You've already forked lazarus-ccr
fpspreadsheet: Delete folder examples/visual/shared. The units were moved to (ccr)/applications/spready
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5280 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -1,673 +0,0 @@
|
|||||||
unit fpsSYLK;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils,
|
|
||||||
fpstypes, fpspreadsheet, fpsReaderWriter, xlsCommon;
|
|
||||||
|
|
||||||
type
|
|
||||||
TsSYLKField = record
|
|
||||||
Name: Char;
|
|
||||||
Value: String;
|
|
||||||
end;
|
|
||||||
TsSYLKFields = array of TsSYLKField;
|
|
||||||
|
|
||||||
|
|
||||||
{ TsSYLKReader }
|
|
||||||
|
|
||||||
TsSYLKReader = class(TsCustomSpreadReader)
|
|
||||||
private
|
|
||||||
FWorksheetName: String;
|
|
||||||
FPointSeparatorSettings: TFormatSettings;
|
|
||||||
FDateMode: TDateMode;
|
|
||||||
protected
|
|
||||||
function GetFieldValue(const AFields: TsSYLKFields; AFieldName: Char): String;
|
|
||||||
procedure ProcessCell(const AFields: TsSYLKFields);
|
|
||||||
procedure ProcessFormat(const AFields: TsSYLKFields);
|
|
||||||
procedure ProcessLine(const ALine: String);
|
|
||||||
procedure ProcessRecord(ARecordType: String; const AFields: TsSYLKFields);
|
|
||||||
public
|
|
||||||
constructor Create(AWorkbook: TsWorkbook); override;
|
|
||||||
procedure ReadFromFile(AFileName: String; AParams: TsStreamParams = []); override;
|
|
||||||
procedure ReadFromStrings(AStrings: TStrings; AParams: TsStreamParams = []); override;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{ TsSYLKWriter }
|
|
||||||
TsSYLKWriter = class(TsCustomSpreadWriter)
|
|
||||||
private
|
|
||||||
FPointSeparatorSettings: TFormatSettings;
|
|
||||||
FDateMode: TDateMode;
|
|
||||||
FSheetIndex: Integer;
|
|
||||||
function GetFormatStr(ACell: PCell): String;
|
|
||||||
function GetFormulaStr(ACell: PCell): String;
|
|
||||||
protected
|
|
||||||
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: Boolean; ACell: PCell); override;
|
|
||||||
procedure WriteCellToStream(AStream: TStream; ACell: PCell); override;
|
|
||||||
procedure WriteComment(AStream: TStream; ACell: PCell); override;
|
|
||||||
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: TDateTime; ACell: PCell); override;
|
|
||||||
procedure WriteDimensions(AStream: TStream);
|
|
||||||
procedure WriteEndOfFile(AStream: TStream);
|
|
||||||
procedure WriteHeader(AStream: TStream);
|
|
||||||
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: string; ACell: PCell); override;
|
|
||||||
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: double; ACell: PCell); override;
|
|
||||||
procedure WriteNumberFormatList(AStream: TStream);
|
|
||||||
procedure WriteOptions(AStream: TStream);
|
|
||||||
public
|
|
||||||
constructor Create(AWorkbook: TsWorkbook); override;
|
|
||||||
procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TSYLKSettings = record
|
|
||||||
SheetIndex: Integer; // W
|
|
||||||
DateMode: TDateMode; // R/W
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
STR_FILEFORMAT_SYLK = 'SYLK';
|
|
||||||
|
|
||||||
var
|
|
||||||
{@@ Default settings for reading/writing of SYLK files }
|
|
||||||
SYLKSettings: TSYLKSettings = (
|
|
||||||
SheetIndex: 0;
|
|
||||||
DateMode: dm1900
|
|
||||||
);
|
|
||||||
|
|
||||||
{@@ File format identifier }
|
|
||||||
sfidSYLK: Integer;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
uses
|
|
||||||
fpsRegFileFormats, fpsUtils, fpsNumFormat;
|
|
||||||
|
|
||||||
{==============================================================================}
|
|
||||||
{ TsSYLKReader }
|
|
||||||
{==============================================================================}
|
|
||||||
|
|
||||||
constructor TsSYLKReader.Create(AWorkbook: TsWorkbook);
|
|
||||||
begin
|
|
||||||
inherited Create(AWorkbook);
|
|
||||||
FWorksheetName := 'Sheet1'; // will be replaced by filename
|
|
||||||
FDateMode := SYLKSettings.DateMode;
|
|
||||||
FPointSeparatorSettings := DefaultFormatSettings;
|
|
||||||
FPointSeparatorSettings.DecimalSeparator := '.';
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TsSYLKReader.GetFieldValue(const AFields: TsSYLKFields;
|
|
||||||
AFieldName: Char): String;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
for i := 0 to Length(AFields)-1 do
|
|
||||||
if AFields[i].Name = AFieldName then begin
|
|
||||||
Result := AFields[i].Value;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
Result := '';
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ProcessCell(const AFields: TsSYLKFields);
|
|
||||||
var
|
|
||||||
row, col: Cardinal;
|
|
||||||
sval, expr: String;
|
|
||||||
val: Double;
|
|
||||||
cell: PCell;
|
|
||||||
begin
|
|
||||||
col := StrToInt(GetFieldValue(AFields, 'X')) - 1;
|
|
||||||
row := StrToInt(GetFieldValue(AFields, 'Y')) - 1;
|
|
||||||
cell := FWorksheet.GetCell(row, col);
|
|
||||||
|
|
||||||
// Formula
|
|
||||||
expr := GetFieldValue(AFields, 'E'); // expression in R1C1 syntax
|
|
||||||
if expr <> '' then
|
|
||||||
begin
|
|
||||||
expr := 'A1'; // to do: Convert R1C1 expression to A1 expression!
|
|
||||||
FWorksheet.WriteFormula(cell, expr); // to do!!!!
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Value
|
|
||||||
sval := GetFieldValue(AFields, 'K');
|
|
||||||
if sval <> '' then begin
|
|
||||||
if sval[1] = '"' then
|
|
||||||
begin
|
|
||||||
sval := UnquoteStr(sval);
|
|
||||||
if (sval = 'TRUE') or (sval = 'FALSE') then
|
|
||||||
FWorksheet.WriteBoolValue(cell, (sval = 'TRUE'))
|
|
||||||
else
|
|
||||||
FWorksheet.WriteText(cell, UnquoteStr(sval))
|
|
||||||
// to do: error values
|
|
||||||
end else begin
|
|
||||||
val := StrToFloat(sval, FPointSeparatorSettings);
|
|
||||||
FWorksheet.WriteNumber(cell, val);
|
|
||||||
// to do: dates
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ProcessFormat(const AFields: TsSYLKFields);
|
|
||||||
var
|
|
||||||
cell: PCell;
|
|
||||||
s, scol, srow, sval, scol1, scol2: String;
|
|
||||||
col, row, col1, col2: LongInt;
|
|
||||||
ch1, ch2: Char;
|
|
||||||
nf: TsNumberFormat;
|
|
||||||
decs: Integer;
|
|
||||||
ha: TsHorAlignment;
|
|
||||||
val: Double;
|
|
||||||
P: PChar;
|
|
||||||
begin
|
|
||||||
nf := nfGeneral;
|
|
||||||
ha := haDefault;
|
|
||||||
decs := 0;
|
|
||||||
|
|
||||||
// Format
|
|
||||||
s := GetFieldValue(AFields, 'F');
|
|
||||||
if s <> '' then
|
|
||||||
begin
|
|
||||||
ch1 := s[1];
|
|
||||||
ch2 := s[Length(s)];
|
|
||||||
sval := copy(s, 2, Length(s));
|
|
||||||
|
|
||||||
// Number format
|
|
||||||
case ch1 of
|
|
||||||
'D': nf := nfGeneral;
|
|
||||||
'C': nf := nfCurrency;
|
|
||||||
'E': nf := nfExp;
|
|
||||||
'F': nf := nfFixed;
|
|
||||||
'G': nf := nfGeneral;
|
|
||||||
'$': ; // no idea what this is
|
|
||||||
'*': ; // no idea what this is
|
|
||||||
'%': nf := nfPercentage;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Decimal places
|
|
||||||
TryStrtoInt(sval, decs);
|
|
||||||
|
|
||||||
// Horizontal alignment
|
|
||||||
case ch2 of
|
|
||||||
'D': ha := haDefault;
|
|
||||||
'C': ha := haCenter;
|
|
||||||
'G': ; // "Standard" ???
|
|
||||||
'L': ha := haLeft;
|
|
||||||
'R': ha := haRight;
|
|
||||||
'-': ; // ???
|
|
||||||
'X': ; // "Fill"
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Determine whether the format applies to column, row or
|
|
||||||
|
|
||||||
scol := GetFieldValue(AFields, 'C');
|
|
||||||
// Column format, not supported yet
|
|
||||||
if scol <> '' then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
srow := GetFieldValue(AFields, 'R');
|
|
||||||
// Row format, not yet supported
|
|
||||||
if srow <> '' then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
// Cell format
|
|
||||||
scol := GetFieldValue(AFields, 'X');
|
|
||||||
srow := GetFieldValue(AFields, 'Y');
|
|
||||||
if (scol <> '') and (srow <> '') then
|
|
||||||
begin
|
|
||||||
if not TryStrToInt(scol, col) then exit;
|
|
||||||
if not TryStrToInt(srow, row) then exit;
|
|
||||||
cell := FWorksheet.GetCell(row, col);
|
|
||||||
|
|
||||||
FWorksheet.WriteNumberFormat(cell, nf, decs);
|
|
||||||
FWorksheet.WriteHorAlignment(cell, ha);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Column width
|
|
||||||
s := GetFieldValue(AFields, 'W');
|
|
||||||
if s <> '' then
|
|
||||||
begin
|
|
||||||
scol1 := '';
|
|
||||||
P := @s[1];
|
|
||||||
while P^ <> ' ' do begin
|
|
||||||
scol1 := scol1 + P^;
|
|
||||||
inc(P);
|
|
||||||
end;
|
|
||||||
inc(P);
|
|
||||||
scol2 := '';
|
|
||||||
while (P^ <> ' ') do begin
|
|
||||||
scol2 := scol2 + P^;
|
|
||||||
inc(P);
|
|
||||||
end;
|
|
||||||
inc(P);
|
|
||||||
sval := '';
|
|
||||||
while (P^ <> #0) do begin
|
|
||||||
sval := sval + P^;
|
|
||||||
inc(P);
|
|
||||||
end;
|
|
||||||
if TryStrToInt(scol1, col1) and
|
|
||||||
TryStrToInt(scol2, col2) and
|
|
||||||
TryStrToFloat(sval, val, FPointSeparatorSettings) then
|
|
||||||
begin
|
|
||||||
for col := col1-1 to col2-1 do
|
|
||||||
FWorksheet.WriteColWidth(col, val, suChars);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ProcessLine(const ALine: String);
|
|
||||||
var
|
|
||||||
P: PChar;
|
|
||||||
i: Integer;
|
|
||||||
rtd, fval: String;
|
|
||||||
ftd: Char;
|
|
||||||
fields: TsSYLKFields;
|
|
||||||
|
|
||||||
procedure StoreField(AName: Char; const AValue: String);
|
|
||||||
begin
|
|
||||||
if i >= Length(fields) then SetLength(fields, Length(fields)+100);
|
|
||||||
fields[i].Name := AName;
|
|
||||||
fields[i].Value := AValue;
|
|
||||||
inc(i);
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
// Get record type
|
|
||||||
rtd := '';
|
|
||||||
P := @ALine[1];
|
|
||||||
while (P^ <> ';') do begin
|
|
||||||
rtd := rtd + P^;
|
|
||||||
inc(P);
|
|
||||||
end;
|
|
||||||
inc(P);
|
|
||||||
|
|
||||||
if rtd = 'C' then
|
|
||||||
ftd := 'C';
|
|
||||||
|
|
||||||
// Get fields
|
|
||||||
SetLength(fields, 100);
|
|
||||||
i := 0;
|
|
||||||
while (P^ <> #0) do begin
|
|
||||||
ftd := P^;
|
|
||||||
inc(P);
|
|
||||||
fval := '';
|
|
||||||
while (P^ <> #0) do begin
|
|
||||||
case P^ of
|
|
||||||
';' : begin
|
|
||||||
inc(P);
|
|
||||||
if P^ = ';' then begin
|
|
||||||
fval := fval + P^;
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
StoreField(ftd, fval);
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
else fval := fval + P^;
|
|
||||||
inc(P);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if fval <> '' then
|
|
||||||
StoreField(ftd, fval);
|
|
||||||
|
|
||||||
// Process record
|
|
||||||
SetLength(fields, i);
|
|
||||||
ProcessRecord(rtd, fields);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ProcessRecord(ARecordType: String;
|
|
||||||
const AFields: TsSYLKFields);
|
|
||||||
begin
|
|
||||||
case ARecordType of
|
|
||||||
'ID': ; // Begin of file - nothing to do for us
|
|
||||||
'C' : ProcessCell(AFields); // Content record
|
|
||||||
'F' : ProcessFormat(AFields); // Format record
|
|
||||||
'E' : ; // End of file
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ReadFromFile(AFileName: String;
|
|
||||||
AParams: TsStreamParams = []);
|
|
||||||
begin
|
|
||||||
FWorksheetName := ChangeFileExt(ExtractFileName(AFileName), '');
|
|
||||||
inherited ReadFromFile(AFilename, AParams);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKReader.ReadFromStrings(AStrings: TStrings;
|
|
||||||
AParams: TsStreamParams = []);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
Unused(AParams);
|
|
||||||
|
|
||||||
// Create worksheet
|
|
||||||
FWorksheet := FWorkbook.AddWorksheet(FWorksheetName, true);
|
|
||||||
|
|
||||||
for i:=0 to AStrings.Count-1 do
|
|
||||||
ProcessLine(AStrings[i]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{==============================================================================}
|
|
||||||
{ TsSYLKWriter }
|
|
||||||
{==============================================================================}
|
|
||||||
|
|
||||||
constructor TsSYLKWriter.Create(AWorkbook: TsWorkbook);
|
|
||||||
begin
|
|
||||||
inherited Create(AWorkbook);
|
|
||||||
FDateMode := SYLKSettings.DateMode;
|
|
||||||
FSheetIndex := SYLKSettings.SheetIndex;
|
|
||||||
FPointSeparatorSettings := DefaultFormatSettings;
|
|
||||||
FPointSeparatorSettings.DecimalSeparator := '.';
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TsSYLKWriter.GetFormatStr(ACell: PCell): String;
|
|
||||||
var
|
|
||||||
cellFmt: PsCellFormat;
|
|
||||||
ch1, ch2: Char;
|
|
||||||
decs: String;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
style: String;
|
|
||||||
fnt: TsFont;
|
|
||||||
begin
|
|
||||||
Result := '';
|
|
||||||
cellFmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
|
|
||||||
if cellFmt <> nil then
|
|
||||||
begin
|
|
||||||
// Number format --> field ";P"
|
|
||||||
ch1 := 'G'; // general number format
|
|
||||||
decs := '0'; // decimal places
|
|
||||||
if (uffNumberFormat in cellFmt^.UsedFormattingFields) then begin
|
|
||||||
Result := Result + Format(';P%d', [cellFmt^.NumberFormatIndex+1]); // +1 because of General format not in list
|
|
||||||
nfp := FWorkbook.GetNumberFormat(cellFmt^.NumberFormatIndex);
|
|
||||||
case nfp.Sections[0].NumFormat of
|
|
||||||
nfFixed : ch1 := 'F';
|
|
||||||
nfCurrency : ch1 := 'C';
|
|
||||||
nfPercentage : ch1 := '%';
|
|
||||||
nfExp : ch1 := 'E';
|
|
||||||
else ch1 := 'G';
|
|
||||||
end;
|
|
||||||
decs := IntToStr(nfp.Sections[0].Decimals);
|
|
||||||
end else
|
|
||||||
Result := Result + ';P0';
|
|
||||||
|
|
||||||
// Horizontal alignment + old-style number format --> field ";F"
|
|
||||||
ch2 := 'D'; // default alignment
|
|
||||||
if (uffHorAlign in cellFmt^.UsedFormattingFields) then
|
|
||||||
case cellFmt^.HorAlignment of
|
|
||||||
haLeft : ch2 := 'L';
|
|
||||||
haCenter: ch2 := 'C';
|
|
||||||
haRight : ch2 := 'R';
|
|
||||||
end;
|
|
||||||
Result := Result + ';F' + ch1 + decs + ch2;
|
|
||||||
|
|
||||||
// Font style, Borders, background --> field ";S"
|
|
||||||
style := '';
|
|
||||||
if (uffFont in cellFmt^.UsedFormattingFields) then
|
|
||||||
begin
|
|
||||||
fnt := FWorkbook.GetFont(cellFmt^.FontIndex);
|
|
||||||
if (fssBold in fnt.Style) then style := style + 'D';
|
|
||||||
if (fssItalic in fnt.Style) then style := style + 'I';
|
|
||||||
end;
|
|
||||||
if (uffBorder in cellFmt^.UsedFormattingFields) then
|
|
||||||
begin
|
|
||||||
if (cbWest in cellFmt^.Border) then style := style + 'L';
|
|
||||||
if (cbEast in cellFmt^.Border) then style := style + 'R';
|
|
||||||
if (cbNorth in cellFmt^.Border) then style := style + 'T';
|
|
||||||
if (cbSouth in cellFmt^.Border) then style := style + 'B';
|
|
||||||
end;
|
|
||||||
if (uffBackground in cellFmt^.UsedFormattingFields) then
|
|
||||||
style := style + 'S';
|
|
||||||
|
|
||||||
if style <> '' then
|
|
||||||
Result := Result + ';S' + style;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Result := 'F' + Result + Format(';Y%d;X%d', [ACell^.Row+1, ACell^.Col+1]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TsSYLKWriter.GetFormulaStr(ACell: PCell): String;
|
|
||||||
begin
|
|
||||||
if HasFormula(ACell) then
|
|
||||||
Result := ';E' + FWorksheet.ConvertFormulaDialect(ACell, fdExcelR1C1) else
|
|
||||||
Result := '';
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes a boolean value.
|
|
||||||
In the first line, we write the format code -- see GetFormatStr
|
|
||||||
In the second line, we write a "C" record containing the fields
|
|
||||||
- ";X" cell column index (1-based)
|
|
||||||
- ";Y" cell row index (1-based)
|
|
||||||
- ";K" boolean value as TRUE or FALSE, no quotes
|
|
||||||
- ";E" formula in R1C1 syntax, if available -- see GetFormulaStr
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: Boolean; ACell: PCell);
|
|
||||||
const
|
|
||||||
BOOLSTR: Array[boolean] of String = ('FALSE', 'TRUE');
|
|
||||||
var
|
|
||||||
sval: String;
|
|
||||||
sfmt: String;
|
|
||||||
begin
|
|
||||||
// Format codes
|
|
||||||
sfmt := GetFormatStr(ACell);
|
|
||||||
if sfmt <> '' then
|
|
||||||
sfmt := sfmt + LineEnding;
|
|
||||||
|
|
||||||
// Cell coordinates, value, formula
|
|
||||||
sval := Format('C;Y$d;X%d;K%s', [ARow+1, ACol+1, BOOLSTR[AValue]]) + GetFormulaStr(ACell);
|
|
||||||
|
|
||||||
// Write out
|
|
||||||
AppendToStream(AStream, sval + sfmt + LineEnding);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKWriter.WriteCellToStream(AStream: TStream; ACell: PCell);
|
|
||||||
begin
|
|
||||||
case ACell^.ContentType of
|
|
||||||
cctBool:
|
|
||||||
WriteBool(AStream, ACell^.Row, ACell^.Col, ACell^.BoolValue, ACell);
|
|
||||||
cctDateTime:
|
|
||||||
WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
|
|
||||||
cctEmpty:
|
|
||||||
WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
|
|
||||||
cctError:
|
|
||||||
WriteError(AStream, ACell^.Row, ACell^.Col, ACell^.ErrorValue, ACell);
|
|
||||||
cctNumber:
|
|
||||||
WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
|
|
||||||
cctUTF8String:
|
|
||||||
WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
|
|
||||||
end;
|
|
||||||
if FWorksheet.HasComment(ACell) then
|
|
||||||
WriteComment(AStream, ACell);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes a comment record. This is a "C" record containing the fields
|
|
||||||
- ";X" cell column index (1-based)
|
|
||||||
- ";Y" cell row index (1-based)
|
|
||||||
- ";A" comment text, not quoted
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteComment(AStream: TStream; ACell: PCell);
|
|
||||||
var
|
|
||||||
comment: String;
|
|
||||||
begin
|
|
||||||
comment := FWorksheet.ReadComment(ACell);
|
|
||||||
if comment <> '' then
|
|
||||||
AppendToStream(AStream, Format(
|
|
||||||
'C;Y%d;X%d;A%s' + LineEnding, [ACell^.Row+1, ACell^.Col+1, comment]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes a date/time value. The date/time cell is just an ordinary number cell,
|
|
||||||
just formatted with a date/time format.
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: TDateTime; ACell: PCell);
|
|
||||||
var
|
|
||||||
DateSerial: double;
|
|
||||||
begin
|
|
||||||
DateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode);
|
|
||||||
WriteNumber(AStream, ARow, ACol, DateSerial, ACell);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes out the size of the worksheet (row and column count)
|
|
||||||
In SYLK, this is a "B" record followed by the fields ";Y" and ";X" containing
|
|
||||||
the row and column counts.
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteDimensions(AStream: TStream);
|
|
||||||
begin
|
|
||||||
AppendToStream(AStream, Format(
|
|
||||||
'B;Y%d;X%d;D%d %d %d %d' + LineEnding, [
|
|
||||||
FWorksheet.GetLastRowIndex+1, FWorksheet.GetLastColIndex+1,
|
|
||||||
FWorksheet.GetFirstRowIndex, FWorksheet.GetFirstColIndex,
|
|
||||||
FWorksheet.GetLastRowIndex, FWorksheet.GetLastColIndex
|
|
||||||
]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes out an "E" record which is the last record of a SYLK file
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteEndOfFile(AStream: TStream);
|
|
||||||
begin
|
|
||||||
AppendToStream(AStream,
|
|
||||||
'E' + LineEnding);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKWriter.WriteHeader(AStream: TStream);
|
|
||||||
begin
|
|
||||||
AppendToStream(AStream,
|
|
||||||
'ID;PFPS' + LineEnding); // ID + generating app ("FPS" = FPSpreadsheet)
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes a text value.
|
|
||||||
In the first line, we write the format code -- see GetFormatStr
|
|
||||||
In the second line, we write a "C" record containing the fields
|
|
||||||
- ";X" cell column index (1-based)
|
|
||||||
- ";Y" cell row index (1-based)
|
|
||||||
- ";K" text value in double quotes
|
|
||||||
- ";E" formula in R1C1 syntax, if available -- see GetFormulaStr
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: String; ACell: PCell);
|
|
||||||
var
|
|
||||||
sval: String;
|
|
||||||
sfmt: String;
|
|
||||||
begin
|
|
||||||
// Format codes
|
|
||||||
sfmt := GetFormatStr(ACell);
|
|
||||||
if sfmt <> '' then
|
|
||||||
sfmt := sfmt + LineEnding;
|
|
||||||
|
|
||||||
// Cell coordinates, value, formula
|
|
||||||
sval := Format('C;Y%d;X%d;K"%s"', [ARow+1, ACol+1, AValue]) + GetFormulaStr(ACell);
|
|
||||||
|
|
||||||
// Write out
|
|
||||||
AppendToStream(AStream, sfmt + sval + LineEnding);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes a number value.
|
|
||||||
In the first line, we write the format code -- see GetFormatStr
|
|
||||||
In the second line, we write a "C" record containing the fields
|
|
||||||
- ";X" cell column index (1-based)
|
|
||||||
- ";Y" cell row index (1-based)
|
|
||||||
- ";K" number value as unformatted string
|
|
||||||
- ";E" formula in R1C1 syntax, if available -- see GetFormulaStr
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
|
|
||||||
const AValue: double; ACell: PCell);
|
|
||||||
var
|
|
||||||
sval: String;
|
|
||||||
sfmt: String;
|
|
||||||
begin
|
|
||||||
// Format codes
|
|
||||||
sfmt := GetFormatStr(ACell);
|
|
||||||
if sfmt <> '' then
|
|
||||||
sfmt := sfmt + LineEnding;
|
|
||||||
|
|
||||||
// Cell coordinates, value, formula
|
|
||||||
sval := Format('C;Y%d;X%d;K%g', [ARow+1, ACol+1, AValue], FPointSeparatorSettings);
|
|
||||||
sval := sval + GetFormulaStr(ACell);
|
|
||||||
|
|
||||||
// Write out
|
|
||||||
AppendToStream(AStream, sfmt + sval + LineEnding);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Writes the list of number formats.
|
|
||||||
In SYLK, this is a sequence of "P" records. Each record contains the Excel
|
|
||||||
format string with field identifier ";P"
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
procedure TsSYLKWriter.WriteNumberFormatList(AStream: TStream);
|
|
||||||
var
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
nfs: String;
|
|
||||||
i, j: Integer;
|
|
||||||
begin
|
|
||||||
AppendToStream(AStream,
|
|
||||||
'P;PGeneral' + LineEnding);
|
|
||||||
|
|
||||||
for i:=0 to FWorkbook.GetNumberFormatCount-1 do begin
|
|
||||||
nfp := FWorkbook.GetNumberFormat(i);
|
|
||||||
nfs := BuildFormatStringFromSection(nfp.Sections[0]);
|
|
||||||
for j:=1 to High(nfp.Sections) do
|
|
||||||
nfs := nfs + ';;' + BuildFormatStringFromSection(nfp.Sections[j]);
|
|
||||||
AppendToStream(AStream,
|
|
||||||
'P;P' + nfs + LineEnding);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKWriter.WriteOptions(AStream: TStream);
|
|
||||||
var
|
|
||||||
dateModeStr: String;
|
|
||||||
A1ModeStr: String;
|
|
||||||
begin
|
|
||||||
A1ModeStr := ';L'; // Display formulas in A1 mode.
|
|
||||||
|
|
||||||
case FDateMode of // Datemode 1900 or 1904
|
|
||||||
dm1900: dateModeStr := ';V0';
|
|
||||||
dm1904: dateModeStr := ';V4';
|
|
||||||
end;
|
|
||||||
|
|
||||||
AppendToStream(AStream,
|
|
||||||
'O' + A1ModeStr + dateModeStr + LineEnding
|
|
||||||
);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TsSYLKWriter.WriteToStream(AStream: TStream;
|
|
||||||
AParams: TsStreamParams = []);
|
|
||||||
begin
|
|
||||||
Unused(AParams);
|
|
||||||
if (FSheetIndex < 0) or (FSheetIndex >= FWorkbook.GetWorksheetCount) then
|
|
||||||
raise Exception.Create('[TsSYLKWriter.WriteToStream] Non-existing worksheet.');
|
|
||||||
|
|
||||||
FWorksheet := FWorkbook.GetWorksheetByIndex(FSheetIndex);
|
|
||||||
|
|
||||||
WriteHeader(AStream);
|
|
||||||
WriteNumberFormatList(AStream);
|
|
||||||
WriteDimensions(AStream);
|
|
||||||
WriteOptions(AStream);
|
|
||||||
WriteCellsToStream(AStream, FWorksheet.Cells);
|
|
||||||
WriteEndOfFile(AStream);
|
|
||||||
end;
|
|
||||||
|
|
||||||
initialization
|
|
||||||
|
|
||||||
sfidSYLK := RegisterSpreadFormat(sfUser,
|
|
||||||
TsSYLKReader, TsSYLKWriter,
|
|
||||||
STR_FILEFORMAT_SYLK, 'SYLK', ['.slk', '.sylk']
|
|
||||||
);
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,554 +0,0 @@
|
|||||||
object CSVParamsForm: TCSVParamsForm
|
|
||||||
Left = 638
|
|
||||||
Height = 555
|
|
||||||
Top = 250
|
|
||||||
Width = 470
|
|
||||||
BorderStyle = bsDialog
|
|
||||||
Caption = 'Parameters for comma-delimited files'
|
|
||||||
ClientHeight = 555
|
|
||||||
ClientWidth = 470
|
|
||||||
OnCloseQuery = FormCloseQuery
|
|
||||||
OnCreate = FormCreate
|
|
||||||
Position = poMainFormCenter
|
|
||||||
LCLVersion = '1.5'
|
|
||||||
object ButtonPanel: TButtonPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 34
|
|
||||||
Top = 515
|
|
||||||
Width = 458
|
|
||||||
OKButton.Name = 'OKButton'
|
|
||||||
OKButton.DefaultCaption = True
|
|
||||||
HelpButton.Name = 'HelpButton'
|
|
||||||
HelpButton.DefaultCaption = True
|
|
||||||
CloseButton.Name = 'CloseButton'
|
|
||||||
CloseButton.DefaultCaption = True
|
|
||||||
CancelButton.Name = 'CancelButton'
|
|
||||||
CancelButton.DefaultCaption = True
|
|
||||||
TabOrder = 0
|
|
||||||
ShowButtons = [pbOK, pbCancel]
|
|
||||||
end
|
|
||||||
object PageControl: TPageControl
|
|
||||||
Left = 8
|
|
||||||
Height = 499
|
|
||||||
Top = 8
|
|
||||||
Width = 454
|
|
||||||
ActivePage = PgGeneralParams
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Around = 8
|
|
||||||
MultiLine = True
|
|
||||||
TabIndex = 0
|
|
||||||
TabOrder = 1
|
|
||||||
Options = [nboMultiLine]
|
|
||||||
object PgGeneralParams: TTabSheet
|
|
||||||
Caption = 'General'
|
|
||||||
ClientHeight = 471
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblQuoteChar: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 84
|
|
||||||
Width = 88
|
|
||||||
Caption = 'Quote character:'
|
|
||||||
FocusControl = CbQuoteChar
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbQuoteChar: TComboBox
|
|
||||||
Left = 156
|
|
||||||
Height = 23
|
|
||||||
Top = 80
|
|
||||||
Width = 275
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'none'
|
|
||||||
'double ( " )'
|
|
||||||
'single ( '' )'
|
|
||||||
)
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 2
|
|
||||||
Text = 'none'
|
|
||||||
end
|
|
||||||
object CbDelimiter: TComboBox
|
|
||||||
Left = 156
|
|
||||||
Height = 23
|
|
||||||
Top = 16
|
|
||||||
Width = 275
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 4
|
|
||||||
Items.Strings = (
|
|
||||||
'Comma ( , )'
|
|
||||||
'Semicolon ( ; )'
|
|
||||||
'Colon ( : )'
|
|
||||||
'Bar ( | )'
|
|
||||||
'TAB'
|
|
||||||
)
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 0
|
|
||||||
Text = 'TAB'
|
|
||||||
end
|
|
||||||
object Label3: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 19
|
|
||||||
Width = 96
|
|
||||||
Caption = 'Column delimiter:'
|
|
||||||
FocusControl = CbDelimiter
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object Label4: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 51
|
|
||||||
Width = 65
|
|
||||||
Caption = 'Line ending:'
|
|
||||||
FocusControl = CbLineEnding
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbLineEnding: TComboBox
|
|
||||||
Left = 156
|
|
||||||
Height = 23
|
|
||||||
Top = 48
|
|
||||||
Width = 275
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'System'
|
|
||||||
'CR+LF (Windows)'
|
|
||||||
'CR (Mac)'
|
|
||||||
'LF (Unix/Linux/OS X/BSD)'
|
|
||||||
)
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 1
|
|
||||||
Text = 'System'
|
|
||||||
end
|
|
||||||
object RgDetectContentType: TRadioGroup
|
|
||||||
Left = 16
|
|
||||||
Height = 80
|
|
||||||
Top = 156
|
|
||||||
Width = 415
|
|
||||||
AutoFill = True
|
|
||||||
Caption = 'Conversion of strings after reading'
|
|
||||||
ChildSizing.LeftRightSpacing = 6
|
|
||||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
|
||||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
|
||||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
|
||||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
|
||||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
|
||||||
ChildSizing.ControlsPerLine = 1
|
|
||||||
ClientHeight = 60
|
|
||||||
ClientWidth = 411
|
|
||||||
ItemIndex = 1
|
|
||||||
Items.Strings = (
|
|
||||||
'Do not convert, strings are sufficient'
|
|
||||||
'Try to convert strings to content types'
|
|
||||||
)
|
|
||||||
TabOrder = 3
|
|
||||||
end
|
|
||||||
object LbEncoding: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 116
|
|
||||||
Width = 87
|
|
||||||
Caption = 'String encoding:'
|
|
||||||
FocusControl = CbEncoding
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbEncoding: TComboBox
|
|
||||||
Left = 156
|
|
||||||
Height = 23
|
|
||||||
Top = 112
|
|
||||||
Width = 275
|
|
||||||
DropDownCount = 32
|
|
||||||
ItemHeight = 15
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 4
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgNumberParams: TTabSheet
|
|
||||||
Caption = 'Number cells'
|
|
||||||
ClientHeight = 471
|
|
||||||
ClientWidth = 446
|
|
||||||
object CbAutoDetectNumberFormat: TCheckBox
|
|
||||||
Left = 16
|
|
||||||
Height = 19
|
|
||||||
Top = 16
|
|
||||||
Width = 200
|
|
||||||
Caption = 'Try to auto-detect number format'
|
|
||||||
Checked = True
|
|
||||||
State = cbChecked
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object EdNumFormat: TEdit
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 140
|
|
||||||
Width = 194
|
|
||||||
TabOrder = 3
|
|
||||||
end
|
|
||||||
object LblNumFormat: TLabel
|
|
||||||
Left = 17
|
|
||||||
Height = 15
|
|
||||||
Top = 144
|
|
||||||
Width = 182
|
|
||||||
Caption = 'Format string for writing numbers:'
|
|
||||||
FocusControl = EdNumFormat
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblNumFormatInfo: TLabel
|
|
||||||
Left = 232
|
|
||||||
Height = 80
|
|
||||||
Top = 176
|
|
||||||
Width = 194
|
|
||||||
AutoSize = False
|
|
||||||
BorderSpacing.Left = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Around = 8
|
|
||||||
Caption = 'If empty, numbers are written in the same format as they appear in the worksheet.'
|
|
||||||
FocusControl = EdNumFormat
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object LblDecimalSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 59
|
|
||||||
Width = 98
|
|
||||||
Caption = 'Decimal separator:'
|
|
||||||
FocusControl = CbDecimalSeparator
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbDecimalSeparator: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 56
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'Period ( . )'
|
|
||||||
'Comma ( , )'
|
|
||||||
)
|
|
||||||
TabOrder = 1
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object LblThousandSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 91
|
|
||||||
Width = 108
|
|
||||||
Caption = 'Thousand separator:'
|
|
||||||
FocusControl = CbThousandSeparator
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbThousandSeparator: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 88
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'Period ( . )'
|
|
||||||
'Comma ( , )'
|
|
||||||
'Space ( )'
|
|
||||||
)
|
|
||||||
TabOrder = 2
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgCurrency: TTabSheet
|
|
||||||
Caption = 'Currency cells'
|
|
||||||
ClientHeight = 471
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblCurrencySymbol: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 20
|
|
||||||
Width = 93
|
|
||||||
Caption = 'Currency symbol:'
|
|
||||||
FocusControl = EdCurrencySymbol
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object EdCurrencySymbol: TEdit
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 16
|
|
||||||
Width = 194
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 0
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgDateTimeParams: TTabSheet
|
|
||||||
Caption = 'Date/time cells'
|
|
||||||
ClientHeight = 471
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblNumFormat1: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 20
|
|
||||||
Width = 128
|
|
||||||
Caption = 'Long date format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblNumFormat2: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 52
|
|
||||||
Width = 129
|
|
||||||
Caption = 'Short date format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblDecimalSeparator1: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 83
|
|
||||||
Width = 79
|
|
||||||
Caption = 'Date separator:'
|
|
||||||
FocusControl = CbDateSeparator
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbDateSeparator: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 80
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'Dot ( . )'
|
|
||||||
'Dash ( - )'
|
|
||||||
'Slash ( / )'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 2
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object LblNumFormat3: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 268
|
|
||||||
Width = 129
|
|
||||||
Caption = 'Long time format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblNumFormat4: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 300
|
|
||||||
Width = 130
|
|
||||||
Caption = 'Short time format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblDecimalSeparator2: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 331
|
|
||||||
Width = 82
|
|
||||||
Caption = 'Time separator:'
|
|
||||||
FocusControl = CbTimeSeparator
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbTimeSeparator: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 328
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'Dot ( . )'
|
|
||||||
'Dash ( - )'
|
|
||||||
'Slash ( / )'
|
|
||||||
'Colon ( : )'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 5
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object LblLongMonthNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 116
|
|
||||||
Width = 107
|
|
||||||
Caption = 'Long month names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblShortMonthNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 148
|
|
||||||
Width = 108
|
|
||||||
Caption = 'Short month names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblLongDayNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 180
|
|
||||||
Width = 90
|
|
||||||
Caption = 'Long day names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblShortDayNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 212
|
|
||||||
Width = 91
|
|
||||||
Caption = 'Short day names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbLongDateFormat: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 16
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'ddd, d/mm/yyyy'
|
|
||||||
'ddd, d/mmm/yyyy'
|
|
||||||
'dddd, d/mm/yyyy'
|
|
||||||
'dddd, d/mmm/yyyy'
|
|
||||||
'd/mm/yyyy'
|
|
||||||
'dd/mm/yyyy'
|
|
||||||
'dddd, mm/d/yyyy'
|
|
||||||
'dddd, mmm/d/yyyy'
|
|
||||||
'mm/d/yyyy'
|
|
||||||
'mm/dd/yyyy'
|
|
||||||
'yyyy/mm/dd'
|
|
||||||
'yyyy/mm/d'
|
|
||||||
'yyyy/mmm/d'
|
|
||||||
'yyyy/mmmm/d'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 0
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object CbShortDateFormat: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 48
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'd/m/yy'
|
|
||||||
'd/mm/yy'
|
|
||||||
'd/mm/yyyy'
|
|
||||||
'm/d/yy'
|
|
||||||
'mm/d/yy'
|
|
||||||
'mm/d/yyyy'
|
|
||||||
'yy/m/d'
|
|
||||||
'yy/mm/d'
|
|
||||||
'yyyy/mm/d'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 1
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object CbLongTimeFormat: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 264
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'h:n:s'
|
|
||||||
'h:nn:ss'
|
|
||||||
'hh:nn:ss'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 3
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object CbShortTimeFormat: TComboBox
|
|
||||||
Left = 232
|
|
||||||
Height = 23
|
|
||||||
Top = 296
|
|
||||||
Width = 194
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'like spreadsheet'
|
|
||||||
'h:n'
|
|
||||||
'h:nn'
|
|
||||||
'hh:nn'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 4
|
|
||||||
Text = 'like spreadsheet'
|
|
||||||
end
|
|
||||||
object GroupBox1: TGroupBox
|
|
||||||
Left = 17
|
|
||||||
Height = 58
|
|
||||||
Top = 366
|
|
||||||
Width = 409
|
|
||||||
Caption = 'Sample'
|
|
||||||
ClientHeight = 38
|
|
||||||
ClientWidth = 405
|
|
||||||
TabOrder = 6
|
|
||||||
object LblDateTimeSample: TLabel
|
|
||||||
Left = 7
|
|
||||||
Height = 20
|
|
||||||
Top = 2
|
|
||||||
Width = 388
|
|
||||||
Alignment = taCenter
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
AutoSize = False
|
|
||||||
Caption = 'sample'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgBoolParams: TTabSheet
|
|
||||||
Caption = 'Boolean cells'
|
|
||||||
ClientHeight = 471
|
|
||||||
ClientWidth = 446
|
|
||||||
object EdTRUE: TEdit
|
|
||||||
Left = 16
|
|
||||||
Height = 23
|
|
||||||
Top = 40
|
|
||||||
Width = 131
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object EdFALSE: TEdit
|
|
||||||
Left = 176
|
|
||||||
Height = 23
|
|
||||||
Top = 40
|
|
||||||
Width = 131
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object Label1: TLabel
|
|
||||||
Left = 19
|
|
||||||
Height = 15
|
|
||||||
Top = 16
|
|
||||||
Width = 81
|
|
||||||
Caption = 'Text for "TRUE"'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object Label2: TLabel
|
|
||||||
Left = 179
|
|
||||||
Height = 15
|
|
||||||
Top = 16
|
|
||||||
Width = 85
|
|
||||||
Caption = 'Text for "FALSE"'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,594 +0,0 @@
|
|||||||
unit sCSVParamsForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
||||||
ButtonPanel, ExtCtrls, ComCtrls, StdCtrls,
|
|
||||||
fpsCSV,
|
|
||||||
sCtrls;
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
{ TCSVParamsForm }
|
|
||||||
|
|
||||||
TCSVParamsForm = class(TForm)
|
|
||||||
ButtonPanel: TButtonPanel;
|
|
||||||
CbAutoDetectNumberFormat: TCheckBox;
|
|
||||||
CbLongDateFormat: TComboBox;
|
|
||||||
CbLongTimeFormat: TComboBox;
|
|
||||||
CbEncoding: TComboBox;
|
|
||||||
EdCurrencySymbol: TEdit;
|
|
||||||
CbShortTimeFormat: TComboBox;
|
|
||||||
CbShortDateFormat: TComboBox;
|
|
||||||
CbDecimalSeparator: TComboBox;
|
|
||||||
CbDateSeparator: TComboBox;
|
|
||||||
CbTimeSeparator: TComboBox;
|
|
||||||
CbThousandSeparator: TComboBox;
|
|
||||||
CbLineEnding: TComboBox;
|
|
||||||
CbQuoteChar: TComboBox;
|
|
||||||
CbDelimiter: TComboBox;
|
|
||||||
EdTRUE: TEdit;
|
|
||||||
EdFALSE: TEdit;
|
|
||||||
EdNumFormat: TEdit;
|
|
||||||
GroupBox1: TGroupBox;
|
|
||||||
Label1: TLabel;
|
|
||||||
Label2: TLabel;
|
|
||||||
Label3: TLabel;
|
|
||||||
Label4: TLabel;
|
|
||||||
LblDateTimeSample: TLabel;
|
|
||||||
LblDecimalSeparator: TLabel;
|
|
||||||
LblDecimalSeparator1: TLabel;
|
|
||||||
LblDecimalSeparator2: TLabel;
|
|
||||||
LblCurrencySymbol: TLabel;
|
|
||||||
LbEncoding: TLabel;
|
|
||||||
LblShortMonthNames: TLabel;
|
|
||||||
LblLongDayNames: TLabel;
|
|
||||||
LblShortDayNames: TLabel;
|
|
||||||
LblNumFormat1: TLabel;
|
|
||||||
LblNumFormat2: TLabel;
|
|
||||||
LblNumFormat3: TLabel;
|
|
||||||
LblNumFormat4: TLabel;
|
|
||||||
LblLongMonthNames: TLabel;
|
|
||||||
LblThousandSeparator: TLabel;
|
|
||||||
LblNumFormat: TLabel;
|
|
||||||
LblQuoteChar: TLabel;
|
|
||||||
LblNumFormatInfo: TLabel;
|
|
||||||
PageControl: TPageControl;
|
|
||||||
PgGeneralParams: TTabSheet;
|
|
||||||
PgNumberParams: TTabSheet;
|
|
||||||
PgDateTimeParams: TTabSheet;
|
|
||||||
PgBoolParams: TTabSheet;
|
|
||||||
RgDetectContentType: TRadioGroup;
|
|
||||||
PgCurrency: TTabSheet;
|
|
||||||
procedure DateTimeFormatChange(Sender: TObject);
|
|
||||||
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
||||||
procedure FormCreate(Sender: TObject);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
FSampleDateTime: TDateTime;
|
|
||||||
FDateFormatSample: String;
|
|
||||||
FTimeFormatSample: String;
|
|
||||||
FEdLongMonthNames: TMonthDayNamesEdit;
|
|
||||||
FEdShortMonthNames: TMonthDayNamesEdit;
|
|
||||||
FEdLongDayNames: TMonthDayNamesEdit;
|
|
||||||
FEdShortDayNames: TMonthDayNamesEdit;
|
|
||||||
procedure DateSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
procedure DecimalSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
// function GetCurrencySymbol: String;
|
|
||||||
procedure ThousandSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
procedure TimeSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
procedure GetParams(var AParams: TsCSVParams);
|
|
||||||
procedure SetParams(const AParams: TsCSVParams);
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
CSVParamsForm: TCSVParamsForm;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
LConvEncoding, fpsUtils;
|
|
||||||
|
|
||||||
resourcestring
|
|
||||||
rsLikeSpreadsheet = 'like spreadsheet';
|
|
||||||
|
|
||||||
var
|
|
||||||
CSVParamsPageIndex: Integer = 0;
|
|
||||||
|
|
||||||
|
|
||||||
{ TCSVParamsForm }
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.DateSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
begin
|
|
||||||
case CbDateSeparator.ItemIndex of
|
|
||||||
0: ASettings.DateSeparator := #0;
|
|
||||||
1: ASettings.DateSeparator := '.';
|
|
||||||
2: ASettings.DateSeparator := '-';
|
|
||||||
3: ASettings.DateSeparator := '/';
|
|
||||||
else ASettings.DateSeparator := CbDateSeparator.Text[1];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.DecimalSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
begin
|
|
||||||
case CbDecimalSeparator.ItemIndex of
|
|
||||||
0: ASettings.DecimalSeparator := #0;
|
|
||||||
1: ASettings.DecimalSeparator := '.';
|
|
||||||
2: ASettings.DecimalSeparator := ',';
|
|
||||||
else ASettings.DecimalSeparator := CbDecimalSeparator.Text[1];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.DateTimeFormatChange(Sender: TObject);
|
|
||||||
var
|
|
||||||
fs: TFormatSettings;
|
|
||||||
ctrl: TWinControl;
|
|
||||||
dt: TDateTime;
|
|
||||||
arr: Array[1..12] of String;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
fs := UTF8FormatSettings;
|
|
||||||
if CbLongDateFormat.ItemIndex <> 0 then
|
|
||||||
fs.LongDateFormat := CbLongDateFormat.Text;
|
|
||||||
if CbShortDateFormat.ItemIndex <> 0 then
|
|
||||||
fs.ShortDateFormat := CbShortDateFormat.Text;
|
|
||||||
if CbLongTimeFormat.ItemIndex <> 0 then
|
|
||||||
fs.LongTimeFormat := CbLongTimeFormat.Text;
|
|
||||||
if CbShortTimeFormat.ItemIndex <> 0 then
|
|
||||||
fs.ShortTimeFormat := CbShortTimeFormat.Text;
|
|
||||||
if CbDateSeparator.ItemIndex <> 0 then
|
|
||||||
DateSeparatorToFormatSettings(fs);
|
|
||||||
if CbTimeSeparator.ItemIndex <> 0 then
|
|
||||||
TimeSeparatorToFormatSettings(fs);
|
|
||||||
|
|
||||||
if FEdLongMonthNames.Text <> rsLikeSpreadsheet then begin
|
|
||||||
arr[1] := ''; // to silence the compiler
|
|
||||||
FEdLongMonthNames.GetNames(arr);
|
|
||||||
for i:=1 to 12 do
|
|
||||||
if arr[i] <> '' then fs.LongMonthNames[i] := arr[i];
|
|
||||||
end;
|
|
||||||
if FEdShortMonthNames.Text <> rsLikeSpreadsheet then begin
|
|
||||||
FEdShortMonthNames.GetNames(arr);
|
|
||||||
for i:=1 to 12 do
|
|
||||||
if arr[i] <> '' then fs.ShortMonthNames[i] := arr[i];
|
|
||||||
end;
|
|
||||||
if FEdLongDayNames.Text <> rsLikeSpreadsheet then begin
|
|
||||||
FEdLongDayNames.GetNames(arr);
|
|
||||||
for i:=1 to 7 do
|
|
||||||
if arr[i] <> '' then fs.LongDayNames[i] := arr[i];
|
|
||||||
end;
|
|
||||||
if FEdShortDayNames.Text <> rsLikeSpreadsheet then begin
|
|
||||||
FEdShortDayNames.GetNames(arr);
|
|
||||||
for i:=1 to 7 do
|
|
||||||
if arr[i] <> '' then fs.ShortDayNames[i] := arr[i];
|
|
||||||
end;
|
|
||||||
|
|
||||||
dt := FSampleDateTime;
|
|
||||||
ctrl := ActiveControl;
|
|
||||||
if (ctrl = CbLongDateFormat) then
|
|
||||||
begin
|
|
||||||
FDateFormatSample := fs.LongDateFormat;
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FDateFormatSample, dt, fs);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbShortDateFormat) then
|
|
||||||
begin
|
|
||||||
FDateFormatSample := fs.ShortDateFormat;
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FDateFormatSample, dt, fs);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbDateSeparator) then
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FDateFormatSample, dt, fs)
|
|
||||||
else
|
|
||||||
if (ctrl = CbLongTimeFormat) then
|
|
||||||
begin
|
|
||||||
FTimeFormatSample := fs.LongTimeFormat;
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FTimeFormatSample, dt, fs);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbShortTimeFormat) then
|
|
||||||
begin
|
|
||||||
FTimeFormatSample := fs.ShortTimeFormat;
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FTimeFormatSample, dt, fs);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbTimeSeparator) then
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime(FTimeFormatSample, dt, fs)
|
|
||||||
else
|
|
||||||
LblDateTimeSample.Caption := FormatDateTime('c', dt, fs);
|
|
||||||
|
|
||||||
Application.ProcessMessages;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
||||||
begin
|
|
||||||
Unused(Sender, CanClose);
|
|
||||||
CSVParamsPageIndex := PageControl.ActivePageIndex;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.FormCreate(Sender: TObject);
|
|
||||||
begin
|
|
||||||
PageControl.ActivePageIndex := CSVParamsPageIndex;
|
|
||||||
|
|
||||||
// Populate encoding combobox. Done in code because of the conditional define.
|
|
||||||
with CbEncoding.Items do begin
|
|
||||||
Add('automatic / UTF8');
|
|
||||||
Add('UTF8');
|
|
||||||
Add('UTF8 with BOM');
|
|
||||||
Add('ISO_8859_1 (Central Europe)');
|
|
||||||
Add('ISO_8859_15 (Western European languages)');
|
|
||||||
Add('ISO_8859_2 (Eastern Europe)');
|
|
||||||
Add('CP1250 (Central Europe)');
|
|
||||||
Add('CP1251 (Cyrillic)');
|
|
||||||
Add('CP1252 (Latin 1)');
|
|
||||||
Add('CP1253 (Greek)');
|
|
||||||
Add('CP1254 (Turkish)');
|
|
||||||
Add('CP1255 (Hebrew)');
|
|
||||||
Add('CP1256 (Arabic)');
|
|
||||||
Add('CP1257 (Baltic)');
|
|
||||||
Add('CP1258 (Vietnam)');
|
|
||||||
Add('CP437 (DOS central Europe)');
|
|
||||||
Add('CP850 (DOS western Europe)');
|
|
||||||
Add('CP852 (DOS central Europe)');
|
|
||||||
Add('CP866 (DOS and Windows console''s cyrillic)');
|
|
||||||
Add('CP874 (Thai)');
|
|
||||||
{$IFNDEF DisableAsianCodePages}
|
|
||||||
// Asian encodings
|
|
||||||
Add('CP932 (Japanese)');
|
|
||||||
Add('CP936 (Chinese)');
|
|
||||||
Add('CP949 (Korea)');
|
|
||||||
Add('CP950 (Chinese Complex)');
|
|
||||||
{$ENDIF}
|
|
||||||
Add('KOI8 (Russian cyrillic)');
|
|
||||||
Add('UCS2LE (UCS2-LE 2byte little endian)');
|
|
||||||
Add('UCS2BE (UCS2-BE 2byte big endian)');
|
|
||||||
end;
|
|
||||||
CbEncoding.ItemIndex := 0;
|
|
||||||
|
|
||||||
FEdLongMonthNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdLongMonthNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTimeParams;
|
|
||||||
Left := CbDateSeparator.Left;
|
|
||||||
Top := CbDateSeparator.Top + 32;
|
|
||||||
{$IFDEF LCL_FULLVERSION AND LCL_FULLVERSION > 1020600}
|
|
||||||
Width := CbDateSeparator.Width;
|
|
||||||
{$ELSE}
|
|
||||||
Width := CbDateSeparator.Width - Button.Width;
|
|
||||||
{$ENDIF}
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
TabOrder := CbDateSeparator.TabOrder + 1;
|
|
||||||
end;
|
|
||||||
LblLongMonthNames.FocusControl := FEdLongMonthNames;
|
|
||||||
|
|
||||||
FEdShortMonthNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdShortMonthNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTimeParams;
|
|
||||||
Left := CbDateSeparator.Left;
|
|
||||||
Top := CbDateSeparator.Top + 32*2;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
TabOrder := CbDateSeparator.TabOrder + 2;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblShortMonthNames.FocusControl := FEdShortMonthNames;
|
|
||||||
|
|
||||||
FEdLongDayNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdLongDayNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTimeParams;
|
|
||||||
Left := CbDateSeparator.Left;
|
|
||||||
Top := CbDateSeparator.Top + 32*3;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
TabOrder := CbDateSeparator.TabOrder + 3;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblLongDayNames.FocusControl := FEdLongDayNames;
|
|
||||||
|
|
||||||
FEdShortDayNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdShortDayNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTimeParams;
|
|
||||||
Left := CbDateSeparator.Left;
|
|
||||||
Top := CbDateSeparator.Top + 32*4;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
TabOrder := CbDateSeparator.TabOrder + 4;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblShortDayNames.FocusControl := FEdShortDayNames;
|
|
||||||
|
|
||||||
FDateFormatSample := UTF8FormatSettings.LongDateFormat;
|
|
||||||
FTimeFormatSample := UTF8FormatSettings.LongTimeFormat;
|
|
||||||
FSampleDateTime := now();
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.GetParams(var AParams: TsCSVParams);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
begin
|
|
||||||
// Line endings
|
|
||||||
case CbLineEnding.ItemIndex of
|
|
||||||
0: AParams.LineEnding := leSystem;
|
|
||||||
1: AParams.LineEnding := leCRLF;
|
|
||||||
2: AParams.LineEnding := leCR;
|
|
||||||
3: AParams.LineEnding := leLF;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Column delimiter
|
|
||||||
case CbDelimiter.ItemIndex of
|
|
||||||
0: AParams.Delimiter := ',';
|
|
||||||
1: AParams.Delimiter := ';';
|
|
||||||
2: AParams.Delimiter := ':';
|
|
||||||
3: AParams.Delimiter := '|';
|
|
||||||
4: AParams.Delimiter := #9;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Quote character
|
|
||||||
case CbQuoteChar.ItemIndex of
|
|
||||||
0: AParams.QuoteChar := #0;
|
|
||||||
1: AParams.QuoteChar := '"';
|
|
||||||
2: AParams.QuoteChar := '''';
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Encoding
|
|
||||||
if CbEncoding.ItemIndex = 0 then
|
|
||||||
AParams.Encoding := ''
|
|
||||||
else if CbEncoding.ItemIndex = 1 then
|
|
||||||
AParams.Encoding := EncodingUTF8BOM
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
s := CbEncoding.Items[CbEncoding.ItemIndex];
|
|
||||||
AParams.Encoding := Copy(s, 1, Pos(' ', s)-1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Detect content type and convert
|
|
||||||
AParams.DetectContentType := RgDetectContentType.ItemIndex <> 0;
|
|
||||||
|
|
||||||
// Auto-detect number format
|
|
||||||
AParams.AutoDetectNumberFormat := CbAutoDetectNumberFormat.Checked;
|
|
||||||
|
|
||||||
// Number format
|
|
||||||
AParams.NumberFormat := EdNumFormat.Text;
|
|
||||||
|
|
||||||
// Decimal separator
|
|
||||||
DecimalSeparatorToFormatSettings(AParams.FormatSettings);
|
|
||||||
|
|
||||||
// Thousand separator
|
|
||||||
ThousandSeparatorToFormatSettings(AParams.FormatSettings);
|
|
||||||
|
|
||||||
// Currency symbol
|
|
||||||
if (EdCurrencySymbol.Text = '') or (EdCurrencySymbol.Text = rsLikeSpreadsheet) then
|
|
||||||
AParams.FormatSettings.CurrencyString := ''
|
|
||||||
else
|
|
||||||
AParams.FormatSettings.CurrencyString := EdCurrencySymbol.Text;
|
|
||||||
|
|
||||||
// Long date format string
|
|
||||||
if (CbLongDateFormat.ItemIndex = 0) or (CbLongDateFormat.Text = '') then
|
|
||||||
AParams.FormatSettings.LongDateFormat := ''
|
|
||||||
else
|
|
||||||
AParams.FormatSettings.LongDateFormat := CbLongDateFormat.Text;
|
|
||||||
|
|
||||||
// Short date format string
|
|
||||||
if (CbShortDateFormat.ItemIndex = 0) or (CbShortDateFormat.Text = '') then
|
|
||||||
AParams.FormatSettings.ShortDateFormat := ''
|
|
||||||
else
|
|
||||||
AParams.FormatSettings.ShortDateFormat := CbShortDateFormat.Text;
|
|
||||||
|
|
||||||
// Date separator
|
|
||||||
DateSeparatorToFormatSettings(AParams.FormatSettings);
|
|
||||||
|
|
||||||
// Long month names
|
|
||||||
FEdLongMonthNames.GetNames(AParams.FormatSettings.LongMonthNames);
|
|
||||||
|
|
||||||
// Short month names
|
|
||||||
FEdShortMonthNames.GetNames(AParams.FormatSettings.ShortMonthNames);
|
|
||||||
|
|
||||||
// Long day names
|
|
||||||
FEdLongDayNames.GetNames(AParams.FormatSettings.LongDayNames);
|
|
||||||
|
|
||||||
// Short day names
|
|
||||||
FEdShortDayNames.GetNames(AParams.FormatSettings.ShortDayNames);
|
|
||||||
|
|
||||||
// Long time format string
|
|
||||||
if CbLongTimeFormat.ItemIndex = 0 then
|
|
||||||
AParams.FormatSettings.LongTimeFormat := ''
|
|
||||||
else
|
|
||||||
AParams.FormatSettings.LongTimeFormat := CbLongTimeFormat.Text;
|
|
||||||
|
|
||||||
// Short time format string
|
|
||||||
if CbShortTimeFormat.ItemIndex = 0 then
|
|
||||||
AParams.FormatSettings.ShortTimeFormat := ''
|
|
||||||
else
|
|
||||||
AParams.FormatSettings.ShortTimeFormat := CbShortTimeFormat.Text;
|
|
||||||
|
|
||||||
// Time separator
|
|
||||||
TimeSeparatorToFormatSettings(AParams.FormatSettings);
|
|
||||||
|
|
||||||
// Text for "TRUE"
|
|
||||||
AParams.TrueText := EdTRUE.Text;
|
|
||||||
|
|
||||||
// Test for "FALSE"
|
|
||||||
AParams.FalseText := EdFALSE.Text;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.SetParams(const AParams: TsCSVParams);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
// Line endings
|
|
||||||
case AParams.LineEnding of
|
|
||||||
leSystem: CbLineEnding.ItemIndex := 0;
|
|
||||||
leCRLF : CbLineEnding.ItemIndex := 1;
|
|
||||||
leCR : CbLineEnding.ItemIndex := 2;
|
|
||||||
leLF : CbLineEnding.ItemIndex := 3;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Column delimiter
|
|
||||||
case AParams.Delimiter of
|
|
||||||
',' : CbDelimiter.ItemIndex := 0;
|
|
||||||
';' : CbDelimiter.ItemIndex := 1;
|
|
||||||
':' : CbDelimiter.ItemIndex := 2;
|
|
||||||
'|' : CbDelimiter.ItemIndex := 3;
|
|
||||||
#9 : CbDelimiter.ItemIndex := 4;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Quote character
|
|
||||||
case AParams.QuoteChar of
|
|
||||||
#0 : CbQuoteChar.ItemIndex := 0;
|
|
||||||
'"' : CbQuoteChar.ItemIndex := 1;
|
|
||||||
'''' : CbQuoteChar.ItemIndex := 2;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// String encoding
|
|
||||||
if AParams.Encoding = '' then
|
|
||||||
CbEncoding.ItemIndex := 0
|
|
||||||
else if AParams.Encoding = EncodingUTF8BOM then
|
|
||||||
CbEncoding.ItemIndex := 1
|
|
||||||
else
|
|
||||||
for i:=1 to CbEncoding.Items.Count-1 do
|
|
||||||
begin
|
|
||||||
s := CbEncoding.Items[i];
|
|
||||||
if SameText(AParams.Encoding, Copy(s, 1, Pos(' ', s)-1)) then
|
|
||||||
begin
|
|
||||||
CbEncoding.ItemIndex := i;
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Detect content type
|
|
||||||
RgDetectContentType.ItemIndex := ord(AParams.DetectContentType);
|
|
||||||
|
|
||||||
// Auto-detect number format
|
|
||||||
CbAutoDetectNumberFormat.Checked := AParams.AutoDetectNumberFormat;
|
|
||||||
|
|
||||||
// Number format
|
|
||||||
EdNumFormat.Text := AParams.NumberFormat;
|
|
||||||
|
|
||||||
// Decimal separator
|
|
||||||
case AParams.FormatSettings.DecimalSeparator of
|
|
||||||
#0 : CbDecimalSeparator.ItemIndex := 0;
|
|
||||||
'.' : CbDecimalSeparator.ItemIndex := 1;
|
|
||||||
',' : CbDecimalSeparator.ItemIndex := 2;
|
|
||||||
else CbDecimalSeparator.Text := AParams.FormatSettings.DecimalSeparator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Thousand separator
|
|
||||||
case AParams.FormatSettings.ThousandSeparator of
|
|
||||||
#0 : CbThousandSeparator.ItemIndex := 0;
|
|
||||||
'.' : CbThousandSeparator.ItemIndex := 1;
|
|
||||||
',' : CbThousandSeparator.ItemIndex := 2;
|
|
||||||
' ' : CbThousandSeparator.ItemIndex := 3;
|
|
||||||
else CbThousandSeparator.Text := AParams.FormatSettings.ThousandSeparator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Currency symbol
|
|
||||||
if AParams.FormatSettings.CurrencyString = '' then
|
|
||||||
EdCurrencySymbol.Text := rsLikeSpreadsheet
|
|
||||||
else
|
|
||||||
EdCurrencySymbol.Text := AParams.FormatSettings.CurrencyString;
|
|
||||||
|
|
||||||
// Long date format
|
|
||||||
if AParams.FormatSettings.LongDateFormat = '' then
|
|
||||||
CbLongDateFormat.ItemIndex := 0
|
|
||||||
else
|
|
||||||
CbLongDateFormat.Text := AParams.FormatSettings.LongDateFormat;
|
|
||||||
|
|
||||||
// Short date format
|
|
||||||
if AParams.FormatSettings.ShortDateFormat = '' then
|
|
||||||
CbShortDateFormat.ItemIndex := 0
|
|
||||||
else
|
|
||||||
CbShortDateFormat.Text := AParams.FormatSettings.ShortDateFormat;
|
|
||||||
|
|
||||||
// Date separator
|
|
||||||
case AParams.FormatSettings.DateSeparator of
|
|
||||||
#0 : CbDateSeparator.ItemIndex := 0;
|
|
||||||
'.' : CbDateSeparator.ItemIndex := 1;
|
|
||||||
'-' : CbDateSeparator.ItemIndex := 2;
|
|
||||||
'/' : CbDateSeparator.ItemIndex := 3;
|
|
||||||
else CbDateSeparator.Text := AParams.FormatSettings.DateSeparator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Long month names
|
|
||||||
FEdLongMonthNames.SetNames(AParams.FormatSettings.LongMonthNames, 12, false, rsLikeSpreadsheet);
|
|
||||||
|
|
||||||
// Short month names
|
|
||||||
FEdShortMonthNames.SetNames(AParams.FormatSettings.ShortMonthNames, 12, true, rsLikeSpreadsheet);
|
|
||||||
|
|
||||||
// Long day names
|
|
||||||
FEdLongDayNames.SetNames(AParams.FormatSettings.LongDayNames, 7, false, rsLikeSpreadsheet);
|
|
||||||
|
|
||||||
// Short month names
|
|
||||||
FEdShortDayNames.SetNames(AParams.FormatSettings.ShortDayNames, 7, true, rsLikeSpreadsheet);
|
|
||||||
|
|
||||||
// Long time format
|
|
||||||
if AParams.FormatSettings.LongTimeFormat = '' then
|
|
||||||
CbLongTimeFormat.ItemIndex := 0
|
|
||||||
else
|
|
||||||
CbLongTimeFormat.Text := AParams.FormatSettings.LongTimeFormat;
|
|
||||||
|
|
||||||
// Short time format
|
|
||||||
if AParams.FormatSettings.ShortTimeFormat = '' then
|
|
||||||
CbShortTimeFormat.ItemIndex := 0
|
|
||||||
else
|
|
||||||
CbShortTimeFormat.Text := AParams.FormatSettings.ShortTimeFormat;
|
|
||||||
|
|
||||||
// Time separator
|
|
||||||
case AParams.FormatSettings.TimeSeparator of
|
|
||||||
#0 : CbTimeSeparator.ItemIndex := 0;
|
|
||||||
'.' : CbTimeSeparator.ItemIndex := 1;
|
|
||||||
'-' : CbTimeSeparator.ItemIndex := 2;
|
|
||||||
'/' : CbTimeSeparator.ItemIndex := 3;
|
|
||||||
':' : CbTimeSeparator.ItemIndex := 4;
|
|
||||||
else CbTimeSeparator.Text := AParams.FormatSettings.TimeSeparator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Text for "TRUE"
|
|
||||||
EdTRUE.Text := AParams.TrueText;
|
|
||||||
|
|
||||||
// Test for "FALSE"
|
|
||||||
EdFALSE.Text := AParams.FalseText;
|
|
||||||
|
|
||||||
// Update date/time sample display
|
|
||||||
DateTimeFormatChange(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.ThousandSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
begin
|
|
||||||
case CbThousandSeparator.ItemIndex of
|
|
||||||
0: ASettings.ThousandSeparator := #0;
|
|
||||||
1: ASettings.ThousandSeparator := '.';
|
|
||||||
2: ASettings.ThousandSeparator := ',';
|
|
||||||
3: ASettings.ThousandSeparator := ' ';
|
|
||||||
else ASettings.ThousandSeparator := CbThousandSeparator.Text[1];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCSVParamsForm.TimeSeparatorToFormatSettings(var ASettings: TFormatSettings);
|
|
||||||
begin
|
|
||||||
case CbTimeSeparator.ItemIndex of
|
|
||||||
0: ASettings.TimeSeparator := #0;
|
|
||||||
1: ASettings.TimeSeparator := '.';
|
|
||||||
2: ASettings.TimeSeparator := '-';
|
|
||||||
3: ASettings.TimeSeparator := '/';
|
|
||||||
4: ASettings.TimeSeparator := ':';
|
|
||||||
else ASettings.TimeSeparator := CbTimeSeparator.Text[1];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//initialization
|
|
||||||
// {$I scsvparamsform.lrs}
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,326 +0,0 @@
|
|||||||
unit sCtrls;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, Controls, StdCtrls, Grids, EditBtn, Forms;
|
|
||||||
|
|
||||||
type
|
|
||||||
{ TMonthDayNamesEdit }
|
|
||||||
TMonthDayNamesEdit = class(TEditButton)
|
|
||||||
private
|
|
||||||
FEmptyString: String;
|
|
||||||
FCount: Integer;
|
|
||||||
FShortnames: Boolean;
|
|
||||||
procedure ButtonClickHandler(Sender: TObject);
|
|
||||||
function CreateMonthDayNamesEditor(var AGrid: TStringGrid): TForm;
|
|
||||||
protected
|
|
||||||
public
|
|
||||||
constructor Create(AOwner: TComponent); override;
|
|
||||||
procedure GetNames(var ANamesArray);
|
|
||||||
procedure SetNames(const ANamesArray; ACount: Integer; IsShortNames: Boolean;
|
|
||||||
const AEmptyString: String);
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ TFormatSeparatorCombo }
|
|
||||||
TFormatSeparatorKind = (skDecimal, skThousand, skDate, skTime, skList);
|
|
||||||
|
|
||||||
TFormatSeparatorCombo = class(TCombobox)
|
|
||||||
private
|
|
||||||
FKind: TFormatSeparatorKind;
|
|
||||||
function GetSeparator: Char;
|
|
||||||
procedure SetSeparator(AValue: Char);
|
|
||||||
procedure SetSeparatorKind(AValue: TFormatSeparatorKind);
|
|
||||||
public
|
|
||||||
property Separator: Char read GetSeparator write SetSeparator;
|
|
||||||
property SeparatorKind: TFormatSeparatorKind read FKind write SetSeparatorKind;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
uses
|
|
||||||
Math, ButtonPanel, fpsUtils;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Concatenates the day names specified in ADayNames to a single string. If all
|
|
||||||
daynames are empty AEmptyStr is returned
|
|
||||||
|
|
||||||
@param ADayNames Array[1..7] of day names as used in the Formatsettings
|
|
||||||
@param AEmptyStr Is returned if all day names are empty
|
|
||||||
@return String having all day names concatenated and separated by the
|
|
||||||
DefaultFormatSettings.ListSeparator
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
function DayNamesToString(const ADayNames: TWeekNameArray;
|
|
||||||
const AEmptyStr: String): String;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
isEmpty: Boolean;
|
|
||||||
begin
|
|
||||||
isEmpty := true;
|
|
||||||
for i:=1 to 7 do
|
|
||||||
if ADayNames[i] <> '' then
|
|
||||||
begin
|
|
||||||
isEmpty := false;
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if isEmpty then
|
|
||||||
Result := AEmptyStr
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Result := ADayNames[1];
|
|
||||||
for i:=2 to 7 do
|
|
||||||
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + ADayNames[i];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{@@ ----------------------------------------------------------------------------
|
|
||||||
Concatenates the month names specified in AMonthNames to a single string.
|
|
||||||
If all month names are empty AEmptyStr is returned
|
|
||||||
|
|
||||||
@param AMonthNames Array[1..12] of month names as used in the Formatsettings
|
|
||||||
@param AEmptyStr Is returned if all month names are empty
|
|
||||||
@return String having all month names concatenated and separated by the
|
|
||||||
DefaultFormatSettings.ListSeparator
|
|
||||||
-------------------------------------------------------------------------------}
|
|
||||||
function MonthNamesToString(const AMonthNames: TMonthNameArray;
|
|
||||||
const AEmptyStr: String): String;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
isEmpty: Boolean;
|
|
||||||
begin
|
|
||||||
isEmpty := true;
|
|
||||||
for i:=1 to 12 do
|
|
||||||
if AMonthNames[i] <> '' then
|
|
||||||
begin
|
|
||||||
isEmpty := false;
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if isEmpty then
|
|
||||||
Result := AEmptyStr
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Result := AMonthNames[1];
|
|
||||||
for i:=2 to 12 do
|
|
||||||
Result := Result + DefaultFormatSettings.ListSeparator + ' ' + AMonthNames[i];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ TMonthDayNamesEdit }
|
|
||||||
|
|
||||||
constructor TMonthDayNamesEdit.Create(AOwner: TComponent);
|
|
||||||
begin
|
|
||||||
inherited Create(AOwner);
|
|
||||||
Button.Caption := '...';
|
|
||||||
OnButtonClick := @ButtonClickHandler;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMonthDayNamesEdit.ButtonClickHandler(Sender: TObject);
|
|
||||||
var
|
|
||||||
F: TForm;
|
|
||||||
i: Integer;
|
|
||||||
grid: TStringGrid = nil;
|
|
||||||
names: TMonthNameArray; // can hold day and month names as well
|
|
||||||
begin
|
|
||||||
F := CreateMonthDayNamesEditor(grid);
|
|
||||||
try
|
|
||||||
if F.ShowModal = mrOK then
|
|
||||||
begin
|
|
||||||
for i:=1 to 12 do
|
|
||||||
names[i] := '';
|
|
||||||
for i:=1 to grid.RowCount-1 do
|
|
||||||
names[i] := grid.Cells[1, i];
|
|
||||||
SetNames(names, FCount, FShortNames, FEmptyString);
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TMonthDayNamesEdit.CreateMonthDayNamesEditor(var AGrid: TStringGrid): TForm;
|
|
||||||
var
|
|
||||||
btnPanel: TButtonPanel;
|
|
||||||
i: Integer;
|
|
||||||
R: TRect;
|
|
||||||
Pt: TPoint;
|
|
||||||
w: Integer;
|
|
||||||
names: TMonthNameArray; // has space for both months and days...
|
|
||||||
begin
|
|
||||||
Result := TForm.Create(nil);
|
|
||||||
btnPanel := TButtonPanel.Create(Result);
|
|
||||||
with btnPanel do begin
|
|
||||||
Parent := Result;
|
|
||||||
ShowButtons := [pbOK, pbCancel];
|
|
||||||
end;
|
|
||||||
AGrid := TStringGrid.Create(Result);
|
|
||||||
with AGrid do begin
|
|
||||||
Parent := Result;
|
|
||||||
Align := alClient;
|
|
||||||
BorderSpacing.Around := 8;
|
|
||||||
TitleStyle := tsNative;
|
|
||||||
Options := Options + [goEditing, goAlwaysShowEditor] - [goVertLine];
|
|
||||||
DefaultColWidth := 150;
|
|
||||||
AutoFillColumns := true;
|
|
||||||
ColCount := 2;
|
|
||||||
RowCount := FCount+1;
|
|
||||||
if FCount = 12 then
|
|
||||||
begin
|
|
||||||
Cells[0, 1] := 'January';
|
|
||||||
Cells[0, 2] := 'February';
|
|
||||||
Cells[0, 3] := 'March';
|
|
||||||
Cells[0, 4] := 'April';
|
|
||||||
Cells[0, 5] := 'May';
|
|
||||||
Cells[0, 6] := 'June';
|
|
||||||
Cells[0, 7] := 'July';
|
|
||||||
Cells[0, 8] := 'August';
|
|
||||||
Cells[0, 9] := 'September';
|
|
||||||
Cells[0,10] := 'October';
|
|
||||||
Cells[0,11] := 'November';
|
|
||||||
Cells[0,12] := 'December';
|
|
||||||
if FShortNames then
|
|
||||||
Cells[1, 0] := 'Short month names'
|
|
||||||
else
|
|
||||||
Cells[1, 0] := 'Long month names';
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
Cells[0, 1] := 'Sunday';
|
|
||||||
Cells[0, 2] := 'Monday';
|
|
||||||
Cells[0, 3] := 'Tuesday';
|
|
||||||
Cells[0, 4] := 'Wesdnesday';
|
|
||||||
Cells[0, 5] := 'Thursday';
|
|
||||||
Cells[0, 6] := 'Friday';
|
|
||||||
Cells[0, 7] := 'Saturday';
|
|
||||||
if FShortNames then
|
|
||||||
Cells[1, 0] := 'Short day names'
|
|
||||||
else
|
|
||||||
Cells[1, 0] := 'Long day names';
|
|
||||||
end;
|
|
||||||
names[1] := ''; // to silence the compiler...
|
|
||||||
GetNames(names);
|
|
||||||
w := 0;
|
|
||||||
for i:=1 to FCount do
|
|
||||||
begin
|
|
||||||
Cells[1, i] := TMonthNameArray(names)[i];
|
|
||||||
w := Max(w, Canvas.TextWidth(Cells[0, i]));
|
|
||||||
end;
|
|
||||||
ColWidths[0] := w + 16;
|
|
||||||
ColWidths[1] := 2*w;
|
|
||||||
R := CellRect(ColCount-1, RowCount-1);
|
|
||||||
end;
|
|
||||||
Pt := Result.ScreenToClient(AGrid.ClientToScreen(R.BottomRight));
|
|
||||||
Result.Width := AGrid.width + AGrid.BorderSpacing.Around*2 + 5;
|
|
||||||
Result.Height := Pt.Y + btnPanel.Height + AGrid.BorderSpacing.Around*2 - 6;
|
|
||||||
Result.Position := poMainFormCenter;
|
|
||||||
Result.ActiveControl := AGrid;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMonthDayNamesEdit.GetNames(var ANamesArray);
|
|
||||||
{ Not very nice code here: will crash if a TWeekNameArray is passed as ANameArray,
|
|
||||||
but the edit stores month data! Watch out... }
|
|
||||||
var
|
|
||||||
L: TStringList;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
for i:=1 to FCount do
|
|
||||||
TMonthNameArray(ANamesArray)[i] := '';
|
|
||||||
if Text <> FEmptyString then
|
|
||||||
begin
|
|
||||||
L := TStringList.Create;
|
|
||||||
try
|
|
||||||
L.Delimiter := DefaultFormatSettings.ListSeparator;
|
|
||||||
L.DelimitedText := Text;
|
|
||||||
for i:=0 to L.Count-1 do
|
|
||||||
if i < L.Count then
|
|
||||||
TMonthNameArray(ANamesArray)[i+1] := L[i];
|
|
||||||
finally
|
|
||||||
L.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TMonthDayNamesEdit.SetNames(const ANamesArray; ACount: Integer;
|
|
||||||
IsShortNames: Boolean; const AEmptyString: String);
|
|
||||||
begin
|
|
||||||
if not ACount in [7, 12] then
|
|
||||||
raise Exception.Create('[TMonthDayNameEdit] Array length can only be 7 or 12.');
|
|
||||||
|
|
||||||
FCount := ACount;
|
|
||||||
FEmptyString := AEmptyString;
|
|
||||||
FShortNames := IsShortNames;
|
|
||||||
|
|
||||||
case FCount of
|
|
||||||
7: Text := DayNamesToString(TWeekNameArray(ANamesArray), AEmptyString);
|
|
||||||
12: Text := MonthNamesToString(TMonthNameArray(ANamesArray), AEmptyString);
|
|
||||||
else raise Exception.Create('[TMonthDayNameEdit] Array length can only be 7 or 12.');
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{ TFormatSeparatorCombo }
|
|
||||||
|
|
||||||
function TFormatSeparatorCombo.GetSeparator: Char;
|
|
||||||
begin
|
|
||||||
if ItemIndex = -1 then
|
|
||||||
begin
|
|
||||||
if Text = '' then
|
|
||||||
Result := #0
|
|
||||||
else
|
|
||||||
Result := Text[1];
|
|
||||||
end else
|
|
||||||
Result := Char(PtrInt(items.Objects[ItemIndex]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSeparatorCombo.SetSeparator(AValue: Char);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
i := Items.IndexOfObject(TObject(PtrInt(ord(AValue))));
|
|
||||||
if i = -1 then
|
|
||||||
Text := AValue
|
|
||||||
else
|
|
||||||
ItemIndex := i;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSeparatorCombo.SetSeparatorKind(AValue: TFormatSeparatorKind);
|
|
||||||
begin
|
|
||||||
FKind := AValue;
|
|
||||||
Items.BeginUpdate;
|
|
||||||
try
|
|
||||||
case FKind of
|
|
||||||
skDecimal, skThousand:
|
|
||||||
begin
|
|
||||||
Items.AddObject('Dot ( . )', TObject(PtrInt(ord('.'))));
|
|
||||||
Items.AddObject('Comma ( , )', TObject(PtrInt(ord(','))));
|
|
||||||
if FKind = skThousand then
|
|
||||||
Items.AddObject('Space ( )', TObject(PtrInt(ord(' '))));
|
|
||||||
end;
|
|
||||||
skDate, skTime:
|
|
||||||
begin
|
|
||||||
Items.AddObject('Dot ( . )', TObject(PtrInt(ord('.'))));
|
|
||||||
Items.AddObject('Dash ( - )', TObject(PtrInt(ord('-'))));
|
|
||||||
Items.AddObject('Slash ( / )', TObject(PtrInt(ord('/'))));
|
|
||||||
if FKind = skTime then
|
|
||||||
Items.AddObject('Colon ( : )', TObject(PtrInt(ord(':'))));
|
|
||||||
end;
|
|
||||||
skList:
|
|
||||||
begin
|
|
||||||
Items.AddObject('Dot ( . )', TObject(PtrInt(ord('.'))));
|
|
||||||
Items.AddObject('Comma ( , )', TObject(PtrInt(ord(','))));
|
|
||||||
Items.AddObject('Semicolon ( ; )', TObject(PtrInt(ord(';'))));
|
|
||||||
Items.AddObject('Colon ( : )', TObject(PtrInt(ord(':'))));
|
|
||||||
Items.AddObject('Bar ( | )', TObject(PtrInt(ord('|'))));
|
|
||||||
Items.AddObject('Slash ( / )', TObject(PtrInt(ord('/'))));
|
|
||||||
Items.AddObject('Backslash ( \ )', TObject(PtrInt(ord('\'))));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
Items.EndUpdate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,172 +0,0 @@
|
|||||||
object CurrencyForm: TCurrencyForm
|
|
||||||
Left = 544
|
|
||||||
Height = 288
|
|
||||||
Top = 339
|
|
||||||
Width = 245
|
|
||||||
BorderStyle = bsDialog
|
|
||||||
Caption = 'Currency symbols'
|
|
||||||
ClientHeight = 288
|
|
||||||
ClientWidth = 245
|
|
||||||
OnCreate = FormCreate
|
|
||||||
ShowHint = True
|
|
||||||
LCLVersion = '1.5'
|
|
||||||
object LblInfo: TLabel
|
|
||||||
Left = 4
|
|
||||||
Height = 15
|
|
||||||
Top = 4
|
|
||||||
Width = 237
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'These strings indicate currencies:'
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object CurrencyListbox: TListBox
|
|
||||||
Left = 4
|
|
||||||
Height = 223
|
|
||||||
Top = 23
|
|
||||||
Width = 237
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
ItemHeight = 0
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object ButtonPanel: TPanel
|
|
||||||
Left = 0
|
|
||||||
Height = 38
|
|
||||||
Top = 250
|
|
||||||
Width = 245
|
|
||||||
Align = alBottom
|
|
||||||
ClientHeight = 38
|
|
||||||
ClientWidth = 245
|
|
||||||
FullRepaint = False
|
|
||||||
TabOrder = 1
|
|
||||||
object BtnOK: TBitBtn
|
|
||||||
Left = 77
|
|
||||||
Height = 25
|
|
||||||
Hint = 'Accept changes and close'
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
DefaultCaption = True
|
|
||||||
Kind = bkOK
|
|
||||||
ModalResult = 1
|
|
||||||
OnClick = BtnOKClick
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object BtnCancel: TBitBtn
|
|
||||||
Left = 157
|
|
||||||
Height = 25
|
|
||||||
Hint = 'Discard changes and close'
|
|
||||||
Top = 8
|
|
||||||
Width = 83
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
DefaultCaption = True
|
|
||||||
Kind = bkCancel
|
|
||||||
ModalResult = 2
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object ButtonBevel: TBevel
|
|
||||||
Left = 5
|
|
||||||
Height = 3
|
|
||||||
Top = 1
|
|
||||||
Width = 235
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Left = 4
|
|
||||||
BorderSpacing.Right = 4
|
|
||||||
Shape = bsTopLine
|
|
||||||
end
|
|
||||||
object BtnAdd: TBitBtn
|
|
||||||
Left = 8
|
|
||||||
Height = 25
|
|
||||||
Hint = 'Add a currency symbol'
|
|
||||||
Top = 8
|
|
||||||
Width = 27
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0041924E233D8F497D3A8C44DB368940F332873CF32F84
|
|
||||||
37DB2C81337D287F3023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0049995853459653E6419950FF7DC28FFF96D0A6FF96CFA6FF78BE
|
|
||||||
89FF368D42FF2C8134E6297F3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00519F61534D9C5DF464B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
|
|
||||||
98FFA5D9B4FF58AA6BFF2C8134F4297F3053FFFFFF00FFFFFF00FFFFFF0059A6
|
|
||||||
6B2256A366E56AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
|
|
||||||
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234E5297F3022FFFFFF00FFFFFF005DA9
|
|
||||||
707E53AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF58B56EFF5CB774FFA6DAB4FF388F43FF2C82347EFFFFFF00FFFFFF0061AC
|
|
||||||
75DB8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539DBFFFFFF00FFFFFF0065AF
|
|
||||||
7AF6A9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DF6FFFFFF00FFFFFF0069B2
|
|
||||||
7EF6B6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42F6FFFFFF00FFFFFF006DB5
|
|
||||||
83DBACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
|
|
||||||
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47DBFFFFFF00FFFFFF0070B8
|
|
||||||
877E85C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
|
|
||||||
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF40914C7EFFFFFF00FFFFFF0073BA
|
|
||||||
8A2270B887E5AADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
|
|
||||||
95FF83D28EFFAFE0B7FF6BB97DFF489856E544945122FFFFFF00FFFFFF00FFFF
|
|
||||||
FF0073BB8B5370B887F4AFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
|
|
||||||
AFFFC0E8C5FF79C28AFF509E5FF44C9B5B53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0073BB8B5371B887E694CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
|
|
||||||
B8FF6DB97FFF58A569E654A16553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0074BB8B2371B9887D6EB684DB6AB380F367B17CF363AE
|
|
||||||
77DB60AB737D5CA86E23FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnAddClick
|
|
||||||
Spacing = 0
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
object BtnDelete: TBitBtn
|
|
||||||
Left = 40
|
|
||||||
Height = 25
|
|
||||||
Hint = 'Delete selected currency symbol'
|
|
||||||
Top = 8
|
|
||||||
Width = 27
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF003F54C3233A50C27D3853BEDB3551BDF3304BBCF32E4E
|
|
||||||
B8DB2B4CB77D2748B523FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF004658C8534255C6E63C52CCFF757AE8FF8F92EEFF8F92EEFF7178
|
|
||||||
E4FF334DC1FF2B4AB7E6294BB553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF004D5ACD534959CBF45C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
|
|
||||||
EEFF9EA0F4FF515DD7FF2B4AB7F4294BB553FFFFFF00FFFFFF00FFFFFF00545F
|
|
||||||
D2225361CFE5616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
|
|
||||||
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8E5294BB522FFFFFF00FFFFFF005860
|
|
||||||
D47E4B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF2A4AB87EFFFFFF00FFFFFF005C62
|
|
||||||
D7DB818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBADBFFFFFF00FFFFFF005F63
|
|
||||||
DAF6A1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCF6FFFFFF00FFFFFF006469
|
|
||||||
DBF6AFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEF6FFFFFF00FFFFFF00676A
|
|
||||||
DEDBA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
|
|
||||||
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0DBFFFFFF00FFFFFF006A69
|
|
||||||
E07E7D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
|
|
||||||
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF3E54C27EFFFFFF00FFFFFF006C6C
|
|
||||||
E1226A69E0E5A3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
|
|
||||||
F9FF768CF8FFA8B6F8FF636EE3FF4557C7E54156C522FFFFFF00FFFFFF00FFFF
|
|
||||||
FF006D6CE3536A69E0F4AAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
|
|
||||||
FBFFBAC7FCFF707BE9FF4C5BCCF44858CA53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF006D6CE3536A6ADFE68E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
|
|
||||||
F4FF6670E2FF535ED1E6505DCE53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF006D6DE2236B6AE17D686ADDDB6364DCF36164DAF35D63
|
|
||||||
D9DB5B63D67D5862D423FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnDeleteClick
|
|
||||||
Spacing = 0
|
|
||||||
TabOrder = 3
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,100 +0,0 @@
|
|||||||
unit scurrencyform;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
|
||||||
ExtCtrls, Buttons;
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
{ TCurrencyForm }
|
|
||||||
|
|
||||||
TCurrencyForm = class(TForm)
|
|
||||||
ButtonBevel: TBevel;
|
|
||||||
BtnAdd: TBitBtn;
|
|
||||||
BtnCancel: TBitBtn;
|
|
||||||
BtnDelete: TBitBtn;
|
|
||||||
BtnOK: TBitBtn;
|
|
||||||
CurrencyListbox: TListBox;
|
|
||||||
LblInfo: TLabel;
|
|
||||||
ButtonPanel: TPanel;
|
|
||||||
procedure BtnAddClick(Sender: TObject);
|
|
||||||
procedure BtnDeleteClick(Sender: TObject);
|
|
||||||
procedure BtnOKClick(Sender: TObject);
|
|
||||||
procedure FormCreate(Sender: TObject);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
function GetCurrencySymbol: String;
|
|
||||||
procedure SetCurrencySymbol(const AValue: String);
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
property CurrencySymbol: String read GetCurrencySymbol write SetCurrencySymbol;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
CurrencyForm: TCurrencyForm;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
fpsCurrency;
|
|
||||||
|
|
||||||
|
|
||||||
{ TCurrencyForm }
|
|
||||||
|
|
||||||
procedure TCurrencyForm.BtnAddClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
s := InputBox('Input', 'Currency symbol:', '');
|
|
||||||
if s <> '' then begin
|
|
||||||
i := CurrencyListbox.Items.IndexOf(s);
|
|
||||||
if i = -1 then
|
|
||||||
i := CurrencyListbox.Items.Add(s);
|
|
||||||
CurrencyListbox.ItemIndex := i;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCurrencyForm.BtnDeleteClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if CurrencyListbox.ItemIndex > -1 then
|
|
||||||
CurrencyListbox.Items.Delete(CurrencyListbox.ItemIndex);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCurrencyForm.BtnOKClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
RegisterCurrencies(CurrencyListbox.Items, true);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCurrencyForm.FormCreate(Sender: TObject);
|
|
||||||
begin
|
|
||||||
GetRegisteredCurrencies(CurrencyListbox.Items);
|
|
||||||
CurrencyListbox.ItemIndex := CurrencyListbox.Items.Count-1;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TCurrencyForm.GetCurrencySymbol: String;
|
|
||||||
var
|
|
||||||
index: Integer;
|
|
||||||
begin
|
|
||||||
index := CurrencyListbox.ItemIndex;
|
|
||||||
if index > -1 then
|
|
||||||
Result := CurrencyListbox.Items[index]
|
|
||||||
else
|
|
||||||
Result := '';
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCurrencyForm.SetCurrencySymbol(const AValue: String);
|
|
||||||
begin
|
|
||||||
CurrencyListbox.ItemIndex := CurrencyListbox.Items.IndexOf(AValue);
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,394 +0,0 @@
|
|||||||
object FormatSettingsForm: TFormatSettingsForm
|
|
||||||
Left = 417
|
|
||||||
Height = 494
|
|
||||||
Top = 229
|
|
||||||
Width = 470
|
|
||||||
BorderStyle = bsDialog
|
|
||||||
Caption = 'Workbook format settings'
|
|
||||||
ClientHeight = 494
|
|
||||||
ClientWidth = 470
|
|
||||||
OnCloseQuery = FormCloseQuery
|
|
||||||
OnCreate = FormCreate
|
|
||||||
Position = poMainFormCenter
|
|
||||||
ShowHint = True
|
|
||||||
LCLVersion = '1.5'
|
|
||||||
object PageControl: TPageControl
|
|
||||||
Left = 8
|
|
||||||
Height = 438
|
|
||||||
Top = 8
|
|
||||||
Width = 454
|
|
||||||
ActivePage = PgCurrency
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Around = 8
|
|
||||||
TabIndex = 1
|
|
||||||
TabOrder = 0
|
|
||||||
OnChange = PageControlChange
|
|
||||||
object PgNumber: TTabSheet
|
|
||||||
Caption = 'Number'
|
|
||||||
ClientHeight = 410
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblDecimalSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 19
|
|
||||||
Width = 98
|
|
||||||
Caption = 'Decimal separator:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblThousandSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 51
|
|
||||||
Width = 108
|
|
||||||
Caption = 'Thousand separator:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object Label1: TLabel
|
|
||||||
Left = 4
|
|
||||||
Height = 15
|
|
||||||
Top = 391
|
|
||||||
Width = 438
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'The current workbook is automatically updated to these settings.'
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object Bevel3: TBevel
|
|
||||||
Left = 0
|
|
||||||
Height = 3
|
|
||||||
Top = 384
|
|
||||||
Width = 446
|
|
||||||
Align = alBottom
|
|
||||||
Shape = bsBottomLine
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgCurrency: TTabSheet
|
|
||||||
Caption = 'Currency'
|
|
||||||
ClientHeight = 410
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblCurrencySymbol: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 20
|
|
||||||
Width = 93
|
|
||||||
Caption = 'Currency symbol:'
|
|
||||||
FocusControl = EdCurrencySymbol
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object EdCurrencySymbol: TEdit
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 16
|
|
||||||
Width = 202
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
OnChange = EdCurrencySymbolChange
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object LblCurrencySymbol1: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 52
|
|
||||||
Width = 132
|
|
||||||
Caption = 'Currency decimal places:'
|
|
||||||
FocusControl = EdCurrencyDecimals
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object EdCurrencyDecimals: TSpinEdit
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 48
|
|
||||||
Width = 66
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object LblPosCurrencyFormat: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 84
|
|
||||||
Width = 135
|
|
||||||
Caption = 'Format of positive values:'
|
|
||||||
FocusControl = CbPosCurrencyFormat
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbPosCurrencyFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 80
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
object LblNegCurrencyFormat: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 15
|
|
||||||
Top = 116
|
|
||||||
Width = 139
|
|
||||||
Caption = 'Format of negative values:'
|
|
||||||
FocusControl = CbNegCurrencyFormat
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbNegCurrencyFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 112
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 3
|
|
||||||
end
|
|
||||||
object Label2: TLabel
|
|
||||||
Left = 4
|
|
||||||
Height = 15
|
|
||||||
Top = 391
|
|
||||||
Width = 438
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'These settings are only respected in new cells.'
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object Bevel2: TBevel
|
|
||||||
Left = 0
|
|
||||||
Height = 3
|
|
||||||
Top = 384
|
|
||||||
Width = 446
|
|
||||||
Align = alBottom
|
|
||||||
Shape = bsBottomLine
|
|
||||||
end
|
|
||||||
object BtnCurrency: TBitBtn
|
|
||||||
Left = 406
|
|
||||||
Height = 25
|
|
||||||
Top = 15
|
|
||||||
Width = 25
|
|
||||||
Caption = '...'
|
|
||||||
OnClick = BtnCurrencyClick
|
|
||||||
TabOrder = 4
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgDateTime: TTabSheet
|
|
||||||
Caption = 'Date/time'
|
|
||||||
ClientHeight = 401
|
|
||||||
ClientWidth = 446
|
|
||||||
object LblNumFormat1: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 20
|
|
||||||
Width = 160
|
|
||||||
Caption = 'Long date format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbLongDateFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 16
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'ddd, d/mm/yyyy'
|
|
||||||
'ddd, d/mmm/yyyy'
|
|
||||||
'dddd, d/mm/yyyy'
|
|
||||||
'dddd, d/mmm/yyyy'
|
|
||||||
'd/mm/yyyy'
|
|
||||||
'dd/mm/yyyy'
|
|
||||||
'dddd, mm/d/yyyy'
|
|
||||||
'dddd, mmm/d/yyyy'
|
|
||||||
'mm/d/yyyy'
|
|
||||||
'mm/dd/yyyy'
|
|
||||||
'yyyy/mm/dd'
|
|
||||||
'yyyy/mm/d'
|
|
||||||
'yyyy/mmm/d'
|
|
||||||
'yyyy/mmmm/d'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 0
|
|
||||||
Text = 'ddd, d/mm/yyyy'
|
|
||||||
end
|
|
||||||
object LblNumFormat2: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 52
|
|
||||||
Width = 162
|
|
||||||
Caption = 'Short date format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbShortDateFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 48
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'd/m/yy'
|
|
||||||
'd/mm/yy'
|
|
||||||
'd/mm/yyyy'
|
|
||||||
'm/d/yy'
|
|
||||||
'mm/d/yy'
|
|
||||||
'mm/d/yyyy'
|
|
||||||
'yy/m/d'
|
|
||||||
'yy/mm/d'
|
|
||||||
'yyyy/mm/d'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 1
|
|
||||||
Text = 'd/m/yy'
|
|
||||||
end
|
|
||||||
object LblDateSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 83
|
|
||||||
Width = 102
|
|
||||||
Caption = 'Date separator:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblLongMonthNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 116
|
|
||||||
Width = 130
|
|
||||||
Caption = 'Long month names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblShortMonthNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 148
|
|
||||||
Width = 132
|
|
||||||
Caption = 'Short month names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblLongDayNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 180
|
|
||||||
Width = 111
|
|
||||||
Caption = 'Long day names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblShortDayNames: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 212
|
|
||||||
Width = 113
|
|
||||||
Caption = 'Short day names:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblNumFormat3: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 252
|
|
||||||
Width = 160
|
|
||||||
Caption = 'Long time format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblNumFormat4: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 284
|
|
||||||
Width = 162
|
|
||||||
Caption = 'Short time format string:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object LblTimeSeparator: TLabel
|
|
||||||
Left = 16
|
|
||||||
Height = 20
|
|
||||||
Top = 315
|
|
||||||
Width = 103
|
|
||||||
Caption = 'Time separator:'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbLongTimeFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 248
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 1
|
|
||||||
Items.Strings = (
|
|
||||||
'h:n:s'
|
|
||||||
'h:nn:ss'
|
|
||||||
'hh:nn:ss'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 2
|
|
||||||
Text = 'h:nn:ss'
|
|
||||||
end
|
|
||||||
object CbShortTimeFormat: TComboBox
|
|
||||||
Left = 200
|
|
||||||
Height = 23
|
|
||||||
Top = 280
|
|
||||||
Width = 231
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
ItemIndex = 1
|
|
||||||
Items.Strings = (
|
|
||||||
'h:n'
|
|
||||||
'h:nn'
|
|
||||||
'hh:nn'
|
|
||||||
)
|
|
||||||
OnChange = DateTimeFormatChange
|
|
||||||
OnEnter = DateTimeFormatChange
|
|
||||||
TabOrder = 3
|
|
||||||
Text = 'h:nn'
|
|
||||||
end
|
|
||||||
object Label3: TLabel
|
|
||||||
Left = 4
|
|
||||||
Height = 40
|
|
||||||
Top = 357
|
|
||||||
Width = 438
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'Only the date and time separator are automatically respected by the workbook; the other settings are considered only for new cells.'
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object Bevel1: TBevel
|
|
||||||
Left = 0
|
|
||||||
Height = 3
|
|
||||||
Top = 350
|
|
||||||
Width = 446
|
|
||||||
Align = alBottom
|
|
||||||
Shape = bsBottomLine
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object ButtonPanel: TButtonPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 34
|
|
||||||
Top = 454
|
|
||||||
Width = 458
|
|
||||||
OKButton.Name = 'OKButton'
|
|
||||||
OKButton.DefaultCaption = True
|
|
||||||
OKButton.OnClick = OKButtonClick
|
|
||||||
HelpButton.Name = 'HelpButton'
|
|
||||||
HelpButton.DefaultCaption = True
|
|
||||||
CloseButton.Name = 'CloseButton'
|
|
||||||
CloseButton.DefaultCaption = True
|
|
||||||
CancelButton.Name = 'CancelButton'
|
|
||||||
CancelButton.DefaultCaption = True
|
|
||||||
TabOrder = 1
|
|
||||||
ShowButtons = [pbOK, pbCancel]
|
|
||||||
object LblDateTimeSample: TLabel
|
|
||||||
Left = 6
|
|
||||||
Height = 36
|
|
||||||
Top = 2
|
|
||||||
Width = 287
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
AutoSize = False
|
|
||||||
Caption = 'sample'
|
|
||||||
Layout = tlCenter
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,470 +0,0 @@
|
|||||||
unit sFormatsettingsForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
||||||
ButtonPanel, ComCtrls, StdCtrls, Spin, ExtCtrls, Buttons, sCtrls;
|
|
||||||
|
|
||||||
type
|
|
||||||
{ TFormatSettingsForm }
|
|
||||||
|
|
||||||
TFormatSettingsForm = class(TForm)
|
|
||||||
Bevel1: TBevel;
|
|
||||||
Bevel2: TBevel;
|
|
||||||
Bevel3: TBevel;
|
|
||||||
BtnCurrency: TBitBtn;
|
|
||||||
ButtonPanel: TButtonPanel;
|
|
||||||
CbLongDateFormat: TComboBox;
|
|
||||||
CbLongTimeFormat: TComboBox;
|
|
||||||
CbPosCurrencyFormat: TComboBox;
|
|
||||||
CbNegCurrencyFormat: TComboBox;
|
|
||||||
CbShortDateFormat: TComboBox;
|
|
||||||
CbShortTimeFormat: TComboBox;
|
|
||||||
EdCurrencySymbol: TEdit;
|
|
||||||
EdCurrencyDecimals: TSpinEdit;
|
|
||||||
Label1: TLabel;
|
|
||||||
Label2: TLabel;
|
|
||||||
Label3: TLabel;
|
|
||||||
LblCurrencySymbol: TLabel;
|
|
||||||
LblCurrencySymbol1: TLabel;
|
|
||||||
LblDateTimeSample: TLabel;
|
|
||||||
LblDecimalSeparator: TLabel;
|
|
||||||
LblDateSeparator: TLabel;
|
|
||||||
LblTimeSeparator: TLabel;
|
|
||||||
LblLongDayNames: TLabel;
|
|
||||||
LblLongMonthNames: TLabel;
|
|
||||||
LblNumFormat1: TLabel;
|
|
||||||
LblNumFormat2: TLabel;
|
|
||||||
LblNumFormat3: TLabel;
|
|
||||||
LblNumFormat4: TLabel;
|
|
||||||
LblPosCurrencyFormat: TLabel;
|
|
||||||
LblNegCurrencyFormat: TLabel;
|
|
||||||
LblShortDayNames: TLabel;
|
|
||||||
LblShortMonthNames: TLabel;
|
|
||||||
LblThousandSeparator: TLabel;
|
|
||||||
PageControl: TPageControl;
|
|
||||||
PgCurrency: TTabSheet;
|
|
||||||
PgDateTime: TTabSheet;
|
|
||||||
PgNumber: TTabSheet;
|
|
||||||
procedure BtnCurrencyClick(Sender: TObject);
|
|
||||||
procedure DateTimeFormatChange(Sender: TObject);
|
|
||||||
procedure EdCurrencySymbolChange(Sender: TObject);
|
|
||||||
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
||||||
procedure FormCreate(Sender: TObject);
|
|
||||||
procedure OKButtonClick(Sender: TObject);
|
|
||||||
procedure PageControlChange(Sender: TObject);
|
|
||||||
private
|
|
||||||
FSampleDateTime: TDateTime;
|
|
||||||
FDateFormatSample: String;
|
|
||||||
FTimeFormatSample: String;
|
|
||||||
FEdLongMonthNames: TMonthDayNamesEdit;
|
|
||||||
FEdShortMonthNames: TMonthDayNamesEdit;
|
|
||||||
FEdLongDayNames: TMonthDayNamesEdit;
|
|
||||||
FEdShortDayNames: TMonthDayNamesEdit;
|
|
||||||
FCbDecimalSeparator: TFormatSeparatorCombo;
|
|
||||||
FCbThousandSeparator: TFormatSeparatorCombo;
|
|
||||||
FCbDateSeparator: TFormatSeparatorCombo;
|
|
||||||
FCbTimeSeparator: TFormatSeparatorCombo;
|
|
||||||
function GetFormatSettings: TFormatSettings;
|
|
||||||
procedure SetFormatSettings(const AValue: TFormatSettings);
|
|
||||||
function ValidData(out AControl: TWinControl; out AMsg: String): Boolean;
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
property FormatSettings: TFormatSettings read GetFormatSettings write SetFormatSettings;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
FormatSettingsForm: TFormatSettingsForm;
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
fpsUtils, fpsNumFormat,
|
|
||||||
sCurrencyForm;
|
|
||||||
|
|
||||||
const
|
|
||||||
CURR_VALUE = 100.0;
|
|
||||||
|
|
||||||
var
|
|
||||||
PageIndex: Integer = 0; // stores the previously selected page index (to open the form always with previously used page)
|
|
||||||
|
|
||||||
|
|
||||||
{ TFormatSettingsForm }
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.DateTimeFormatChange(Sender: TObject);
|
|
||||||
var
|
|
||||||
fs: TFormatSettings;
|
|
||||||
ctrl: TWinControl;
|
|
||||||
dt: TDateTime;
|
|
||||||
s: String;
|
|
||||||
begin
|
|
||||||
fs := GetFormatSettings;
|
|
||||||
dt := FSampleDateTime;
|
|
||||||
ctrl := ActiveControl;
|
|
||||||
|
|
||||||
if (ctrl = CbLongDateFormat) then
|
|
||||||
begin
|
|
||||||
FDateFormatSample := fs.LongDateFormat;
|
|
||||||
s := FormatDateTime(FDateFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample date:'#13 + s;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbShortDateFormat) then
|
|
||||||
begin
|
|
||||||
FDateFormatSample := fs.ShortDateFormat;
|
|
||||||
s := FormatDateTime(FDateFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample date:'#13 + s;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = FCbDateSeparator) then begin
|
|
||||||
s := FormatDateTime(FDateFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample date:'#13 + s;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbLongTimeFormat) then
|
|
||||||
begin
|
|
||||||
FTimeFormatSample := fs.LongTimeFormat;
|
|
||||||
s := FormatDateTime(FTimeFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample time:'#13 + s;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = CbShortTimeFormat) then
|
|
||||||
begin
|
|
||||||
FTimeFormatSample := fs.ShortTimeFormat;
|
|
||||||
s := FormatDateTime(FTimeFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample time:'#13 + s;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (ctrl = FCbTimeSeparator) then
|
|
||||||
begin
|
|
||||||
s := FormatDateTime(FTimeFormatSample, dt, fs);
|
|
||||||
LblDateTimeSample.Caption := 'Sample time:'#13 + s;
|
|
||||||
{
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
s := AnsiToUTF8(FormatDateTime('c', dt, fs));
|
|
||||||
LblDateTimeSample.Caption := 'Sample date/time:'#13 + s;
|
|
||||||
}
|
|
||||||
end;
|
|
||||||
|
|
||||||
LblDateTimeSample.Visible := (PageControl.Activepage = PgDateTime) and
|
|
||||||
((FDateFormatSample <> '') or (FTimeFormatSample <> ''));
|
|
||||||
// Application.ProcessMessages;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.BtnCurrencyClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
F: TCurrencyForm;
|
|
||||||
begin
|
|
||||||
F := TCurrencyForm.Create(nil);
|
|
||||||
try
|
|
||||||
F.CurrencySymbol := EdCurrencySymbol.Text;
|
|
||||||
if F.ShowModal = mrOK then
|
|
||||||
EdCurrencySymbol.Text := F.CurrencySymbol;
|
|
||||||
finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.EdCurrencySymbolChange(Sender: TObject);
|
|
||||||
var
|
|
||||||
currSym: String;
|
|
||||||
begin
|
|
||||||
currSym := EdCurrencySymbol.Text;
|
|
||||||
BuildCurrencyFormatList(CbPosCurrencyFormat.Items, true, CURR_VALUE, currSym);
|
|
||||||
BuildCurrencyFormatList(CbNegCurrencyFormat.Items, false, CURR_VALUE, currSym);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.FormCloseQuery(Sender: TObject;
|
|
||||||
var CanClose: boolean);
|
|
||||||
begin
|
|
||||||
Unused(Sender, CanClose);
|
|
||||||
PageIndex := PageControl.ActivePageIndex;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.FormCreate(Sender: TObject);
|
|
||||||
const
|
|
||||||
DROPDOWN_COUNT = 32;
|
|
||||||
var
|
|
||||||
w: Integer;
|
|
||||||
begin
|
|
||||||
PageControl.ActivePageIndex := PageIndex;
|
|
||||||
|
|
||||||
CbLongDateFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
CbShortDateFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
CbLongTimeFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
CbShortTimeFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
CbPosCurrencyFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
CbNegCurrencyFormat.DropdownCount := DROPDOWN_COUNT;
|
|
||||||
|
|
||||||
w := CbLongDateFormat.Width;
|
|
||||||
FCbDecimalSeparator := TFormatSeparatorCombo.Create(self);
|
|
||||||
with FCbDecimalSeparator do
|
|
||||||
begin
|
|
||||||
Parent := PgNumber;
|
|
||||||
Left := CbLongDateFormat.Left;
|
|
||||||
Width := w;
|
|
||||||
Top := CbLongDateFormat.Top;
|
|
||||||
TabOrder := 0;
|
|
||||||
SeparatorKind := skDecimal;
|
|
||||||
end;
|
|
||||||
LblDecimalSeparator.FocusControl := FCbDecimalSeparator;
|
|
||||||
|
|
||||||
FCbThousandSeparator := TFormatSeparatorCombo.Create(self);
|
|
||||||
with FCbThousandSeparator do
|
|
||||||
begin
|
|
||||||
Parent := PgNumber;
|
|
||||||
Left := FCbDecimalSeparator.Left;
|
|
||||||
Width := w;
|
|
||||||
Top := FCBDecimalSeparator.Top + 32;
|
|
||||||
TabOrder := FCbDecimalSeparator.TabOrder + 1;
|
|
||||||
SeparatorKind := skThousand;
|
|
||||||
end;
|
|
||||||
LblThousandSeparator.FocusControl := FCbThousandSeparator;
|
|
||||||
|
|
||||||
FCbDateSeparator := TFormatSeparatorCombo.Create(self);
|
|
||||||
with FCbDateSeparator do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortDateFormat.Left;
|
|
||||||
Width := w;
|
|
||||||
Top := CbShortDateFormat.Top + 32;
|
|
||||||
TabOrder := CbShortDateFormat.TabOrder + 1;
|
|
||||||
SeparatorKind := skDate;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblDateSeparator.FocusControl := FCbDateSeparator;
|
|
||||||
|
|
||||||
FEdLongMonthNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdLongMonthNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortDateFormat.Left;
|
|
||||||
{$IFDEF LCL_FULLVERSION AND LCL_FULLVERSION > 1020600}
|
|
||||||
Width := w;
|
|
||||||
{$ELSE}
|
|
||||||
Width := w - Button.Width;
|
|
||||||
{$ENDIF}
|
|
||||||
Top := CbShortDateFormat.Top + 32*2;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
TabOrder := CbShortDateFormat.TabOrder + 2;
|
|
||||||
end;
|
|
||||||
LblLongMonthNames.FocusControl := FEdLongMonthNames;
|
|
||||||
|
|
||||||
FEdShortMonthNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdShortMonthNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortDateFormat.Left;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
Top := CbShortDateFormat.Top + 32*3;
|
|
||||||
TabOrder := CbShortDateFormat.TabOrder + 3;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblShortMonthNames.FocusControl := FEdShortMonthNames;
|
|
||||||
|
|
||||||
FEdLongDayNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdLongDayNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortDateformat.Left;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
Top := CbShortDateFormat.Top + 32*4;
|
|
||||||
TabOrder := CbShortDateFormat.TabOrder + 4;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblLongDayNames.FocusControl := FEdLongDayNames;
|
|
||||||
|
|
||||||
FEdShortDayNames := TMonthDayNamesEdit.Create(self);
|
|
||||||
with FEdShortDayNames do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortDateFormat.Left;
|
|
||||||
Width := FEdLongMonthNames.Width;
|
|
||||||
Top := CbShortDateFormat.Top + 32*5;
|
|
||||||
TabOrder := CbShortDateFormat.TabOrder + 5;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblShortDayNames.FocusControl := FEdShortDayNames;
|
|
||||||
|
|
||||||
FCbTimeSeparator := TFormatSeparatorCombo.Create(self);
|
|
||||||
with FCbTimeSeparator do
|
|
||||||
begin
|
|
||||||
Parent := PgDateTime;
|
|
||||||
Left := CbShortTimeFormat.Left;
|
|
||||||
Width := w;
|
|
||||||
Top := CbShortTimeFormat.Top + 32;
|
|
||||||
TabOrder := CbShortTimeFormat.TabOrder + 1;
|
|
||||||
SeparatorKind := skTime;
|
|
||||||
OnChange := @DateTimeFormatChange;
|
|
||||||
OnEnter := @DateTimeFormatChange;
|
|
||||||
end;
|
|
||||||
LblTimeSeparator.FocusControl := FCbTimeSeparator;
|
|
||||||
|
|
||||||
FDateFormatSample := '';
|
|
||||||
FTimeFormatSample := '';
|
|
||||||
FSampleDateTime := now();
|
|
||||||
|
|
||||||
LblDateTimeSample.Visible := false;
|
|
||||||
|
|
||||||
// Published property not available in old Laz versions
|
|
||||||
EdCurrencyDecimals.Alignment := taRightJustify;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.OKButtonClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
msg: String;
|
|
||||||
C: TWinControl;
|
|
||||||
cParent: TWinControl;
|
|
||||||
begin
|
|
||||||
if not ValidData(C, msg) then
|
|
||||||
begin
|
|
||||||
cParent := C.Parent;
|
|
||||||
while (cParent <> nil) and not (cParent is TTabSheet) do
|
|
||||||
cParent := cParent.Parent;
|
|
||||||
PageControl.ActivePage := cParent as TTabSheet;
|
|
||||||
if C.CanFocus then C.SetFocus;
|
|
||||||
MessageDlg(msg, mtError, [mbOK], 0);
|
|
||||||
ModalResult := mrNone;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.PageControlChange(Sender: TObject);
|
|
||||||
begin
|
|
||||||
LblDateTimeSample.Visible := (PageControl.Activepage = PgDateTime) and
|
|
||||||
((FDateFormatSample <> '') or (FTimeFormatSample <> ''));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TFormatSettingsForm.GetFormatSettings: TFormatSettings;
|
|
||||||
begin
|
|
||||||
Result := DefaultFormatSettings;
|
|
||||||
|
|
||||||
// --- Number format parameters --
|
|
||||||
// Decimal separator
|
|
||||||
Result.DecimalSeparator := FCbDecimalSeparator.Separator;
|
|
||||||
// Thousand separator
|
|
||||||
Result.ThousandSeparator := FCbThousandSeparator.Separator;
|
|
||||||
|
|
||||||
// --- Currency format parameters ---
|
|
||||||
// Currency symbol
|
|
||||||
Result.CurrencyString := EdCurrencySymbol.Text;
|
|
||||||
// Currency decimal places
|
|
||||||
Result.CurrencyDecimals := EdCurrencyDecimals.Value;
|
|
||||||
// Positive currency format
|
|
||||||
Result.CurrencyFormat := CbPosCurrencyFormat.ItemIndex;
|
|
||||||
// Negative currency format
|
|
||||||
Result.NegCurrFormat := CbNegCurrencyFormat.ItemIndex;
|
|
||||||
|
|
||||||
// --- Date format parameters ---
|
|
||||||
// Long date format string
|
|
||||||
Result.LongDateFormat := CbLongDateFormat.Text;
|
|
||||||
// Short date format string
|
|
||||||
Result.ShortDateFormat := CbShortDateFormat.Text;
|
|
||||||
// Date separator
|
|
||||||
Result.DateSeparator := FCbDateSeparator.Separator;
|
|
||||||
// Long month names
|
|
||||||
FEdLongMonthNames.GetNames(Result.LongMonthNames);
|
|
||||||
// Short month names
|
|
||||||
FEdShortMonthNames.GetNames(Result.ShortMonthNames);
|
|
||||||
// Long day names
|
|
||||||
FEdLongDayNames.GetNames(Result.LongDayNames);
|
|
||||||
// Short day names
|
|
||||||
FEdShortDayNames.GetNames(Result.ShortDayNames);
|
|
||||||
|
|
||||||
// --- Time format parameters ---
|
|
||||||
// Long time format string
|
|
||||||
Result.LongTimeFormat := CbLongTimeFormat.Text;
|
|
||||||
// Short time format string
|
|
||||||
Result.ShortTimeFormat := CbShortTimeFormat.Text;
|
|
||||||
// Time separator
|
|
||||||
Result.TimeSeparator := FCbTimeSeparator.Separator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFormatSettingsForm.SetFormatSettings(const AValue: TFormatSettings);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
// --- Number format parameters ---
|
|
||||||
FCbDecimalSeparator.Separator := AValue.DecimalSeparator;
|
|
||||||
FCbThousandSeparator.Separator := AValue.ThousandSeparator;
|
|
||||||
|
|
||||||
// --- Currency format parameters ---
|
|
||||||
// Currency symbol
|
|
||||||
EdCurrencySymbol.Text := AValue.CurrencyString;
|
|
||||||
// Currency decimal places
|
|
||||||
EdCurrencyDecimals.Value := AValue.CurrencyDecimals;
|
|
||||||
// Positive currency format
|
|
||||||
CbPosCurrencyFormat.ItemIndex := AValue.CurrencyFormat;
|
|
||||||
// Negative currency format
|
|
||||||
CbNegCurrencyFormat.ItemIndex := AValue.NegCurrFormat;
|
|
||||||
|
|
||||||
// --- Date format parameters ---
|
|
||||||
// Long date format string
|
|
||||||
i := CbLongDateFormat.Items.IndexOf(AValue.LongDateFormat);
|
|
||||||
if i = -1 then
|
|
||||||
CbLongDateFormat.ItemIndex := CbLongDateFormat.Items.Add(AValue.LongDateFormat)
|
|
||||||
else
|
|
||||||
CbLongDateFormat.ItemIndex := i;
|
|
||||||
// Short date format string
|
|
||||||
i := CbShortDateFormat.Items.IndexOf(AValue.ShortDateFormat);
|
|
||||||
if i = -1 then
|
|
||||||
CbShortDateFormat.ItemIndex := CbShortDateFormat.items.Add(AValue.ShortDateFormat)
|
|
||||||
else
|
|
||||||
CbShortDateFormat.ItemIndex := i;
|
|
||||||
// Date separator
|
|
||||||
FCbDateSeparator.Separator := AValue.DateSeparator;
|
|
||||||
// Long month names
|
|
||||||
FEdLongMonthNames.SetNames(AValue.LongMonthNames, 12, false, 'Error');
|
|
||||||
// Short month names
|
|
||||||
FEdShortMonthNames.SetNames(AValue.ShortMonthNames, 12, true, 'Error');
|
|
||||||
// Long day names
|
|
||||||
FEdLongDayNames.SetNames(AValue.LongDayNames, 7, false, 'Error');
|
|
||||||
// Short month names
|
|
||||||
FEdShortDayNames.SetNames(AValue.ShortDayNames, 7, true, 'Error');
|
|
||||||
|
|
||||||
// --- Time format parameters ---
|
|
||||||
|
|
||||||
// Long time format string
|
|
||||||
i := CbLongTimeFormat.items.IndexOf(AValue.LongTimeFormat);
|
|
||||||
if i = -1 then
|
|
||||||
CbLongTimeFormat.ItemIndex := CbLongTimeFormat.Items.Add(AValue.LongTimeFormat)
|
|
||||||
else
|
|
||||||
CbLongTimeFormat.ItemIndex := i;
|
|
||||||
// Short time format string
|
|
||||||
i := cbShortTimeFormat.Items.IndexOf(AValue.ShortTimeFormat);
|
|
||||||
if i = -1 then
|
|
||||||
CbShortTimeFormat.itemIndex := CbShortTimeFormat.Items.Add(AValue.ShortTimeFormat);
|
|
||||||
// Time separator
|
|
||||||
FCbTimeSeparator.Separator := AValue.TimeSeparator;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TFormatSettingsForm.ValidData(out AControl: TWinControl;
|
|
||||||
out AMsg: String): Boolean;
|
|
||||||
begin
|
|
||||||
Result := false;
|
|
||||||
if FCbDecimalSeparator.Separator = FCbThousandSeparator.Separator then
|
|
||||||
begin
|
|
||||||
AControl := FCbDecimalSeparator;
|
|
||||||
AMsg := 'Decimal and thousand separators cannot be the same.';
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
Result := true;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//initialization
|
|
||||||
// {$I sformatsettingsform.lrs}
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,813 +0,0 @@
|
|||||||
object HyperlinkForm: THyperlinkForm
|
|
||||||
Left = 327
|
|
||||||
Height = 386
|
|
||||||
Top = 259
|
|
||||||
Width = 498
|
|
||||||
Caption = 'Hyperlink'
|
|
||||||
ClientHeight = 386
|
|
||||||
ClientWidth = 498
|
|
||||||
OnCreate = FormCreate
|
|
||||||
ShowHint = True
|
|
||||||
LCLVersion = '1.5'
|
|
||||||
object ButtonPanel1: TButtonPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 34
|
|
||||||
Top = 346
|
|
||||||
Width = 486
|
|
||||||
OKButton.Name = 'OKButton'
|
|
||||||
OKButton.DefaultCaption = True
|
|
||||||
OKButton.OnClick = OKButtonClick
|
|
||||||
HelpButton.Name = 'HelpButton'
|
|
||||||
HelpButton.DefaultCaption = True
|
|
||||||
CloseButton.Name = 'CloseButton'
|
|
||||||
CloseButton.DefaultCaption = True
|
|
||||||
CancelButton.Name = 'CancelButton'
|
|
||||||
CancelButton.DefaultCaption = True
|
|
||||||
TabOrder = 0
|
|
||||||
ShowButtons = [pbOK, pbCancel]
|
|
||||||
end
|
|
||||||
object Panel2: TPanel
|
|
||||||
Left = 75
|
|
||||||
Height = 340
|
|
||||||
Top = 0
|
|
||||||
Width = 423
|
|
||||||
Align = alClient
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 340
|
|
||||||
ClientWidth = 423
|
|
||||||
TabOrder = 1
|
|
||||||
object Notebook: TNotebook
|
|
||||||
Left = 4
|
|
||||||
Height = 246
|
|
||||||
Top = 4
|
|
||||||
Width = 415
|
|
||||||
PageIndex = 2
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
TabOrder = 0
|
|
||||||
TabStop = True
|
|
||||||
object PgInternal: TPage
|
|
||||||
object GroupBox2: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 80
|
|
||||||
Top = 0
|
|
||||||
Width = 415
|
|
||||||
Align = alTop
|
|
||||||
Caption = 'Target within current workbook'
|
|
||||||
ClientHeight = 60
|
|
||||||
ClientWidth = 411
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object CbWorksheets: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 24
|
|
||||||
Width = 210
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnChange = UpdateHyperlinkInfo
|
|
||||||
ParentFont = False
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object Label5: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 6
|
|
||||||
Width = 59
|
|
||||||
Caption = 'Worksheet:'
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object Label6: TLabel
|
|
||||||
Left = 226
|
|
||||||
Height = 15
|
|
||||||
Top = 8
|
|
||||||
Width = 66
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Cell address:'
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object CbCellAddress: TComboBox
|
|
||||||
Left = 226
|
|
||||||
Height = 23
|
|
||||||
Top = 24
|
|
||||||
Width = 176
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnChange = UpdateHyperlinkInfo
|
|
||||||
OnEditingDone = CbCellAddressEditingDone
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgFile: TPage
|
|
||||||
object GbFileName: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 64
|
|
||||||
Top = 0
|
|
||||||
Width = 407
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
Caption = 'File / Document'
|
|
||||||
ClientHeight = 44
|
|
||||||
ClientWidth = 403
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object CbFileName: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 8
|
|
||||||
Width = 307
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnChange = UpdateHyperlinkInfo
|
|
||||||
OnEditingDone = CbFileNameEditingDone
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object BtnBrowseFile: TButton
|
|
||||||
Left = 320
|
|
||||||
Height = 23
|
|
||||||
Top = 8
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Browse...'
|
|
||||||
OnClick = BtnBrowseFileClick
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object GbFileBookmark: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 64
|
|
||||||
Top = 72
|
|
||||||
Width = 407
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
Caption = 'Bookmark within document'
|
|
||||||
ClientHeight = 44
|
|
||||||
ClientWidth = 403
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
object CbFileBookmark: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 8
|
|
||||||
Width = 387
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnChange = UpdateHyperlinkInfo
|
|
||||||
OnDropDown = CbFileBookmarkDropDown
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgInternet: TPage
|
|
||||||
object GbInternetLinkType: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 64
|
|
||||||
Top = 0
|
|
||||||
Width = 407
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
Caption = 'Type of link'
|
|
||||||
ClientHeight = 44
|
|
||||||
ClientWidth = 403
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object RbHTTP: TRadioButton
|
|
||||||
Left = 11
|
|
||||||
Height = 19
|
|
||||||
Top = 7
|
|
||||||
Width = 42
|
|
||||||
Caption = 'http'
|
|
||||||
Checked = True
|
|
||||||
OnChange = HTTP_FTP_Change
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
TabStop = True
|
|
||||||
end
|
|
||||||
object RbFTP: TRadioButton
|
|
||||||
Left = 77
|
|
||||||
Height = 19
|
|
||||||
Top = 7
|
|
||||||
Width = 35
|
|
||||||
Caption = 'ftp'
|
|
||||||
OnChange = HTTP_FTP_Change
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object InternetNotebook: TNotebook
|
|
||||||
Left = 0
|
|
||||||
Height = 182
|
|
||||||
Top = 64
|
|
||||||
Width = 415
|
|
||||||
PageIndex = 1
|
|
||||||
Align = alClient
|
|
||||||
TabOrder = 1
|
|
||||||
TabStop = True
|
|
||||||
object PgHTTP: TPage
|
|
||||||
object GbHttp: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 144
|
|
||||||
Top = 8
|
|
||||||
Width = 407
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Top = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
Caption = 'Bookmark within document'
|
|
||||||
ClientHeight = 124
|
|
||||||
ClientWidth = 403
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object CbHttpAddress: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 32
|
|
||||||
Width = 384
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnEditingDone = CbHttpAddressEditingDone
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object EdHttpBookmark: TEdit
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 86
|
|
||||||
Width = 384
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object LblHttpAddress: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 8
|
|
||||||
Width = 121
|
|
||||||
Caption = 'URL of web document;'
|
|
||||||
FocusControl = CbHttpAddress
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object LblHttpBookmark: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 64
|
|
||||||
Width = 151
|
|
||||||
Caption = 'Bookmark within document:'
|
|
||||||
FocusControl = EdHttpBookmark
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PfFTP: TPage
|
|
||||||
object GbFtp: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 144
|
|
||||||
Top = 8
|
|
||||||
Width = 407
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Top = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
Caption = 'ftp server'
|
|
||||||
ClientHeight = 124
|
|
||||||
ClientWidth = 403
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object CbFtpServer: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 32
|
|
||||||
Width = 384
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnEditingDone = CbFtpServerEditingDone
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object Label1: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 10
|
|
||||||
Width = 35
|
|
||||||
Caption = 'Server:'
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object LblFtpUserName: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 64
|
|
||||||
Width = 59
|
|
||||||
Caption = 'User name:'
|
|
||||||
FocusControl = CbFtpUsername
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object CbFtpUsername: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 86
|
|
||||||
Width = 190
|
|
||||||
ItemHeight = 15
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object LblFtpPassword: TLabel
|
|
||||||
Left = 208
|
|
||||||
Height = 15
|
|
||||||
Top = 64
|
|
||||||
Width = 53
|
|
||||||
Caption = 'Password:'
|
|
||||||
FocusControl = CbFtpPassword
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object CbFtpPassword: TComboBox
|
|
||||||
Left = 208
|
|
||||||
Height = 23
|
|
||||||
Top = 86
|
|
||||||
Width = 182
|
|
||||||
ItemHeight = 15
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object PgMail: TPage
|
|
||||||
object GbMailRecipient: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 60
|
|
||||||
Top = 0
|
|
||||||
Width = 415
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
Caption = 'Mail address of recipient'
|
|
||||||
ClientHeight = 40
|
|
||||||
ClientWidth = 411
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object CbMailRecipient: TComboBox
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 6
|
|
||||||
Width = 397
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnEditingDone = CbMailRecipientEditingDone
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object GroupBox8: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 60
|
|
||||||
Top = 68
|
|
||||||
Width = 415
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
Caption = 'Subject'
|
|
||||||
ClientHeight = 40
|
|
||||||
ClientWidth = 411
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
object EdMailSubject: TEdit
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 6
|
|
||||||
Width = 397
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
OnChange = UpdateHyperlinkInfo
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object HyperlinkInfo: TLabel
|
|
||||||
Left = 8
|
|
||||||
Height = 15
|
|
||||||
Top = 321
|
|
||||||
Width = 407
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Left = 8
|
|
||||||
BorderSpacing.Top = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Bottom = 4
|
|
||||||
Caption = 'HyperlinkInfo'
|
|
||||||
ParentColor = False
|
|
||||||
WordWrap = True
|
|
||||||
end
|
|
||||||
object Bevel1: TBevel
|
|
||||||
Left = 4
|
|
||||||
Height = 3
|
|
||||||
Top = 310
|
|
||||||
Width = 415
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Left = 4
|
|
||||||
BorderSpacing.Right = 4
|
|
||||||
Shape = bsBottomLine
|
|
||||||
end
|
|
||||||
object GroupBox6: TGroupBox
|
|
||||||
Left = 0
|
|
||||||
Height = 56
|
|
||||||
Top = 254
|
|
||||||
Width = 415
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
Caption = 'Cell tooltip'
|
|
||||||
ClientHeight = 36
|
|
||||||
ClientWidth = 411
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
object EdTooltip: TEdit
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Top = 3
|
|
||||||
Width = 392
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
Text = 'EdTooltip'
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object ToolBar: TToolBar
|
|
||||||
Left = 4
|
|
||||||
Height = 336
|
|
||||||
Top = 4
|
|
||||||
Width = 67
|
|
||||||
Align = alLeft
|
|
||||||
AutoSize = True
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
ButtonHeight = 56
|
|
||||||
ButtonWidth = 64
|
|
||||||
Caption = 'ToolBar'
|
|
||||||
Color = clWindow
|
|
||||||
EdgeBorders = [ebLeft, ebTop, ebRight, ebBottom]
|
|
||||||
EdgeInner = esNone
|
|
||||||
Images = Images
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
ShowCaptions = True
|
|
||||||
TabOrder = 2
|
|
||||||
Wrapable = False
|
|
||||||
object TbInternal: TToolButton
|
|
||||||
Left = 2
|
|
||||||
Top = 1
|
|
||||||
AllowAllUp = True
|
|
||||||
Caption = 'internal'
|
|
||||||
Down = True
|
|
||||||
ImageIndex = 0
|
|
||||||
OnClick = ToolButtonClick
|
|
||||||
end
|
|
||||||
object TbFile: TToolButton
|
|
||||||
Tag = 1
|
|
||||||
Left = 2
|
|
||||||
Top = 57
|
|
||||||
AllowAllUp = True
|
|
||||||
Caption = 'File'
|
|
||||||
ImageIndex = 1
|
|
||||||
OnClick = ToolButtonClick
|
|
||||||
end
|
|
||||||
object TbInternet: TToolButton
|
|
||||||
Tag = 2
|
|
||||||
Left = 2
|
|
||||||
Top = 113
|
|
||||||
AllowAllUp = True
|
|
||||||
Caption = 'Internet'
|
|
||||||
ImageIndex = 2
|
|
||||||
OnClick = ToolButtonClick
|
|
||||||
end
|
|
||||||
object TbMail: TToolButton
|
|
||||||
Tag = 3
|
|
||||||
Left = 2
|
|
||||||
Top = 169
|
|
||||||
AllowAllUp = True
|
|
||||||
Caption = 'Mail'
|
|
||||||
ImageIndex = 3
|
|
||||||
OnClick = ToolButtonClick
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object Images: TImageList
|
|
||||||
Height = 24
|
|
||||||
Width = 24
|
|
||||||
left = 48
|
|
||||||
top = 296
|
|
||||||
Bitmap = {
|
|
||||||
4C69040000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF007E7E54007F7F554D7F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F554DFFFFFF007E7E54007E7E5467FFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF7D7D5467FFFFFF007C7C52007C7C5268FFFFFFFFFEFEFEFFFEFE
|
|
||||||
FEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFE
|
|
||||||
FEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFE
|
|
||||||
FEFFFFFFFFFF7B7B5268FFFFFF007A7A51007A7A5168FEFEFDFFFDFDFCFFFFCC
|
|
||||||
44FFFECB43FFFECB43FFFDCA42FFFCC941FFFAC73FFFF9C63EFFF8C53DFFF6C3
|
|
||||||
3CFFF5C23AFFF4C139FFF3C038FFF1BE36FFF0BD35FFEFBC34FFEFBC34FFFDFD
|
|
||||||
FCFFFEFEFDFF79795069FFFFFF0078784F0078784F69FEFEFCFFFCFCFAFFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFFDCA42FFFCEB85FFFBEA84FFF9C63EFFF8E781FFF6E5
|
|
||||||
80FFF5C23AFFF4E37DFFF2E17BFFF1BE36FFF0DF79FFEFDE78FFEFBC34FFFCFC
|
|
||||||
FAFFFEFEFCFF76764E6AFFFFFF0076764D0076764D6AFDFDFAFFFBFBF8FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFFDCA42FFFCEB85FFFBEA84FFF9C63EFFF8E781FFF6E5
|
|
||||||
80FFF5C23AFFF4E37DFFF2E17BFFF1BE36FFF0DF79FFEFDE78FFEFBC34FFFBFB
|
|
||||||
F8FFFDFDFAFF74744B6BFFFFFF0073734B0073734B6BFDFDF9FFFAFAF6FFFFCC
|
|
||||||
44FFFECB43FFFECB43FFF5CE64FFEBD285FFE9D083FFE8CF82FFE7CE81FFE5CC
|
|
||||||
80FFE4CB7EFFE3CA7DFFE2C97CFFE0C77AFFDFC679FFDEC578FFDEC578FFFAFA
|
|
||||||
F6FFFDFDF9FF7171496CFFFFFF00717149007171496CFCFCF8FFF8F8F4FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFFCFCFAFFFCFCFAFFD7D7C6FFFCFCFAFFFCFC
|
|
||||||
FAFFD3D3C2FFFCFCFAFFFCFCFAFFCFCFBEFFFCFCFAFFFCFCFAFFCDCDBCFFF8F8
|
|
||||||
F4FFFCFCF8FF6E6E466DFFFFFF006E6E46006E6E466DFBFBF6FFF7F7F1FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFFBFBF8FFFBFBF8FFD7D7C6FFFBFBF8FFFBFB
|
|
||||||
F8FFD3D3C2FFFBFBF8FFFBFBF8FFCFCFBEFFFBFBF8FFFBFBF8FFCDCDBCFFF7F7
|
|
||||||
F1FFFBFBF6FF6A6A436EFFFFFF006B6B44006B6B446EFAFAF4FFF5F5EFFFFFCC
|
|
||||||
44FFFECB43FFFECB43FFECD286FFDADAC9FFD8D8C7FFDFDFD0FFD6D6C5FFD4D4
|
|
||||||
C3FFDCDCCEFFD2D2C1FFD1D1C0FFD9D9CBFFCECEBDFFCDCDBCFFCDCDBCFFF5F5
|
|
||||||
EFFFFAFAF4FF67674070FFFFFF00686841006868416FFAFAF2FFF4F4ECFFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFFAFAF6FFFAFAF6FFD7D7C6FFFAFAF6FFFAFA
|
|
||||||
F6FFD3D3C2FFFAFAF6FFFAFAF6FFCFCFBEFFFAFAF6FFFAFAF6FFCDCDBCFFF4F4
|
|
||||||
ECFFFAFAF2FF63633D71FFFFFF0065653F0065653F70F9F9F0FFF2F2E9FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFF9F9F4FFF9F9F4FFD7D7C6FFF9F9F4FFF9F9
|
|
||||||
F4FFD3D3C2FFF9F9F4FFF9F9F4FFCFCFBEFFF9F9F4FFF9F9F4FFCDCDBCFFF2F2
|
|
||||||
E9FFF9F9F0FF60603A73FFFFFF0062623C0062623C72F8F8EEFFF0F0E6FFFFCC
|
|
||||||
44FFFECB43FFFECB43FFECD286FFDADAC9FFD8D8C7FFDDDDCEFFD6D6C5FFD4D4
|
|
||||||
C3FFDBDBCCFFD2D2C1FFD1D1C0FFD8D8C9FFCECEBDFFCDCDBCFFCDCDBCFFF0F0
|
|
||||||
E6FFF8F8EEFF5C5C3674FFFFFF005F5F39005F5F3973F7F7ECFFEFEFE4FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFF7F7F2FFF7F7F2FFD7D7C6FFF7F7F2FFF7F7
|
|
||||||
F2FFD3D3C2FFF7F7F2FFF7F7F2FFCFCFBEFFF7F7F2FFF7F7F2FFCDCDBCFFEFEF
|
|
||||||
E4FFF7F7ECFF58583375FFFFFF005C5C36005C5C3674F6F6EBFFEDEDE1FFFFCC
|
|
||||||
44FFFFEE88FFFEED87FFECD286FFF6F6F1FFF6F6F1FFD7D7C6FFF6F6F1FFF6F6
|
|
||||||
F1FFD3D3C2FFF6F6F1FFF6F6F1FFCFCFBEFFF6F6F1FFF6F6F1FFCDCDBCFFEDED
|
|
||||||
E1FFF6F6EBFF55553077FFFFFF005959340059593475F6F6E9FFECECDFFFFFCC
|
|
||||||
44FFFECB43FFFECB43FFECD286FFDADAC9FFD8D8C7FFD7D7C6FFD6D6C5FFD4D4
|
|
||||||
C3FFD3D3C2FFD2D2C1FFD1D1C0FFCFCFBEFFCECEBDFFCDCDBCFFCDCDBCFFECEC
|
|
||||||
DFFFF6F6E9FF50502B79FFFFFF005656310056563177F5F5E7FFEAEADDFFEAEA
|
|
||||||
DDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEA
|
|
||||||
DDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEADDFFEAEA
|
|
||||||
DDFFF5F5E7FF42421F7FFFFFFF0052522E0052522E78F4F4E6FFE9E9DBFFE9E9
|
|
||||||
DBFFE9E9DBFFE9E9DBFFEFEFE0FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4
|
|
||||||
E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4E6FFF4F4
|
|
||||||
E6FFFAFAEBFF34341384FFFFFF00494925004949257CF4F4E5FFE8E8D9FFE8E8
|
|
||||||
D9FFE8E8D9FFE8E8D9FFF4F4E5FFAAAA99FFAAAA99FFAAAA99FFAAAA99FFAAAA
|
|
||||||
99FFAAAA99FFAAAA99FF29290988292909882929098829290988292909882929
|
|
||||||
0988292909882A2A0A66FFFFFF003C3C1A003C3C1A80F5F5E5FFE7E7D7FFE7E7
|
|
||||||
D7FFE7E7D7FFE7E7D7FFF5F5E5FF67674FC5F5F5E5FFE7E7D7FFE7E7D7FFE7E7
|
|
||||||
D7FFE7E7D7FFF5F5E5FF2323048A262607002727070027270700272707002727
|
|
||||||
07002727070029290900FFFFFF000D0D050031311174D4D4C0DCF4F4E3FFF3F3
|
|
||||||
E2FFF3F3E2FFF4F4E3FFD4D4C0DC2323048AD0D0BDDEF4F4E3FFF3F3E2FFF3F3
|
|
||||||
E2FFF4F4E3FFD0D0BDDE23230479090901000000000000000000000000000000
|
|
||||||
00000000000000000000FFFFFF0000000011171705402727097B282809882828
|
|
||||||
098828280988282809882727097B1A1A035F2222047C2323048A2323048A2323
|
|
||||||
048A2323048A2222047C1212024C0000002F000000280000001F000000160000
|
|
||||||
000D0000000600000001FFFFFF000000000000000012000000190000001A0000
|
|
||||||
001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000
|
|
||||||
001A0000001A0000001A0000001A0000001800000014000000100000000B0000
|
|
||||||
00070000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000088CB000088CB000088
|
|
||||||
CC410088CC810088CC810088CC810088CC810088CC810088CC810088CC810088
|
|
||||||
CC810088CC810088CC810088CC810088CC810088CC810088CC810088CC610088
|
|
||||||
CB000088CB00FFFFFF00FFFFFF00FFFFFF00FFFFFF000087CB000087CB000087
|
|
||||||
CB826FCCECE092E1F7FFADF1FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2
|
|
||||||
FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2FFFFB1F5FFFF0087CB820087
|
|
||||||
CB000087CB00FFFFFF00FFFFFF00FFFFFF00FFFFFF000086C9000086C9000086
|
|
||||||
C983B0F5FFFF91E1F6FF5DC0E7FF72CCEEFF8CDCF6FFA6ECFEFFA8EDFEFFA8ED
|
|
||||||
FEFFA8EDFEFFA8EDFEFFA8EDFEFFA8EDFEFFA8EDFEFFADF2FFFF0086C9830086
|
|
||||||
C9000086C900FFFFFF00FFFFFF00FFFFFF00FFFFFF000085C8000085C8000085
|
|
||||||
C885ADF1FFFFABEFFEFFACF1FEFF8FDFF5FF69C7EAFF59BCE6FF76C9E6FFA6EB
|
|
||||||
FDFFA6EBFDFFA6EBFDFFA6EBFDFFA6EBFDFFA6EBFDFFABF0FEFF0085C8850085
|
|
||||||
C8000085C800FFFFFF00FFFFFF00FFFFFF00FFFFFF000084C6000084C6000084
|
|
||||||
C687ABEFFEFFA6EAFDFFA6EAFDFFA9EEFDFFADF1FEFFA1EAFAFF4FAFD8FF9BDC
|
|
||||||
EEFFA2E6F9FFA4E9FCFFA4E9FCFFA4E9FCFFA4E9FCFFA9EEFDFF0084C6870084
|
|
||||||
C6000084C600FFFFFF00FFFFFF00FFFFFF00FFFFFF000083C4000083C4000083
|
|
||||||
C489A8EEFDFFA3E9FCFFA3E9FCFFA3E9FCFFA3E9FCFFADF2FEFF49AEDAFF91CF
|
|
||||||
E1FF91CFE1FF97D8EBFF9FE4F7FFA1E6FAFFA1E6FAFFA6EBFCFF0083C4890083
|
|
||||||
C4000083C400FFFFFF00FFFFFF00FFFFFF00FFFFFF000081C2000081C2000081
|
|
||||||
C28BA6ECFCFFA1E7FBFFA1E7FBFFA1E7FBFFA1E7FBFFABF0FDFF41A5D2FF8ECD
|
|
||||||
E0FF8ECDE0FF8ECDE0FF96D9EDFF9EE4F9FF9EE4F9FFA4E9FBFF0081C28B0081
|
|
||||||
C2000081C200FFFFFF00FFFFFF00FFFFFF00FFFFFF000080C0000080C0000080
|
|
||||||
C08DA4E9FBFF9EE4F9FF9EE4F9FF9EE4F9FF9EE4F9FFA9EEFCFF3A9BC7FF8ACA
|
|
||||||
DEFF8ACADEFF8ACADEFF92D6EBFF9AE1F7FF9AE1F7FFA0E6F9FF0080C08D0080
|
|
||||||
C0000080C000FFFFFF00FFFFFF00FFFFFF00FFFFFF00007EBD00007EBD00007E
|
|
||||||
BD8FA1E7FAFF9BE2F8FF9BE2F8FF9BE2F8FF9BE2F8FFA7ECFCFF3696C2FF88C7
|
|
||||||
DDFF88C7DDFF88C7DDFF90D3EAFF97DEF6FF97DEF6FF9DE4F9FF007EBD8F007E
|
|
||||||
BD00007DBB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00007DBB00007DBB00007D
|
|
||||||
BB919EE5F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FFA4EAFBFF3393BFFF84C5
|
|
||||||
DBFF84C5DBFF84C5DBFF8CD0E8FF93DBF4FF93DBF4FF9AE1F7FF007DBB91007D
|
|
||||||
BB33007BB800FFFFFF00FFFFFF00FFFFFF00FFFFFF00007BB800007BB800007B
|
|
||||||
B8949CE3F8FF95DDF5FF95DDF5FF95DDF5FF95DDF5FFA2E8FAFF318FBCFF81C2
|
|
||||||
D9FF81C2D9FF81C2D9FF89CDE6FF90D8F2FF90D8F2FF90D8F2FF90D8F2FF007B
|
|
||||||
B894007BB834FFFFFF00FFFFFF00FFFFFF00FFFFFF000079B6000079B6000079
|
|
||||||
B69699E0F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF9FE5F9FF2E8CB8FF7EBF
|
|
||||||
D8FF7EBFD8FF7EBFD8FF85CAE4FF8CD5F0FF8CD5F0FF8CD5F0FFFEFEFDFF8CD5
|
|
||||||
F0FF0079B696FFFFFF00FFFFFF00FFFFFF00FFFFFF000077B3000077B3000077
|
|
||||||
B39996DEF6FF8FD8F2FF8FD8F2FF8FD8F2FF8FD8F2FF9CE3F9FF2B88B5FF7BBD
|
|
||||||
D6FF7BBDD6FF7BBDD6FF82C8E2FF89D2EEFF89D2EEFF89D2EEFFF8F8F3FF89D2
|
|
||||||
EEFF0077B399FFFFFF00FFFFFF00FFFFFF00FFFFFF000076B0000076B0000076
|
|
||||||
B09B93DBF4FF8CD5F0FF8CD5F0FF8CD5F0FF8CD5F0FF9AE0F8FF2986B2FF78BA
|
|
||||||
D5FF78BAD5FF78BAD5FF7FC5E1FF85CFEDFF85CFEDFF85CFEDFFF0F0E6FF85CF
|
|
||||||
EDFF0076B09BFFFFFF00FFFFFF00FFFFFF00FFFFFF000074AE000074AE000074
|
|
||||||
AE9E90D8F3FF89D2EEFF89D2EEFF89D2EEFF89D2EEFF97DEF7FF2682AFFF75B8
|
|
||||||
D3FF75B8D3FF75B8D3FF7CC3DFFF82CDEBFF82CDEBFF82CDEBFFE9E9DBFF82CD
|
|
||||||
EBFF0074AE9EFFFFFF00FFFFFF00FFFFFF00FFFFFF000072AB000072AB000072
|
|
||||||
ABA08ED6F2FF86D0EDFF86D0EDFF86D0EDFF86D0EDFF95DCF6FF257FACFF72B5
|
|
||||||
D2FF72B5D2FF72B5D2FF79C0DEFF7FCAEAFF7FCAEAFF7FCAEAFFFEC941FF7FCA
|
|
||||||
EAFF0072ABA0FFFFFF00FFFFFF00FFFFFF00FFFFFF00006EA600006EA600006E
|
|
||||||
A6A58BD4F0FF83CEEBFF83CEEBFF83CEEBFF83CEEBFF93DAF5FF237DA9FF70B4
|
|
||||||
D0FF70B4D0FF70B4D0FF77BEDCFF7DC8E8FF7DC8E8FF7DC8E8FFF4B62EFF7DC8
|
|
||||||
E8FF006EA6A5FFFFFF00FFFFFF00FFFFFF00FFFFFF00001B280000679B000067
|
|
||||||
9BAF89D2F0FF81CBEAFF81CBEAFF81CBEAFF81CBEAFF91D8F5FF217AA6FF6EB2
|
|
||||||
CFFF6EB2CFFF6EB2CFFF75BCDBFF7BC6E7FF7BC6E7FF7BC6E7FF7BC6E7FF0067
|
|
||||||
9BAF00689D3DFFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000001925000061
|
|
||||||
91B887D0EFFF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF8ED6F4FF227AA5FF74B6
|
|
||||||
D4FF74B6D4FF74B6D4FF7BC1E1FF81CBECFF81CBECFF81CBECFF006191B80049
|
|
||||||
6E41001A2600FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000011000000260045
|
|
||||||
689C3590BCF269B8DCFA82CCECFF7CC7E8FF7CC7E8FF8CD4F4FF005C8BEF004F
|
|
||||||
77C6004F77C6004F77C6005885C2005B8AC0005B8AC0005B8AC00045689C0000
|
|
||||||
002300000010FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000009000000130000
|
|
||||||
001A005C8A5B0062939F368FBAD16BBADEED80CAEBFF8BD3F3FF005884C70000
|
|
||||||
0031000000310000001F0000001A0000001A0000001A0000001A0000001A0000
|
|
||||||
001200000008FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
|
|
||||||
0000005D8C0000649700006191530060909E1B76A3C551A2CAE2005A88C20000
|
|
||||||
001A000000070000000000000000000000000000000000000000000000000000
|
|
||||||
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
|
|
||||||
0000005D8C000064970000609000005E8E00005C8A31005B897E005986930000
|
|
||||||
0007000000000000000000000000000000000000000000000000000000000000
|
|
||||||
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CF7A0200CF7A0200CF7A0200D47E
|
|
||||||
0200DC830300E2880300E58A0313E68B034EE78B0388E78B03A6E78B03B8E78B
|
|
||||||
03B8E78B03A6E78B0388E68B034EE58A0313E2880300DC830300D47E0200CF7A
|
|
||||||
0200CF7A0200CF7A0200FFFFFF00FFFFFF00CF7A0200CF7A0200CF7A0200D47E
|
|
||||||
0200DC83030DE0870363E38F13B5EDB459D5F7DCA4EBFBECC5F7FCF3D3FDFCF4
|
|
||||||
D4FDFCEEC7F7F7DCA4EBEDB459D5E38F13B5E0870363DC83030DD47E0200CF7A
|
|
||||||
0200CF7A0200CF7A0200FFFFFF00FFFFFF00CF7A0200CF7A0200CF7A0200D47E
|
|
||||||
021CD780039DE1A146D7EBC68CF7E9C48EFFEAC792FFF0D19EFFF2D4A2FFEFD5
|
|
||||||
A8FFFFFAD7FFFFFAD4FFFFFAD4FFFBEDC2F7E8B25BD7D780039DD47E021CCF7A
|
|
||||||
0200CF7A0200CF7A0200FFFFFF00FFFFFF00C3710200C5730200CB77021CCF7E
|
|
||||||
0CAEE7BD78E5EDCC90FFEBC788FFF7E7BBFFF9EDC5FFF1D29FFFF8DBA5FFF2D7
|
|
||||||
A8FFFCF4D2FFFFFAD6FFFFF9D1FFFFF8CBFFFFF9CDFFEDC986E5CF7E0CAECB77
|
|
||||||
021CC5730200C3710200FFFFFF00FFFFFF00B6680200BA6B020DC070039FE8C3
|
|
||||||
82E5E1B570FFE0AD5FFFF1D9A2FFFFF7CCFFFFF7D0FFF5E0B2FFF1D199FFEED1
|
|
||||||
A0FFEDD4AAFFFFF7D0FFFFF7CCFFFFF6C6FFFFF5BFFFFFF5C1FFE8C382E5C070
|
|
||||||
039FBA6B020DB6680200FFFFFF00FFFFFF00B0640200B3660266D19C50D9E2BA
|
|
||||||
7AFFE6BE76FFE1B771FFFAE6AFFFFFF0BFFFF7E2B2FFE9C487FFE6BE81FFFDEE
|
|
||||||
C4FFFAEABEFFFAE7B9FFFFEFBDFFFFEFB9FFFFEDB4FFFFECAFFFFFEEB7FFD29E
|
|
||||||
52D9B3660266B0640200FFFFFF00FFFFFF00A75D0114AE670EBCD7A866F8D498
|
|
||||||
3AFFE8BD6EFFD49F52FFFCE0A2FFF1D194FFDAA85EFFE5B86AFFDEB16DFFFFEA
|
|
||||||
B5FFFFE9B4FFE0B87BFFD4A25CFFF9DD9FFFFFE5A4FFFFE4A1FFFADB98FFD09E
|
|
||||||
5DF8AB630ABCA75D0114FFFFFF00FFFFFF009B530153BB833DDBCB903DFFD599
|
|
||||||
38FFD79C3AFFD49A3EFFE3B364FFD59F4AFFDDA84FFFDEAB53FFD7A457FFFDDC
|
|
||||||
9BFFE9BF7CFFE1B266FFCD9441FFEDC27AFFFFDA92FFF0C67DFFFFD98FFFE1B0
|
|
||||||
66FFB4782EDB9B530153FFFFFF00FFFFFF00914D0190C79355EFE9B160FFDA9F
|
|
||||||
47FFD39633FFD59934FFD49836FFD59B39FFD89D3CFFD89E3EFFD1973CFFD79F
|
|
||||||
4BFFC98D38FFC58731FFCF9344FFFFCF82FFFFCF80FFD29547FFCE913FFFE2AA
|
|
||||||
56FFC48E46EF914D0190FFFFFF00FFFFFF00894700B2F2C07AF8F7BB67FFD797
|
|
||||||
41FFCC8C2AFFD0922DFFD1922DFFD1932EFFD19430FFD19430FFD19430FFCB8C
|
|
||||||
2EFFDFA24EFFFFC571FFFFC470FFFCC16DFFDC9E4DFFFFC46FFFC48325FFCB8B
|
|
||||||
29FFCD9848F8894700B2FFFFFF00FFFFFF00834200C6D89C54FEC6802CFFE19B
|
|
||||||
44FFCE8A2DFFCD8A26FFCE8C26FFCE8C27FFCE8C27FFCE8C27FFCE8C27FFCB88
|
|
||||||
2AFFEDA951FFF2AD57FFFFBB62FFEEA852FFBC7720FFC17E20FFC58222FFCA88
|
|
||||||
24FFD39943FE834200C6FFFFFF00FFFFFF00804000C7C6873DFEC37C21FFE89D
|
|
||||||
41FFCB8327FFCB8722FFCC8822FFCC8822FFCC8822FFCC8822FFCC8822FFC985
|
|
||||||
22FFC98224FFBD751EFFE2973FFFFFB354FFC88026FFC57F22FFE79C40FFC67E
|
|
||||||
26FFC98C39FE804000C7FFFFFF00FFFFFF00814000B3E59F4FF8C47D1EFFC882
|
|
||||||
20FFCB8521FFCE8822FFCE8823FFCE8823FFCE8823FFCE8924FFCE8924FFCE89
|
|
||||||
24FFCC8623FFC17A1FFFF4A344FFFFAD4BFFC47A22FFCB7F27FFFFAD4AFFFBAA
|
|
||||||
48FFD99546F8814000B3FFFFFF00FFFFFF0083420092BF7B32F0CB8220FFD088
|
|
||||||
22FFD08823FFD08823FFD18924FFD18A25FFD18A26FFD18A26FFD18B26FFD18B
|
|
||||||
26FFCF8725FFD6892DFFFFAB47FFEE9C3DFFBB701BFFF39F3EFFFFAA45FFFFAA
|
|
||||||
45FFDC9544F083420092FFFFFF00FFFFFF0088450054A36018DED48A28FFD488
|
|
||||||
23FFD48924FFD58A25FFD58B27FFD68C29FFD68E2CFFD78E2EFFD78F2FFFD78F
|
|
||||||
2FFFD68D2DFFD2882AFFC77C23FFCC7F25FFDA8A2FFFFFAC46FFFFAB46FFFFAE
|
|
||||||
4AFFB57024DE88450054FFFFFF00FFFFFF008F4A0014944E04C1D3882DF9DA89
|
|
||||||
24FFDA8A26FFDB8C29FFDC8E2DFFDC9132FFDD9337FFDE953AFFDE963CFFDE96
|
|
||||||
3CFFDE953AFFDD9337FFDC9032FFD28329FFF0A242FFFFB14AFFFFB049FFF3AA
|
|
||||||
4CF9975107C18F4A0014FFFFFF00FFFFFF00954E0000974F006AB56A16DFE18D
|
|
||||||
2BFFE18C28FFE28F2EFFE39336FFE4973FFFE59C46FFE69F4CFFE6A04FFFE6A0
|
|
||||||
4FFFE69F4CFFE59C46FFE4973FFFD98932FFF0A84BFFFFB954FFFFBA56FFC07A
|
|
||||||
26DF974F006A954E0000FFFFFF00FFFFFF00995000009B52000E9F5500A7CC7A
|
|
||||||
20EAE78F2FFFE89235FFEA9840FFEB9F4DFFECA558FFEDA960FFEDAC64FFEDAC
|
|
||||||
64FFEDA960FFECA558FFEB9F4DFFE0903DFFF1B057FFFFC362FFDA983EEA9F55
|
|
||||||
00A79B52000E99500000FFFFFF00FFFFFF00A2560000A3570000A75A001DAB5D
|
|
||||||
03B7D27E22EAEE973DFFEF9D49FFF0A558FFF1AD66FFF2B16EFFF2B473FFF2B4
|
|
||||||
73FFF2B16EFFF1AD66FFF0A558FFE69446FFF3BA66FFDEA145EAAC6005B7A75A
|
|
||||||
001DA3570000A2560000FFFFFF00FFFFFF00552E0000552E0000552E0000AE5E
|
|
||||||
001DB06000A7CB771ADFEC9A46F8F5A95EFFF5AF6AFFF6B474FFF6B779FFF6B7
|
|
||||||
79FFF6B474FFF5AF6AFFF5A95EFFE59244F8CA822ADFB06000A7AE5E001D552E
|
|
||||||
0000552E0000552E0000FFFFFF00FFFFFF000000000000000000000000010000
|
|
||||||
00022E1900119A55006EBB6906C2CF7E23DEE6994BF0F0A963F8F7B271FEF7B2
|
|
||||||
71FEF0A963F8E6994BF0CF7E23DEBA6806C29C56006D2E190011000000020000
|
|
||||||
00010000000000000000FFFFFF00FFFFFF000000000000000000000000030000
|
|
||||||
000C0000001A00000024371F00376E3D006DAB5F009CB96600B5BC6800C7BC68
|
|
||||||
00C7B96600B5AB5F009C6E3D006D371F003700000024000000190000000C0000
|
|
||||||
00020000000000000000FFFFFF00FFFFFF000000000000000000000000020000
|
|
||||||
000800000011000000180000001A0000001A0000001A0000001A0000001A0000
|
|
||||||
001A0000001A0000001A0000001A0000001A0000001800000011000000080000
|
|
||||||
00010000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF007E7E54007F7F554D7F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F55667F7F
|
|
||||||
55667F7F55667F7F554D7E7E54007D7D53007D7D5367E0E0CFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFE0E0CFFF7D7D53677D7D53007A7A51007A7A5168F5F5F0FFDBDBCAFFFEFE
|
|
||||||
FDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFE
|
|
||||||
FDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFFEFEFDFFDBDB
|
|
||||||
CAFFF5F5F0FF7A7A51687A7A510077774E0077774E69FDFDFAFFEEEEE5FFD5D5
|
|
||||||
C4FFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFC
|
|
||||||
FAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFFCFCFAFFD5D5C4FFEEEE
|
|
||||||
E5FFFDFDFAFF77774E6977774E0074744C0074744C6BFDFDFAFFF8F8F3FFE6E6
|
|
||||||
DAFFCFCFBEFFFBFBF7FFFBFBF7FFFBFBF7FFFBFBF7FFFBFBF7FFFBFBF7FFFBFB
|
|
||||||
F7FFFBFBF7FFFBFBF7FFFBFBF7FFFBFBF7FFFBFBF7FFCFCFBEFFE6E6DAFFF8F8
|
|
||||||
F3FFFDFDFAFF74744C6B74744C00717148007171486CFCFCF8FFF9F9F4FFF4F4
|
|
||||||
EEFFDEDED0FFC9C9B8FFF9F9F4FFF9F9F4FFF9F9F4FFF9F9F4FFF9F9F4FFF9F9
|
|
||||||
F4FFF9F9F4FFF9F9F4FFF9F9F4FFF9F9F4FFC9C9B8FFDEDED0FFF4F4EEFFF9F9
|
|
||||||
F4FFFCFCF8FF7171486C717148006D6D45006D6D456DFBFBF5FFF6F6F0FFF6F6
|
|
||||||
F0FFF1F1E8FFD9D9C9FFC4C4B3FFF6F6F0FFF6F6F0FFF6F6F0FFF6F6F0FFF6F6
|
|
||||||
F0FFF6F6F0FFF6F6F0FFF6F6F0FFC4C4B3FFD9D9C9FFF1F1E8FFF6F6F0FFF6F6
|
|
||||||
F0FFFBFBF5FF6D6D456D6D6D4500696942006969426FFAFAF2FFF4F4ECFFF4F4
|
|
||||||
ECFFF4F4ECFFEEEEE4FFD6D6C5FFBEBEADFFF4F4ECFFF4F4ECFFF4F4ECFFF4F4
|
|
||||||
ECFFF4F4ECFFF4F4ECFFBEBEADFFD6D6C5FFEEEEE4FFF4F4ECFFF4F4ECFFF4F4
|
|
||||||
ECFFFAFAF2FF6969426F6969420065653E0065653E71F9F9F0FFF2F2E9FFF2F2
|
|
||||||
E9FFF2F2E9FFF2F2E9FFE8E8DBFFD5D5C4FFB9B9A8FFF2F2E9FFF2F2E9FFF2F2
|
|
||||||
E9FFF2F2E9FFB9B9A8FFD5D5C4FFE8E8DBFFF2F2E9FFF2F2E9FFF2F2E9FFF2F2
|
|
||||||
E9FFF9F9F0FF65653E7165653E0061613A0061613A72F8F8EDFFF0F0E5FFF0F0
|
|
||||||
E5FFF0F0E5FFEBEBDFFFDBDBCAFFECECE0FFD7D7C8FFB3B3A2FFF0F0E5FFF0F0
|
|
||||||
E5FFB3B3A2FFD7D7C8FFECECE0FFDBDBCAFFEBEBDFFFF0F0E5FFF0F0E5FFF0F0
|
|
||||||
E5FFF8F8EDFF61613A7261613A005C5C37005C5C3774F6F6EBFFEDEDE1FFEDED
|
|
||||||
E1FFE8E8DBFFD8D8C7FFEDEDE1FFEDEDE1FFEBEBDEFFD8D8C9FFAEAE9DFFAEAE
|
|
||||||
9DFFD8D8C9FFEBEBDEFFEDEDE1FFEDEDE1FFD8D8C7FFE8E8DBFFEDEDE1FFEDED
|
|
||||||
E1FFF6F6EBFF5C5C37745C5C37005858330058583376F5F5E8FFEBEBDEFFE5E5
|
|
||||||
D7FFD5D5C4FFEBEBDEFFEBEBDEFFEBEBDEFFEBEBDEFFEAEADDFFD9D9CAFFD9D9
|
|
||||||
CAFFEAEADDFFEBEBDEFFEBEBDEFFEBEBDEFFEBEBDEFFD5D5C4FFE5E5D7FFEBEB
|
|
||||||
DEFFF5F5E8FF585833765858330054542F0054542F77F4F4E6FFE3E3D5FFD3D3
|
|
||||||
C2FFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9
|
|
||||||
DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFE9E9DBFFD3D3C2FFE3E3
|
|
||||||
D5FFF4F4E6FF54542F7754542F00494926004949267BEEEEDEFFD0D0BFFFE8E8
|
|
||||||
D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8
|
|
||||||
D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFE8E8D8FFD0D0
|
|
||||||
BFFFEEEEDEFF4949267B494926000F0F070038381782CECEBDFFF3F3E2FFF3F3
|
|
||||||
E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3
|
|
||||||
E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3E2FFF3F3
|
|
||||||
E2FFCECEBDFF383817820F0F0700000000102121096C2A2A0B872A2A0B872A2A
|
|
||||||
0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A
|
|
||||||
0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A0B872A2A
|
|
||||||
0B872A2A0B872121096B0000000E0000000800000011000000190000001A0000
|
|
||||||
001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000
|
|
||||||
001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000
|
|
||||||
001A000000170000000E00000007FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
end
|
|
||||||
object OpenDialog: TOpenDialog
|
|
||||||
Filter = 'All files (*.*)|*.*'
|
|
||||||
left = 128
|
|
||||||
top = 296
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,550 +0,0 @@
|
|||||||
unit sHyperlinkForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
|
||||||
ExtCtrls, Buttons, StdCtrls, ComCtrls,
|
|
||||||
fpsTypes, fpspreadsheet;
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
{ THyperlinkForm }
|
|
||||||
|
|
||||||
THyperlinkForm = class(TForm)
|
|
||||||
Bevel1: TBevel;
|
|
||||||
BtnBrowseFile: TButton;
|
|
||||||
ButtonPanel1: TButtonPanel;
|
|
||||||
CbFtpServer: TComboBox;
|
|
||||||
CbFtpUsername: TComboBox;
|
|
||||||
CbFtpPassword: TComboBox;
|
|
||||||
CbHttpAddress: TComboBox;
|
|
||||||
CbFileBookmark: TComboBox;
|
|
||||||
CbWorksheets: TComboBox;
|
|
||||||
CbCellAddress: TComboBox;
|
|
||||||
CbFileName: TComboBox;
|
|
||||||
CbMailRecipient: TComboBox;
|
|
||||||
EdHttpBookmark: TEdit;
|
|
||||||
EdTooltip: TEdit;
|
|
||||||
EdMailSubject: TEdit;
|
|
||||||
GroupBox2: TGroupBox;
|
|
||||||
GbFileName: TGroupBox;
|
|
||||||
GbInternetLinkType: TGroupBox;
|
|
||||||
GbHttp: TGroupBox;
|
|
||||||
GbMailRecipient: TGroupBox;
|
|
||||||
GroupBox6: TGroupBox;
|
|
||||||
GbFileBookmark: TGroupBox;
|
|
||||||
GroupBox8: TGroupBox;
|
|
||||||
GbFtp: TGroupBox;
|
|
||||||
Images: TImageList;
|
|
||||||
HyperlinkInfo: TLabel;
|
|
||||||
Label1: TLabel;
|
|
||||||
LblFtpUserName: TLabel;
|
|
||||||
LblFtpPassword: TLabel;
|
|
||||||
LblHttpAddress: TLabel;
|
|
||||||
Label5: TLabel;
|
|
||||||
Label6: TLabel;
|
|
||||||
LblHttpBookmark: TLabel;
|
|
||||||
Notebook: TNotebook;
|
|
||||||
InternetNotebook: TNotebook;
|
|
||||||
OpenDialog: TOpenDialog;
|
|
||||||
PgHTTP: TPage;
|
|
||||||
PfFTP: TPage;
|
|
||||||
PgInternal: TPage;
|
|
||||||
PgFile: TPage;
|
|
||||||
PgInternet: TPage;
|
|
||||||
PgMail: TPage;
|
|
||||||
Panel2: TPanel;
|
|
||||||
RbFTP: TRadioButton;
|
|
||||||
RbHTTP: TRadioButton;
|
|
||||||
ToolBar: TToolBar;
|
|
||||||
TbInternal: TToolButton;
|
|
||||||
TbFile: TToolButton;
|
|
||||||
TbInternet: TToolButton;
|
|
||||||
TbMail: TToolButton;
|
|
||||||
procedure BtnBrowseFileClick(Sender: TObject);
|
|
||||||
procedure CbCellAddressEditingDone(Sender: TObject);
|
|
||||||
procedure CbFileBookmarkDropDown(Sender: TObject);
|
|
||||||
procedure CbFileNameEditingDone(Sender: TObject);
|
|
||||||
procedure CbFtpServerEditingDone(Sender: TObject);
|
|
||||||
procedure CbHttpAddressEditingDone(Sender: TObject);
|
|
||||||
procedure CbMailRecipientEditingDone(Sender: TObject);
|
|
||||||
procedure FormCreate(Sender: TObject);
|
|
||||||
procedure OKButtonClick(Sender: TObject);
|
|
||||||
procedure HTTP_FTP_Change(Sender: TObject);
|
|
||||||
procedure ToolButtonClick(Sender: TObject);
|
|
||||||
procedure UpdateHyperlinkInfo(Sender: TObject);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
FWorkbook: TsWorkbook;
|
|
||||||
FWorksheet: TsWorksheet;
|
|
||||||
function GetHyperlinkTarget: String;
|
|
||||||
function GetHyperlinkTooltip: String;
|
|
||||||
procedure SetHyperlinkKind(AValue: Integer);
|
|
||||||
procedure SetHyperlinkTarget(const AValue: String);
|
|
||||||
procedure SetHyperlinkTooltip(const AValue: String);
|
|
||||||
procedure SetInternetLinkKind(AValue: Integer);
|
|
||||||
procedure SetWorksheet(AWorksheet: TsWorksheet);
|
|
||||||
protected
|
|
||||||
function GetHyperlinkKind: Integer;
|
|
||||||
function ValidData(out AControl: TWinControl; out AMsg: String): Boolean;
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
procedure GetHyperlink(out AHyperlink: TsHyperlink);
|
|
||||||
procedure SetHyperlink(AWorksheet: TsWorksheet; const AHyperlink: TsHyperlink);
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
HyperlinkForm: THyperlinkForm;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
URIParser, LazFileUtils,
|
|
||||||
fpsUtils;
|
|
||||||
|
|
||||||
const
|
|
||||||
TAG_INTERNAL = 0;
|
|
||||||
TAG_FILE = 1;
|
|
||||||
TAG_INTERNET = 2;
|
|
||||||
TAG_MAIL = 3;
|
|
||||||
|
|
||||||
TAG_HTTP = 0;
|
|
||||||
TAG_FTP = 1;
|
|
||||||
|
|
||||||
{ THyperlinkForm }
|
|
||||||
|
|
||||||
procedure THyperlinkForm.BtnBrowseFileClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
with OpenDialog do begin
|
|
||||||
Filename := CbFileName.Text;
|
|
||||||
if Execute then begin
|
|
||||||
InitialDir := ExtractFileDir(FileName);
|
|
||||||
CbFileName.Text := FileName;
|
|
||||||
if (CbFileName.Text <> '') and (CbFileName.Items.IndexOf(FileName) = -1) then
|
|
||||||
CbFilename.Items.Insert(0, FileName);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbCellAddressEditingDone(Sender: TObject);
|
|
||||||
begin
|
|
||||||
CbCellAddress.Text := Uppercase(CbCellAddress.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbFileBookmarkDropDown(Sender: TObject);
|
|
||||||
var
|
|
||||||
ext: String;
|
|
||||||
wb: TsWorkbook;
|
|
||||||
ws: TsWorksheet;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
CbFileBookmark.Items.Clear;
|
|
||||||
if FileExists(CbFilename.Text) then begin
|
|
||||||
ext := Lowercase(ExtractFileExt(CbFileName.Text));
|
|
||||||
if (ext = '.xls') or (ext = '.xlsx') or (ext = '.ods') then begin
|
|
||||||
wb := TsWorkbook.Create;
|
|
||||||
try
|
|
||||||
wb.ReadFromFile(CbFileName.Text);
|
|
||||||
for i:=0 to wb.GetWorksheetCount-1 do
|
|
||||||
begin
|
|
||||||
ws := wb.GetWorksheetByIndex(i);
|
|
||||||
CbFileBookmark.Items.Add(ws.Name);
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
wb.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbFileNameEditingDone(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if (CbFilename.Text <> '') and
|
|
||||||
(CbFilename.Items.IndexOf(CbFilename.Text) = -1)
|
|
||||||
then
|
|
||||||
CbFileName.Items.Insert(0, CbFileName.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbFtpServerEditingDone(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if (CbFtpServer.Text <> '') and
|
|
||||||
(CbFtpServer.Items.IndexOf(CbFtpServer.Text) = -1)
|
|
||||||
then
|
|
||||||
CbFtpServer.Items.Insert(0, CbFtpServer.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbHttpAddressEditingDone(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if (CbHttpAddress.Text <> '') and
|
|
||||||
(CbHttpAddress.Items.Indexof(CbHttpAddress.Text) = -1)
|
|
||||||
then
|
|
||||||
CbHttpAddress.Items.Insert(0, CbHttpAddress.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.CbMailRecipientEditingDone(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if (CbMailRecipient.Text <> '') and
|
|
||||||
(CbMaiLRecipient.Items.IndexOf(CbMailRecipient.Text) = -1)
|
|
||||||
then
|
|
||||||
CbMailRecipient.Items.Insert(0, CbMailRecipient.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.FormCreate(Sender: TObject);
|
|
||||||
begin
|
|
||||||
HTTP_FTP_Change(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.GetHyperlink(out AHyperlink: TsHyperlink);
|
|
||||||
begin
|
|
||||||
AHyperlink.Target := GetHyperlinkTarget;
|
|
||||||
AHyperlink.Tooltip := GetHyperlinkTooltip;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function THyperlinkForm.GetHyperlinkKind: Integer;
|
|
||||||
begin
|
|
||||||
for Result := 0 to Toolbar.ButtonCount-1 do
|
|
||||||
if Toolbar.Buttons[Result].Down then
|
|
||||||
exit;
|
|
||||||
Result := -1;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function THyperlinkForm.GetHyperlinkTarget: String;
|
|
||||||
begin
|
|
||||||
Result := '';
|
|
||||||
case GetHyperlinkKind of
|
|
||||||
TAG_INTERNAL:
|
|
||||||
begin //internal
|
|
||||||
if (CbWorksheets.ItemIndex > 0) and (CbCellAddress.Text <> '') then
|
|
||||||
Result := '#' + CbWorksheets.Text + '!' + Uppercase(CbCellAddress.Text)
|
|
||||||
else if (CbWorksheets.ItemIndex > 0) then
|
|
||||||
Result := '#' + CbWorksheets.Text + '!'
|
|
||||||
else if (CbCellAddress.Text <> '') then
|
|
||||||
Result := '#' + Uppercase(CbCellAddress.Text);
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_FILE:
|
|
||||||
begin // File
|
|
||||||
if FileNameIsAbsolute(CbFilename.Text) then
|
|
||||||
Result := FilenameToURI(CbFilename.Text)
|
|
||||||
else
|
|
||||||
Result := CbFilename.Text;
|
|
||||||
if CbFileBookmark.Text <> '' then
|
|
||||||
Result := Result + '#' + CbFileBookmark.Text;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_INTERNET:
|
|
||||||
begin // Internet link
|
|
||||||
if RbHttp.Checked and (CbHttpAddress.Text <> '') then
|
|
||||||
begin
|
|
||||||
if pos('http', Lowercase(CbHttpAddress.Text)) = 1 then
|
|
||||||
Result := CbHttpAddress.Text
|
|
||||||
else
|
|
||||||
Result := 'http://' + CbHttpAddress.Text;
|
|
||||||
if EdHttpBookmark.Text <> '' then
|
|
||||||
Result := Result + '#' + EdHttpBookmark.Text;
|
|
||||||
end else
|
|
||||||
if RbFtp.Checked and (CbFtpServer.Text <> '') then
|
|
||||||
begin
|
|
||||||
if (CbFtpUsername.Text <> '') and (CbFtpPassword.Text <> '') then
|
|
||||||
Result := Format('ftp://%s:%s@%s', [CbFtpUsername.Text, CbFtpPassword.Text, CbFtpServer.Text])
|
|
||||||
else
|
|
||||||
if (CbFtpUsername.Text <> '') and (CbFtpPassword.Text = '') then
|
|
||||||
Result := Format('ftp://%s@%s', [CbFtpUsername.Text , CbFtpServer.Text])
|
|
||||||
else
|
|
||||||
Result := 'ftp://anonymous@' + CbFtpServer.Text;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_MAIL:
|
|
||||||
begin // Mail
|
|
||||||
if EdMailSubject.Text <> '' then
|
|
||||||
Result := Format('mailto:%s?subject=%s', [CbMailRecipient.Text, EdMailSubject.Text])
|
|
||||||
else
|
|
||||||
Result := Format('mailto:%s', [CbMailRecipient.Text]);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function THyperlinkForm.GetHyperlinkTooltip: String;
|
|
||||||
begin
|
|
||||||
Result := EdTooltip.Text;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.OKButtonClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
C: TWinControl;
|
|
||||||
msg: String;
|
|
||||||
begin
|
|
||||||
if not ValidData(C, msg) then begin
|
|
||||||
C.SetFocus;
|
|
||||||
MessageDlg(msg, mtError, [mbOK], 0);
|
|
||||||
ModalResult := mrNone;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.HTTP_FTP_Change(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if RbHTTP.Checked then
|
|
||||||
InternetNotebook.PageIndex := 0;
|
|
||||||
if RbFTP.Checked then
|
|
||||||
InternetNotebook.PageIndex := 1;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetHyperlink(AWorksheet: TsWorksheet;
|
|
||||||
const AHyperlink: TsHyperlink);
|
|
||||||
begin
|
|
||||||
SetWorksheet(AWorksheet);
|
|
||||||
SetHyperlinkTarget(AHyperlink.Target);
|
|
||||||
SetHyperlinkTooltip(AHyperlink.Tooltip);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetHyperlinkKind(AValue: Integer);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
for i:=0 to Toolbar.ButtonCount-1 do
|
|
||||||
Toolbar.Buttons[i].Down := (AValue = Toolbar.Buttons[i].Tag);
|
|
||||||
Notebook.PageIndex := AValue;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetHyperlinkTarget(const AValue: String);
|
|
||||||
var
|
|
||||||
u: TURI;
|
|
||||||
sheet: TsWorksheet;
|
|
||||||
c,r: Cardinal;
|
|
||||||
i, idx: Integer;
|
|
||||||
p: Integer;
|
|
||||||
fn, bm: String;
|
|
||||||
begin
|
|
||||||
if AValue = '' then
|
|
||||||
begin
|
|
||||||
CbWorksheets.ItemIndex := 0;
|
|
||||||
CbCellAddress.Text := '';
|
|
||||||
|
|
||||||
CbMailRecipient.Text := '';
|
|
||||||
EdMailSubject.Text := '';
|
|
||||||
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Internal link
|
|
||||||
if pos('#', AValue) = 1 then begin
|
|
||||||
SetHyperlinkKind(TAG_INTERNAL);
|
|
||||||
if FWorkbook.TryStrToCell(Copy(AValue, 2, Length(AValue)), sheet, r, c) then
|
|
||||||
begin
|
|
||||||
if (sheet = nil) or (sheet = FWorksheet) then
|
|
||||||
CbWorksheets.ItemIndex := 0
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
idx := 0;
|
|
||||||
for i:=1 to CbWorksheets.Items.Count-1 do
|
|
||||||
if CbWorksheets.Items[i] = sheet.Name then
|
|
||||||
begin
|
|
||||||
idx := i;
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
CbWorksheets.ItemIndex := idx;
|
|
||||||
end;
|
|
||||||
CbCellAddress.Text := GetCellString(r, c);
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
end else begin
|
|
||||||
HyperlinkInfo.Caption := AValue;
|
|
||||||
MessageDlg(Format('Sheet not found in hyperlink "%s"', [AValue]), mtError,
|
|
||||||
[mbOK], 0);
|
|
||||||
end;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// external links
|
|
||||||
u := ParseURI(AValue);
|
|
||||||
|
|
||||||
// File with absolute path
|
|
||||||
if SameText(u.Protocol, 'file') then
|
|
||||||
begin
|
|
||||||
SetHyperlinkKind(TAG_FILE);
|
|
||||||
UriToFilename(AValue, fn);
|
|
||||||
CbFilename.Text := fn;
|
|
||||||
CbFileBookmark.Text := u.Bookmark;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Mail
|
|
||||||
if SameText(u.Protocol, 'mailto') then
|
|
||||||
begin
|
|
||||||
SetHyperlinkKind(TAG_MAIL);
|
|
||||||
CbMailRecipient.Text := u.Document;
|
|
||||||
if CbMailRecipient.Items.IndexOf(u.Document) = -1 then
|
|
||||||
CbMailRecipient.Items.Insert(0, u.Document);
|
|
||||||
if (u.Params <> '') then
|
|
||||||
begin
|
|
||||||
p := pos('subject=', u.Params);
|
|
||||||
if p <> 0 then
|
|
||||||
EdMailSubject.Text := copy(u.Params, p+Length('subject='), MaxInt);
|
|
||||||
end;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// http
|
|
||||||
if SameText(u.Protocol, 'http') or SameText(u.Protocol, 'https') then
|
|
||||||
begin
|
|
||||||
SetHyperlinkKind(TAG_INTERNET);
|
|
||||||
SetInternetLinkKind(TAG_HTTP);
|
|
||||||
CbHttpAddress.Text := u.Host;
|
|
||||||
EdHttpBookmark.Text := u.Bookmark;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// ftp
|
|
||||||
if SameText(u.Protocol, 'ftp') then
|
|
||||||
begin
|
|
||||||
SetHyperlinkKind(TAG_INTERNET);
|
|
||||||
SetInternetLinkKind(TAG_FTP);
|
|
||||||
CbFtpServer.Text := u.Host;
|
|
||||||
CbFtpUserName.text := u.UserName;
|
|
||||||
CbFtpPassword.Text := u.Password;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// If we get there it must be a local file with relative path
|
|
||||||
SetHyperlinkKind(TAG_FILE);
|
|
||||||
SplitHyperlink(AValue, fn, bm);
|
|
||||||
CbFileName.Text := fn;
|
|
||||||
CbFileBookmark.Text := bm;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetHyperlinkTooltip(const AValue: String);
|
|
||||||
begin
|
|
||||||
EdTooltip.Text := AValue;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetInternetLinkKind(AValue: Integer);
|
|
||||||
begin
|
|
||||||
RbHttp.Checked := AValue = TAG_HTTP;
|
|
||||||
RbFtp.Checked := AValue = TAG_FTP;
|
|
||||||
InternetNotebook.PageIndex := AValue;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.SetWorksheet(AWorksheet: TsWorksheet);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
FWorksheet := AWorksheet;
|
|
||||||
if FWorksheet = nil then
|
|
||||||
raise Exception.Create('[THyperlinkForm.SetWorksheet] Worksheet cannot be nil.');
|
|
||||||
FWorkbook := FWorksheet.Workbook;
|
|
||||||
|
|
||||||
CbWorksheets.Items.Clear;
|
|
||||||
CbWorksheets.Items.Add('(current worksheet)');
|
|
||||||
for i:=0 to FWorkbook.GetWorksheetCount-1 do
|
|
||||||
CbWorksheets.Items.Add(FWorkbook.GetWorksheetByIndex(i).Name);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.ToolButtonClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
Notebook.PageIndex := TToolButton(Sender).Tag;
|
|
||||||
for i:=0 to Toolbar.ButtonCount-1 do
|
|
||||||
Toolbar.Buttons[i].Down := Toolbar.Buttons[i].Tag = TToolbutton(Sender).Tag;
|
|
||||||
UpdateHyperlinkInfo(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure THyperlinkForm.UpdateHyperlinkInfo(Sender: TObject);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
begin
|
|
||||||
s := GetHyperlinkTarget;
|
|
||||||
if s = '' then s := #32;
|
|
||||||
HyperlinkInfo.Caption := s;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function THyperlinkForm.ValidData(out AControl: TWinControl;
|
|
||||||
out AMsg: String): Boolean;
|
|
||||||
var
|
|
||||||
r,c: Cardinal;
|
|
||||||
begin
|
|
||||||
Result := false;
|
|
||||||
AMsg := '';
|
|
||||||
AControl := nil;
|
|
||||||
|
|
||||||
case GetHyperlinkKind of
|
|
||||||
TAG_INTERNAL:
|
|
||||||
begin
|
|
||||||
if CbCellAddress.Text = '' then
|
|
||||||
begin
|
|
||||||
AMsg := 'No cell address specified.';
|
|
||||||
AControl := CbCellAddress;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if not ParseCellString(CbCellAddress.Text, r, c) then
|
|
||||||
begin
|
|
||||||
AMsg := Format('"%s" is not a valid cell address.', [CbCellAddress.Text]);
|
|
||||||
AControl := CbCellAddress;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if (CbWorksheets.Items.IndexOf(CbWorksheets.Text) = -1) and (CbWorksheets.ItemIndex <> 0) then
|
|
||||||
begin
|
|
||||||
AMsg := Format('Worksheet "%s" does not exist.', [CbWorksheets.Text]);
|
|
||||||
AControl := CbWorksheets;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_FILE:
|
|
||||||
begin
|
|
||||||
if CbFilename.Text = '' then
|
|
||||||
begin
|
|
||||||
AMsg := 'No filename specified.';
|
|
||||||
AControl := CbFileName;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_INTERNET:
|
|
||||||
if RbHttp.Checked then
|
|
||||||
begin
|
|
||||||
if CbHttpAddress.Text = '' then
|
|
||||||
begin
|
|
||||||
AMsg := 'URL of web site not specified.';
|
|
||||||
AControl := CbHttpAddress;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end else
|
|
||||||
if RbFtp.Checked then
|
|
||||||
begin
|
|
||||||
if CbFtpServer.Text = '' then
|
|
||||||
begin
|
|
||||||
AMsg := 'Ftp server not specified.';
|
|
||||||
AControl := CbFtpServer;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TAG_MAIL:
|
|
||||||
begin
|
|
||||||
if CbMailRecipient.Text = '' then
|
|
||||||
begin
|
|
||||||
AMsg := 'No mail recipient specified.';
|
|
||||||
AControl := CbMailRecipient;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
// Check e-mail address here also!
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Result := true;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,387 +0,0 @@
|
|||||||
object NumFormatForm: TNumFormatForm
|
|
||||||
Left = 336
|
|
||||||
Height = 394
|
|
||||||
Top = 173
|
|
||||||
Width = 559
|
|
||||||
BorderStyle = bsDialog
|
|
||||||
Caption = 'Number format'
|
|
||||||
ClientHeight = 394
|
|
||||||
ClientWidth = 559
|
|
||||||
ShowHint = True
|
|
||||||
LCLVersion = '1.7'
|
|
||||||
object ButtonPanel1: TButtonPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 34
|
|
||||||
Top = 354
|
|
||||||
Width = 547
|
|
||||||
OKButton.Name = 'OKButton'
|
|
||||||
OKButton.Hint = 'Accept changes and close'
|
|
||||||
OKButton.DefaultCaption = True
|
|
||||||
HelpButton.Name = 'HelpButton'
|
|
||||||
HelpButton.DefaultCaption = True
|
|
||||||
CloseButton.Name = 'CloseButton'
|
|
||||||
CloseButton.DefaultCaption = True
|
|
||||||
CancelButton.Name = 'CancelButton'
|
|
||||||
CancelButton.Hint = 'Discard changes and close'
|
|
||||||
CancelButton.DefaultCaption = True
|
|
||||||
TabOrder = 2
|
|
||||||
ShowButtons = [pbOK, pbCancel]
|
|
||||||
end
|
|
||||||
object Panel1: TPanel
|
|
||||||
Left = 0
|
|
||||||
Height = 297
|
|
||||||
Top = 0
|
|
||||||
Width = 122
|
|
||||||
Align = alLeft
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 297
|
|
||||||
ClientWidth = 122
|
|
||||||
TabOrder = 0
|
|
||||||
object Label1: TLabel
|
|
||||||
Left = 6
|
|
||||||
Height = 15
|
|
||||||
Top = 6
|
|
||||||
Width = 112
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Left = 2
|
|
||||||
BorderSpacing.Top = 2
|
|
||||||
BorderSpacing.Bottom = 2
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'Category'
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object LbCategory: TListBox
|
|
||||||
Left = 6
|
|
||||||
Height = 270
|
|
||||||
Top = 27
|
|
||||||
Width = 116
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Left = 6
|
|
||||||
Items.Strings = (
|
|
||||||
'Number'
|
|
||||||
'Percent'
|
|
||||||
'Scientific'
|
|
||||||
'Fraction'
|
|
||||||
'Currency'
|
|
||||||
'Date'
|
|
||||||
'Time'
|
|
||||||
'Text'
|
|
||||||
)
|
|
||||||
ItemHeight = 15
|
|
||||||
OnClick = LbCategoryClick
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object Panel2: TPanel
|
|
||||||
Left = 122
|
|
||||||
Height = 297
|
|
||||||
Top = 0
|
|
||||||
Width = 230
|
|
||||||
Align = alLeft
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 297
|
|
||||||
ClientWidth = 230
|
|
||||||
TabOrder = 1
|
|
||||||
object Label2: TLabel
|
|
||||||
Left = 6
|
|
||||||
Height = 15
|
|
||||||
Top = 6
|
|
||||||
Width = 220
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Left = 2
|
|
||||||
BorderSpacing.Top = 2
|
|
||||||
BorderSpacing.Bottom = 2
|
|
||||||
BorderSpacing.Around = 4
|
|
||||||
Caption = 'Format'
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object LbFormat: TListBox
|
|
||||||
Left = 6
|
|
||||||
Height = 225
|
|
||||||
Top = 27
|
|
||||||
Width = 224
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Left = 6
|
|
||||||
ItemHeight = 0
|
|
||||||
OnClick = LbFormatClick
|
|
||||||
OnDrawItem = LbFormatDrawItem
|
|
||||||
Style = lbOwnerDrawFixed
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object CurrSymbolPanel: TPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 41
|
|
||||||
Top = 256
|
|
||||||
Width = 224
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Left = 6
|
|
||||||
BorderSpacing.Top = 4
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 41
|
|
||||||
ClientWidth = 224
|
|
||||||
TabOrder = 1
|
|
||||||
Visible = False
|
|
||||||
object Label5: TLabel
|
|
||||||
Left = 0
|
|
||||||
Height = 15
|
|
||||||
Top = 0
|
|
||||||
Width = 224
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Bottom = 2
|
|
||||||
Caption = 'Currency string'
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object CbCurrSymbol: TComboBox
|
|
||||||
Left = 0
|
|
||||||
Height = 23
|
|
||||||
Hint = 'List of registered currency symbols'
|
|
||||||
Top = 16
|
|
||||||
Width = 200
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
OnSelect = CbCurrSymbolSelect
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object BtnAddCurrSymbol: TSpeedButton
|
|
||||||
Left = 201
|
|
||||||
Height = 23
|
|
||||||
Hint = 'Add new currency symbol'
|
|
||||||
Top = 16
|
|
||||||
Width = 23
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = '...'
|
|
||||||
OnClick = BtnAddCurrSymbolClick
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object DetailsPanel: TPanel
|
|
||||||
Left = 352
|
|
||||||
Height = 297
|
|
||||||
Top = 0
|
|
||||||
Width = 207
|
|
||||||
Align = alClient
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 297
|
|
||||||
ClientWidth = 207
|
|
||||||
TabOrder = 3
|
|
||||||
object GbOptions: TGroupBox
|
|
||||||
Left = 8
|
|
||||||
Height = 121
|
|
||||||
Top = 7
|
|
||||||
Width = 187
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
Caption = 'Options'
|
|
||||||
ClientHeight = 101
|
|
||||||
ClientWidth = 183
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
object Label3: TLabel
|
|
||||||
Left = 15
|
|
||||||
Height = 15
|
|
||||||
Top = 11
|
|
||||||
Width = 79
|
|
||||||
Caption = 'Decimal places'
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
end
|
|
||||||
object EdDecimals: TSpinEdit
|
|
||||||
Left = 121
|
|
||||||
Height = 23
|
|
||||||
Top = 7
|
|
||||||
Width = 50
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
MaxValue = 16
|
|
||||||
OnChange = EdDecimalsChange
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object CbThousandSep: TCheckBox
|
|
||||||
Left = 15
|
|
||||||
Height = 19
|
|
||||||
Top = 40
|
|
||||||
Width = 125
|
|
||||||
Caption = 'Thousand separator'
|
|
||||||
OnClick = CbThousandSepClick
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object CbNegRed: TCheckBox
|
|
||||||
Left = 15
|
|
||||||
Height = 19
|
|
||||||
Top = 67
|
|
||||||
Width = 100
|
|
||||||
Caption = 'Negative in red'
|
|
||||||
OnClick = CbNegRedClick
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object GroupBox3: TGroupBox
|
|
||||||
Left = 8
|
|
||||||
Height = 62
|
|
||||||
Top = 136
|
|
||||||
Width = 187
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
Caption = 'Sample'
|
|
||||||
ClientHeight = 42
|
|
||||||
ClientWidth = 183
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 1
|
|
||||||
object Shape1: TShape
|
|
||||||
Left = 8
|
|
||||||
Height = 34
|
|
||||||
Top = 0
|
|
||||||
Width = 167
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Left = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
end
|
|
||||||
object Sample: TLabel
|
|
||||||
Left = 9
|
|
||||||
Height = 32
|
|
||||||
Top = 1
|
|
||||||
Width = 165
|
|
||||||
Align = alClient
|
|
||||||
Alignment = taCenter
|
|
||||||
AutoSize = False
|
|
||||||
BorderSpacing.Left = 8
|
|
||||||
BorderSpacing.Right = 8
|
|
||||||
BorderSpacing.Bottom = 8
|
|
||||||
BorderSpacing.Around = 1
|
|
||||||
Caption = 'Sample'
|
|
||||||
Color = clWhite
|
|
||||||
Layout = tlCenter
|
|
||||||
ParentColor = False
|
|
||||||
ParentFont = False
|
|
||||||
Transparent = False
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object GbFormatString: TGroupBox
|
|
||||||
Left = 6
|
|
||||||
Height = 47
|
|
||||||
Top = 301
|
|
||||||
Width = 547
|
|
||||||
Align = alBottom
|
|
||||||
BorderSpacing.Left = 6
|
|
||||||
BorderSpacing.Top = 4
|
|
||||||
BorderSpacing.Right = 6
|
|
||||||
Caption = 'Format string'
|
|
||||||
ClientHeight = 27
|
|
||||||
ClientWidth = 543
|
|
||||||
Font.Style = [fsBold]
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 4
|
|
||||||
object EdNumFormatStr: TEdit
|
|
||||||
Left = 8
|
|
||||||
Height = 23
|
|
||||||
Hint = 'Number format string'
|
|
||||||
Top = 0
|
|
||||||
Width = 483
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
OnChange = EdNumFormatStrChange
|
|
||||||
ParentFont = False
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object BtnAddFormat: TSpeedButton
|
|
||||||
Left = 493
|
|
||||||
Height = 23
|
|
||||||
Hint = 'Add this format string to list'
|
|
||||||
Top = 0
|
|
||||||
Width = 23
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0041924E233D8F497D3A8C44DB368940F332873CF32F84
|
|
||||||
37DB2C81337D287F3023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0049995853459653E6419950FF7DC28FFF96D0A6FF96CFA6FF78BE
|
|
||||||
89FF368D42FF2C8134E6297F3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00519F61534D9C5DF464B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
|
|
||||||
98FFA5D9B4FF58AA6BFF2C8134F4297F3053FFFFFF00FFFFFF00FFFFFF0059A6
|
|
||||||
6B2256A366E56AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
|
|
||||||
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234E5297F3022FFFFFF00FFFFFF005DA9
|
|
||||||
707E53AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF58B56EFF5CB774FFA6DAB4FF388F43FF2C82347EFFFFFF00FFFFFF0061AC
|
|
||||||
75DB8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539DBFFFFFF00FFFFFF0065AF
|
|
||||||
7AF6A9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DF6FFFFFF00FFFFFF0069B2
|
|
||||||
7EF6B6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42F6FFFFFF00FFFFFF006DB5
|
|
||||||
83DBACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
|
|
||||||
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47DBFFFFFF00FFFFFF0070B8
|
|
||||||
877E85C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
|
|
||||||
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF40914C7EFFFFFF00FFFFFF0073BA
|
|
||||||
8A2270B887E5AADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
|
|
||||||
95FF83D28EFFAFE0B7FF6BB97DFF489856E544945122FFFFFF00FFFFFF00FFFF
|
|
||||||
FF0073BB8B5370B887F4AFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
|
|
||||||
AFFFC0E8C5FF79C28AFF509E5FF44C9B5B53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0073BB8B5371B887E694CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
|
|
||||||
B8FF6DB97FFF58A569E654A16553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0074BB8B2371B9887D6EB684DB6AB380F367B17CF363AE
|
|
||||||
77DB60AB737D5CA86E23FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnAddFormatClick
|
|
||||||
end
|
|
||||||
object BtnDeleteFormat: TSpeedButton
|
|
||||||
Left = 516
|
|
||||||
Height = 23
|
|
||||||
Hint = 'Remove this format string from list'
|
|
||||||
Top = 0
|
|
||||||
Width = 23
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF003F54C3233A50C27D3853BEDB3551BDF3304BBCF32E4E
|
|
||||||
B8DB2B4CB77D2748B523FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF004658C8534255C6E63C52CCFF757AE8FF8F92EEFF8F92EEFF7178
|
|
||||||
E4FF334DC1FF2B4AB7E6294BB553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF004D5ACD534959CBF45C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
|
|
||||||
EEFF9EA0F4FF515DD7FF2B4AB7F4294BB553FFFFFF00FFFFFF00FFFFFF00545F
|
|
||||||
D2225361CFE5616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
|
|
||||||
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8E5294BB522FFFFFF00FFFFFF005860
|
|
||||||
D47E4B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF2A4AB87EFFFFFF00FFFFFF005C62
|
|
||||||
D7DB818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBADBFFFFFF00FFFFFF005F63
|
|
||||||
DAF6A1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCF6FFFFFF00FFFFFF006469
|
|
||||||
DBF6AFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEF6FFFFFF00FFFFFF00676A
|
|
||||||
DEDBA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
|
|
||||||
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0DBFFFFFF00FFFFFF006A69
|
|
||||||
E07E7D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
|
|
||||||
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF3E54C27EFFFFFF00FFFFFF006C6C
|
|
||||||
E1226A69E0E5A3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
|
|
||||||
F9FF768CF8FFA8B6F8FF636EE3FF4557C7E54156C522FFFFFF00FFFFFF00FFFF
|
|
||||||
FF006D6CE3536A69E0F4AAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
|
|
||||||
FBFFBAC7FCFF707BE9FF4C5BCCF44858CA53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF006D6CE3536A6ADFE68E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
|
|
||||||
F4FF6670E2FF535ED1E6505DCE53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF006D6DE2236B6AE17D686ADDDB6364DCF36164DAF35D63
|
|
||||||
D9DB5B63D67D5862D423FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnDeleteFormatClick
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,829 +0,0 @@
|
|||||||
unit sNumFormatForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
|
||||||
ExtCtrls, StdCtrls, Spin, Buttons, types, inifiles,
|
|
||||||
fpsTypes, fpsNumFormat, fpSpreadsheet;
|
|
||||||
|
|
||||||
type
|
|
||||||
TsNumFormatCategory = (nfcNumber, nfcPercent, nfcScientific, nfcFraction,
|
|
||||||
nfcCurrency, nfcDate, nfcTime, nfcText);
|
|
||||||
|
|
||||||
{ TNumFormatForm }
|
|
||||||
|
|
||||||
TNumFormatForm = class(TForm)
|
|
||||||
ButtonPanel1: TButtonPanel;
|
|
||||||
CbThousandSep: TCheckBox;
|
|
||||||
CbNegRed: TCheckBox;
|
|
||||||
CbCurrSymbol: TComboBox;
|
|
||||||
EdNumFormatStr: TEdit;
|
|
||||||
GbOptions: TGroupBox;
|
|
||||||
GbFormatString: TGroupBox;
|
|
||||||
GroupBox3: TGroupBox;
|
|
||||||
Label1: TLabel;
|
|
||||||
Label2: TLabel;
|
|
||||||
Label3: TLabel;
|
|
||||||
DetailsPanel: TPanel;
|
|
||||||
Sample: TLabel;
|
|
||||||
Label5: TLabel;
|
|
||||||
LbCategory: TListBox;
|
|
||||||
LbFormat: TListBox;
|
|
||||||
Panel1: TPanel;
|
|
||||||
Panel2: TPanel;
|
|
||||||
EdDecimals: TSpinEdit;
|
|
||||||
CurrSymbolPanel: TPanel;
|
|
||||||
BtnAddCurrSymbol: TSpeedButton;
|
|
||||||
Shape1: TShape;
|
|
||||||
BtnAddFormat: TSpeedButton;
|
|
||||||
BtnDeleteFormat: TSpeedButton;
|
|
||||||
procedure BtnAddCurrSymbolClick(Sender: TObject);
|
|
||||||
procedure BtnAddFormatClick(Sender: TObject);
|
|
||||||
procedure BtnDeleteFormatClick(Sender: TObject);
|
|
||||||
procedure CbCurrSymbolSelect(Sender: TObject);
|
|
||||||
procedure CbNegRedClick(Sender: TObject);
|
|
||||||
procedure CbThousandSepClick(Sender: TObject);
|
|
||||||
procedure EdDecimalsChange(Sender: TObject);
|
|
||||||
procedure EdNumFormatStrChange(Sender: TObject);
|
|
||||||
procedure LbCategoryClick(Sender: TObject);
|
|
||||||
procedure LbFormatClick(Sender: TObject);
|
|
||||||
procedure LbFormatDrawItem(Control: TWinControl; Index: Integer;
|
|
||||||
ARect: TRect; State: TOwnerDrawState);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
FWorkbook: TsWorkbook;
|
|
||||||
FSampleValue: Double;
|
|
||||||
FSampleText: String;
|
|
||||||
FGenerator: array[TsNumFormatCategory] of Double;
|
|
||||||
FNumFormatStrOfList: String;
|
|
||||||
FLockCount: Integer;
|
|
||||||
function GetNumFormatStr: String;
|
|
||||||
procedure SetNumFormatStr(const AValue: String);
|
|
||||||
protected
|
|
||||||
function FindNumFormat(ACategory: TsNumFormatCategory;
|
|
||||||
ANumFormatStr: String): Integer;
|
|
||||||
function FormatStrOfListIndex(AIndex: Integer): String;
|
|
||||||
procedure ReplaceCurrSymbol;
|
|
||||||
procedure ReplaceDecs;
|
|
||||||
procedure SelectCategory(ACategory: TsNumFormatCategory);
|
|
||||||
procedure SelectFormat(AIndex: Integer);
|
|
||||||
procedure UpdateControls(ANumFormatParams: TsNumFormatParams);
|
|
||||||
procedure UpdateSample(ANumFormatParams: TsNumFormatParams);
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
constructor Create(AOwner: TComponent); override;
|
|
||||||
procedure SetData(ANumFormatStr: String; AWorkbook: TsWorkbook;
|
|
||||||
ASample: variant);
|
|
||||||
property NumFormatStr: String read GetNumFormatStr;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
NumFormatForm: TNumFormatForm;
|
|
||||||
|
|
||||||
procedure ReadNumFormatsFromIni(const AIniFile: TCustomIniFile);
|
|
||||||
procedure WriteNumFormatsToIni(const AIniFile: TCustomIniFile);
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
LCLType, Math, DateUtils, TypInfo, variants,
|
|
||||||
fpsUtils, fpsNumFormatParser, fpsCurrency,
|
|
||||||
sCurrencyForm;
|
|
||||||
|
|
||||||
const
|
|
||||||
BUILTIN_OFFSET = 1;
|
|
||||||
USER_OFFSET = 1000;
|
|
||||||
|
|
||||||
var
|
|
||||||
NumFormats: TStringList = nil;
|
|
||||||
|
|
||||||
procedure AddToList(ACategory: TsNumFormatCategory; AFormatStr: String;
|
|
||||||
AOffset: Integer = BUILTIN_OFFSET);
|
|
||||||
begin
|
|
||||||
if NumFormats.IndexOf(AFormatStr) = -1 then
|
|
||||||
NumFormats.AddObject(AFormatStr, TObject(PtrInt(AOffset + ord(ACategory))));
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure InitNumFormats(AFormatSettings: TFormatSettings);
|
|
||||||
var
|
|
||||||
copiedFormats: TStringList;
|
|
||||||
nfs: String;
|
|
||||||
data: PtrInt;
|
|
||||||
i: Integer;
|
|
||||||
fs: TFormatSettings absolute AFormatSettings;
|
|
||||||
begin
|
|
||||||
copiedFormats := nil;
|
|
||||||
|
|
||||||
// Store user-defined formats already added to NumFormats list
|
|
||||||
if NumFormats <> nil then
|
|
||||||
begin
|
|
||||||
copiedFormats := TStringList.Create;
|
|
||||||
for i:=0 to NumFormats.Count-1 do
|
|
||||||
begin
|
|
||||||
nfs := NumFormats.Strings[i];
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if data >= USER_OFFSET then
|
|
||||||
copiedFormats.AddObject(nfs, TObject(data));
|
|
||||||
end;
|
|
||||||
NumFormats.Free;
|
|
||||||
end;
|
|
||||||
|
|
||||||
NumFormats := TStringList.Create;
|
|
||||||
|
|
||||||
// Add built-in formats
|
|
||||||
AddToList(nfcNumber, 'General');
|
|
||||||
AddToList(nfcNumber, '0');
|
|
||||||
AddToList(nfcNumber, '0.0');
|
|
||||||
AddToList(nfcNumber, '0.00');
|
|
||||||
AddToList(nfcNumber, '0.000');
|
|
||||||
AddToList(nfcNumber, '#,##0');
|
|
||||||
AddToList(nfcNumber, '#,##0.0');
|
|
||||||
AddToList(nfcNumber, '#,##0.00');
|
|
||||||
AddToList(nfcNumber, '#,##0.000');
|
|
||||||
|
|
||||||
AddToList(nfcPercent, '0%');
|
|
||||||
AddToList(nfcPercent, '0.0%');
|
|
||||||
AddToList(nfcPercent, '0.00%');
|
|
||||||
AddToList(nfcPercent, '0.000%');
|
|
||||||
|
|
||||||
AddToList(nfcScientific, '0E+0');
|
|
||||||
AddToList(nfcScientific, '0E+00');
|
|
||||||
AddToList(nfcScientific, '0E+000');
|
|
||||||
AddToList(nfcScientific, '0.0E+0');
|
|
||||||
AddToList(nfcScientific, '0.0E+00');
|
|
||||||
AddToList(nfcScientific, '0.0E+000');
|
|
||||||
AddToList(nfcScientific, '0.00E+0');
|
|
||||||
AddToList(nfcScientific, '0.00E+00');
|
|
||||||
AddToList(nfcScientific, '0.00E+000');
|
|
||||||
AddToList(nfcScientific, '0.000E+0');
|
|
||||||
AddToList(nfcScientific, '0.000E+00');
|
|
||||||
AddToList(nfcScientific, '0.000E+000');
|
|
||||||
AddToList(nfcScientific, '0E-0');
|
|
||||||
AddToList(nfcScientific, '0E-00');
|
|
||||||
AddToList(nfcScientific, '0E-000');
|
|
||||||
AddToList(nfcScientific, '0.0E-0');
|
|
||||||
AddToList(nfcScientific, '0.0E-00');
|
|
||||||
AddToList(nfcScientific, '0.0E-000');
|
|
||||||
AddToList(nfcScientific, '0.00E-0');
|
|
||||||
AddToList(nfcScientific, '0.00E-00');
|
|
||||||
AddToList(nfcScientific, '0.00E-000');
|
|
||||||
AddToList(nfcScientific, '0.000E-0');
|
|
||||||
AddToList(nfcScientific, '0.000E-00');
|
|
||||||
AddToList(nfcScientific, '0.000E-000');
|
|
||||||
|
|
||||||
AddToList(nfcFraction, '# ?/?');
|
|
||||||
AddToList(nfcFraction, '# ??/??');
|
|
||||||
AddToList(nfcFraction, '# ???/???');
|
|
||||||
AddToList(nfcFraction, '# ?/2');
|
|
||||||
AddToList(nfcFraction, '# ?/4');
|
|
||||||
AddToList(nfcFraction, '# ?/8');
|
|
||||||
AddToList(nfcFraction, '# ?/16');
|
|
||||||
AddToList(nfcFraction, '# ?/32');
|
|
||||||
AddToList(nfcFraction, '?/?');
|
|
||||||
AddToList(nfcFraction, '?/??');
|
|
||||||
AddToList(nfcFraction, '?/???');
|
|
||||||
AddToList(nfcFraction, '?/2');
|
|
||||||
AddToList(nfcFraction, '?/4');
|
|
||||||
AddToList(nfcFraction, '?/8');
|
|
||||||
AddToList(nfcFraction, '?/16');
|
|
||||||
AddToList(nfcFraction, '?/32');
|
|
||||||
|
|
||||||
AddToList(nfcCurrency, '#,##0 [$$];-#,##0 [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0.00 [$$];-#,##0.00 [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0 [$$];(#,##0) [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0.00 [$$];(#,##0.00) [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0 [$$];[red]-#,##0 [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0.00 [$$];[red]-#,##0.00 [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0 [$$];[red](#,##0) [$$]');
|
|
||||||
AddToList(nfcCurrency, '#,##0.00 [$$];[red]-#,##0.00 [$$]');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0;[$$] -#,##0');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0.00;[$$] -#,##0.00');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0;[$$] (#,##0)');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0.00;[$$] (#,##0.00)');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0;[red][$$] -#,##0');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0.00;[red][$$] -#,##0.00');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0;[red][$$] (#,##0)');
|
|
||||||
AddToList(nfcCurrency, '[$$] #,##0.00;[red][$$] -#,##0.00');
|
|
||||||
|
|
||||||
AddToList(nfcDate, 'dddd, '+fs.LongDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, 'dddd, '+fs.ShortDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, 'dddd, '+fs.LongDateFormat);
|
|
||||||
AddToList(nfcDate, 'dddd, '+fs.ShortDateFormat);
|
|
||||||
AddToList(nfcDate, 'ddd., '+fs.LongDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, 'ddd., '+fs.ShortDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, 'ddd., '+fs.LongDateFormat);
|
|
||||||
AddToList(nfcDate, 'ddd., '+fs.ShortDateFormat);
|
|
||||||
AddToList(nfcDate, fs.LongDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcDate, fs.LongDateFormat);
|
|
||||||
AddToList(nfcDate, fs.ShortDateFormat);
|
|
||||||
AddToList(nfcDate, 'dd. mmmm');
|
|
||||||
AddToList(nfcDate, 'dd. mmm.');
|
|
||||||
AddToList(nfcDate, 'd. mmmm');
|
|
||||||
AddToList(nfcDate, 'd. mmm.');
|
|
||||||
AddToList(nfcDate, 'mmmm dd');
|
|
||||||
AddToList(nfcDate, 'mmmm d');
|
|
||||||
AddToList(nfcDate, 'mmm. dd');
|
|
||||||
AddToList(nfcDate, 'mmm. d');
|
|
||||||
AddToList(nfcDate, 'mmmm yyyy');
|
|
||||||
AddToList(nfcDate, 'mmm. yy');
|
|
||||||
AddToList(nfcDate, 'yyyy-mmm');
|
|
||||||
AddToList(nfcDate, 'yy-mmm');
|
|
||||||
|
|
||||||
AddToList(nfcTime, fs.LongTimeFormat);
|
|
||||||
AddToList(nfcTime, fs.ShortTimeFormat);
|
|
||||||
AddToList(nfcTime, AddAMPM(fs.LongTimeFormat, fs));
|
|
||||||
AddToList(nfcTime, AddAMPM(fs.ShortTimeFormat, fs));
|
|
||||||
AddToList(nfcTime, 'nn:ss');
|
|
||||||
AddToList(nfcTime, 'nn:ss.0');
|
|
||||||
AddToList(nfcTime, 'nn:ss.00');
|
|
||||||
AddToList(nfcTime, 'nn:ss.000');
|
|
||||||
AddToList(nfcTime, '[h]:nn');
|
|
||||||
AddToList(nfcTime, '[h]:nn:ss');
|
|
||||||
|
|
||||||
AddToList(nfcText, '@');
|
|
||||||
|
|
||||||
// Add user-defined formats
|
|
||||||
if copiedFormats <> nil then
|
|
||||||
begin
|
|
||||||
for i:=0 to copiedFormats.Count-1 do begin
|
|
||||||
nfs := copiedFormats.Strings[i];
|
|
||||||
data := PtrInt(copiedFormats.Objects[i]);
|
|
||||||
NumFormats.AddObject(nfs, TObject(PtrInt(data)));
|
|
||||||
end;
|
|
||||||
copiedFormats.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure DestroyNumFormats;
|
|
||||||
begin
|
|
||||||
NumFormats.Free;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ Reads the user-defined number format strings from an ini file. }
|
|
||||||
procedure ReadNumFormatsFromIni(const AIniFile: TCustomIniFile);
|
|
||||||
var
|
|
||||||
section: String;
|
|
||||||
list: TStringList;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
i: Integer;
|
|
||||||
nfs: String;
|
|
||||||
scat: String;
|
|
||||||
begin
|
|
||||||
if NumFormats = nil
|
|
||||||
then NumFormats := TStringList.Create
|
|
||||||
else NumFormats.Clear;
|
|
||||||
|
|
||||||
list := TStringList.Create;
|
|
||||||
try
|
|
||||||
section := 'Built-in number formats';
|
|
||||||
AIniFile.ReadSection(section, list);
|
|
||||||
for i:=0 to list.Count-1 do begin
|
|
||||||
scat := list.Names[i];
|
|
||||||
nfs := list.Values[scat];
|
|
||||||
cat := TsNumFormatCategory(GetEnumValue(TypeInfo(TsNumFormatCategory), scat));
|
|
||||||
AddToList(cat, nfs, BUILTIN_OFFSET);
|
|
||||||
end;
|
|
||||||
|
|
||||||
list.Clear;
|
|
||||||
section := 'User-defined number formats';
|
|
||||||
AIniFile.ReadSection(section, list);
|
|
||||||
for i:=0 to list.Count-1 do begin
|
|
||||||
scat := list.Names[i];
|
|
||||||
nfs := list.Values[scat];
|
|
||||||
cat := TsNumFormatCategory(GetEnumValue(TypeInfo(TsNumFormatCategory), scat));
|
|
||||||
AddToList(cat, nfs, USER_OFFSET);
|
|
||||||
end;
|
|
||||||
|
|
||||||
finally
|
|
||||||
list.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure WriteNumFormatsToIni(const AIniFile: TCustomIniFile);
|
|
||||||
var
|
|
||||||
data: PtrInt;
|
|
||||||
section: String;
|
|
||||||
i: Integer;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
scat: String;
|
|
||||||
nfs: String;
|
|
||||||
begin
|
|
||||||
section := 'Built-in number formats';
|
|
||||||
for i:=0 to NumFormats.Count-1 do
|
|
||||||
begin
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if data < USER_OFFSET then
|
|
||||||
begin
|
|
||||||
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
|
|
||||||
scat := Copy(GetEnumName(TypeInfo(TsNumFormatCategory), ord(cat)), 3, MaxInt);
|
|
||||||
nfs := NumFormats.Strings[i];
|
|
||||||
AIniFile.WriteString(section, scat, nfs);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
section := 'User-defined number formats';
|
|
||||||
for i:=0 to NumFormats.Count-1 do
|
|
||||||
begin
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if data >= USER_OFFSET then
|
|
||||||
begin
|
|
||||||
cat := TsNumFormatCategory(data - USER_OFFSET);
|
|
||||||
scat := Copy(GetEnumName(TypeInfo(TsNumFormatCategory), ord(cat)), 3, MaxInt);
|
|
||||||
nfs := NumFormats.Strings[i];
|
|
||||||
AIniFile.WriteString(section, scat, nfs);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{ TNumFormatForm }
|
|
||||||
|
|
||||||
constructor TNumFormatForm.Create(AOwner: TComponent);
|
|
||||||
begin
|
|
||||||
inherited Create(AOwner);
|
|
||||||
FGenerator[nfcNumber] := -1234.123456;
|
|
||||||
FGenerator[nfcPercent] := -0.123456789;
|
|
||||||
FGenerator[nfcScientific] := -1234.5678;
|
|
||||||
FGenerator[nfcFraction] := -1234; //-1.23456;
|
|
||||||
FGenerator[nfcCurrency] := -1234.56789;
|
|
||||||
FGenerator[nfcDate] := EncodeDate(YearOf(date), 1, 1);
|
|
||||||
FGenerator[nfcTime] := EncodeTime(9, 0, 2, 235);
|
|
||||||
FGenerator[nfcText] := NaN;
|
|
||||||
GetRegisteredCurrencies(CbCurrSymbol.Items);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.BtnAddCurrSymbolClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
F: TCurrencyForm;
|
|
||||||
begin
|
|
||||||
F := TCurrencyForm.Create(nil);
|
|
||||||
try
|
|
||||||
if F.ShowModal = mrOK then
|
|
||||||
begin
|
|
||||||
GetRegisteredCurrencies(CbCurrSymbol.Items);
|
|
||||||
CbCurrSymbol.ItemIndex := CbCurrSymbol.Items.IndexOf(F.CurrencySymbol);
|
|
||||||
ReplaceCurrSymbol;
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.BtnAddFormatClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
idx: Integer;
|
|
||||||
nfs: String;
|
|
||||||
begin
|
|
||||||
if LbCategory.ItemIndex > -1 then begin
|
|
||||||
cat := TsNumFormatCategory(LbCategory.ItemIndex);
|
|
||||||
nfs := EdNumFormatStr.Text;
|
|
||||||
if nfs = '' then nfs := 'General';
|
|
||||||
if NumFormats.IndexOf(nfs) = -1 then
|
|
||||||
begin
|
|
||||||
AddToList(cat, nfs, USER_OFFSET);
|
|
||||||
SelectCategory(cat); // Rebuilds the "Format" listbox
|
|
||||||
idx := FindNumFormat(cat, nfs);
|
|
||||||
SelectFormat(idx);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.BtnDeleteFormatClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
idx: Integer;
|
|
||||||
nfs: String;
|
|
||||||
n, i: Integer;
|
|
||||||
begin
|
|
||||||
if LbCategory.ItemIndex > -1 then begin
|
|
||||||
// Find in internal template list
|
|
||||||
idx := NumFormats.IndexOf(EdNumFormatStr.Text);
|
|
||||||
if idx > -1 then begin
|
|
||||||
nfs := NumFormats.Strings[idx];
|
|
||||||
n := PtrInt(NumFormats.Objects[idx]);
|
|
||||||
if n >= USER_OFFSET
|
|
||||||
then cat := TsNumFormatCategory(n - USER_OFFSET)
|
|
||||||
else cat := TsNumFormatCategory(n - BUILTIN_OFFSET);
|
|
||||||
i := FindNumFormat(cat, nfs); // Index in format listbox
|
|
||||||
// Delete from internal template list
|
|
||||||
NumFormats.Delete(idx);
|
|
||||||
|
|
||||||
// Rebuild format listbox (without the deleted item)
|
|
||||||
SelectCategory(cat);
|
|
||||||
if i >= LbFormat.Items.Count
|
|
||||||
then SelectFormat(LbFormat.Items.Count-1)
|
|
||||||
else SelectFormat(i);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.CbCurrSymbolSelect(Sender: TObject);
|
|
||||||
begin
|
|
||||||
ReplaceCurrSymbol;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.CbNegRedClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
nfs: String;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
begin
|
|
||||||
if FLockCount > 0 then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if EdNumFormatStr.Text = '' then nfs := 'General' else nfs := EdNumFormatStr.Text;
|
|
||||||
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
|
|
||||||
if nfp <> nil then
|
|
||||||
try
|
|
||||||
nfp.SetNegativeRed(CbNegRed.Checked);
|
|
||||||
EdNumFormatStr.Text := nfp.NumFormatStr;
|
|
||||||
SelectCategory(TsNumFormatCategory(LbCategory.ItemIndex)); // to rebuild the format listbox
|
|
||||||
UpdateSample(nfp);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.CbThousandSepClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
nfs: String;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
begin
|
|
||||||
if FLockCount > 0 then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if EdNumFormatStr.Text = '' then nfs := 'General' else nfs := EdNumFormatStr.Text;
|
|
||||||
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
|
|
||||||
if nfp <> nil then
|
|
||||||
try
|
|
||||||
nfp.SetThousandSep(CbThousandSep.Checked);
|
|
||||||
EdNumFormatStr.Text := nfp.NumFormatStr;
|
|
||||||
SelectCategory(TsNumFormatCategory(LbCategory.ItemIndex)); // to rebuild the format listbox
|
|
||||||
UpdateSample(nfp);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.EdDecimalsChange(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if FLockCount > 0 then
|
|
||||||
exit;
|
|
||||||
ReplaceDecs;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.EdNumFormatStrChange(Sender: TObject);
|
|
||||||
var
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
begin
|
|
||||||
nfp := CreateNumFormatParams(EdNumFormatStr.Text, FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
UpdateControls(nfp);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ Returns the index of a specific number format string in the format listbox
|
|
||||||
shown for a particular category }
|
|
||||||
function TNumFormatForm.FindNumFormat(ACategory: TsNumFormatCategory;
|
|
||||||
ANumFormatStr: String): Integer;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
data: PtrInt;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
nfs: String;
|
|
||||||
begin
|
|
||||||
Result := -1;
|
|
||||||
if ANumFormatStr = '' then ANumFormatStr := 'General';
|
|
||||||
for i := 0 to NumFormats.Count-1 do begin
|
|
||||||
nfs := NumFormats.Strings[i];
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if data >= USER_OFFSET then
|
|
||||||
cat := TsNumFormatCategory(data - USER_OFFSET)
|
|
||||||
else
|
|
||||||
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
|
|
||||||
if (cat = ACategory) then
|
|
||||||
inc(Result);
|
|
||||||
if SameText(nfs, ANumFormatStr) then
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TNumFormatForm.FormatStrOfListIndex(AIndex: Integer): String;
|
|
||||||
var
|
|
||||||
idx: PtrInt;
|
|
||||||
begin
|
|
||||||
if (AIndex >= 0) and (AIndex < LbFormat.Count) then
|
|
||||||
begin
|
|
||||||
idx := PtrInt(LbFormat.Items.Objects[AIndex]);
|
|
||||||
Result := NumFormats.Strings[idx];
|
|
||||||
end else
|
|
||||||
Result := '';
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TNumFormatForm.GetNumFormatStr: String;
|
|
||||||
begin
|
|
||||||
Result := EdNumFormatStr.Text;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.LbCategoryClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
SelectCategory(TsNumFormatCategory(LbCategory.ItemIndex));
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.LbFormatClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
SelectFormat(LbFormat.ItemIndex);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.LbFormatDrawItem(Control: TWinControl; Index: Integer;
|
|
||||||
ARect: TRect; State: TOwnerDrawState);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
nfs: String;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
idx: PtrInt;
|
|
||||||
begin
|
|
||||||
Unused(Control);
|
|
||||||
LbFormat.Canvas.Brush.Color := clWindow;
|
|
||||||
LbFormat.Canvas.Font.Assign(LbFormat.Font);
|
|
||||||
if State * [odSelected, odFocused] <> [] then
|
|
||||||
begin
|
|
||||||
LbFormat.Canvas.Font.Color := clHighlightText;
|
|
||||||
LbFormat.Canvas.Brush.Color := clHighlight;
|
|
||||||
end;
|
|
||||||
if (Index > -1) and (Index < LbFormat.Items.Count) then
|
|
||||||
begin
|
|
||||||
s := LbFormat.Items[Index];
|
|
||||||
idx := PtrInt(LbFormat.Items.Objects[Index]);
|
|
||||||
nfs := NumFormats.Strings[idx];
|
|
||||||
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
if (nfp <> nil) and (Length(nfp.Sections) > 1) and (nfp.Sections[1].Color = scRed) then
|
|
||||||
LbFormat.Canvas.Font.Color := clRed;
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end else
|
|
||||||
s := '';
|
|
||||||
LbFormat.Canvas.FillRect(ARect);
|
|
||||||
LbFormat.Canvas.TextRect(ARect, ARect.Left+1, ARect.Top+1, s);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.ReplaceCurrSymbol;
|
|
||||||
var
|
|
||||||
cs: String;
|
|
||||||
i: Integer;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
data: PtrInt;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
begin
|
|
||||||
cs := CbCurrSymbol.Items[CbCurrSymbol.ItemIndex];
|
|
||||||
for i:=0 to NumFormats.Count-1 do
|
|
||||||
begin
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if (data >= USER_OFFSET) then
|
|
||||||
cat := TsNumFormatCategory(data - USER_OFFSET)
|
|
||||||
else
|
|
||||||
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
|
|
||||||
if cat = nfcCurrency then
|
|
||||||
begin
|
|
||||||
nfp := CreateNumFormatParams(NumFormats.Strings[i], FWorkbook.FormatSettings);
|
|
||||||
if (nfp <> nil) then
|
|
||||||
try
|
|
||||||
nfp.SetCurrSymbol(cs);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
SelectCategory(TsNumFormatCategory(LbCategory.ItemIndex)); // to rebuild the format listbox
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.ReplaceDecs;
|
|
||||||
var
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
begin
|
|
||||||
if EdDecimals.Text = '' then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
nfp := CreateNumFormatParams(EdNumFormatStr.Text, FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
nfp.SetDecimals(EdDecimals.Value);
|
|
||||||
EdNumFormatStr.Text := nfp.NumFormatStr;
|
|
||||||
UpdateSample(nfp);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.SelectCategory(ACategory: TsNumFormatCategory);
|
|
||||||
var
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
i, digits, numdigits: Integer;
|
|
||||||
data: PtrInt;
|
|
||||||
s: String;
|
|
||||||
genvalue: Double;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
begin
|
|
||||||
LbCategory.ItemIndex := ord(ACategory);
|
|
||||||
with LbFormat.Items do
|
|
||||||
begin
|
|
||||||
Clear;
|
|
||||||
for i:=0 to NumFormats.Count-1 do
|
|
||||||
begin
|
|
||||||
data := PtrInt(NumFormats.Objects[i]);
|
|
||||||
if data >= USER_OFFSET then
|
|
||||||
cat := TsNumFormatCategory(data - USER_OFFSET)
|
|
||||||
else
|
|
||||||
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
|
|
||||||
if cat = ACategory then
|
|
||||||
begin
|
|
||||||
nfp := CreateNumFormatParams(NumFormats.Strings[i], FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
if IsTextFormat(nfp) then
|
|
||||||
s := 'abc'
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
genValue := FGenerator[ACategory];
|
|
||||||
if nfkTimeInterval in nfp.Sections[0].Kind then
|
|
||||||
genvalue := genValue + 1.0;
|
|
||||||
if ACategory = nfcFraction then
|
|
||||||
begin
|
|
||||||
digits := nfp.Sections[0].FracInt;
|
|
||||||
numdigits := nfp.Sections[0].FracDenominator;
|
|
||||||
genvalue := 1.0 / (IntPower(10, numdigits) - 3);
|
|
||||||
if digits <> 0 then genvalue := -(1234 + genValue);
|
|
||||||
end;
|
|
||||||
s := ConvertFloatToStr(genValue, nfp, FWorkbook.FormatSettings);
|
|
||||||
if s = '' then s := 'General';
|
|
||||||
end;
|
|
||||||
LbFormat.Items.AddObject(s, TObject(PtrInt(i)));
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
CurrSymbolPanel.Visible := (ACategory = nfcCurrency);
|
|
||||||
GbOptions.Visible := not (ACategory in [nfcDate, nfcTime]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.SelectFormat(AIndex: Integer);
|
|
||||||
var
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
begin
|
|
||||||
if LbCategory.ItemIndex = -1 then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
LbFormat.ItemIndex := AIndex;
|
|
||||||
if AIndex >= 0 then begin
|
|
||||||
FNumFormatStrOfList := NumFormats.Strings[PtrInt(LbFormat.Items.Objects[AIndex])];
|
|
||||||
nfp := CreateNumFormatParams(FNumFormatStrOfList, FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
UpdateControls(nfp);
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.SetData(ANumFormatStr: String; AWorkbook: TsWorkbook;
|
|
||||||
ASample: variant);
|
|
||||||
var
|
|
||||||
cs: String;
|
|
||||||
begin
|
|
||||||
FWorkbook := AWorkbook;
|
|
||||||
cs := FWorkbook.FormatSettings.CurrencyString;
|
|
||||||
if (cs = '?') or (cs = '') then
|
|
||||||
cs := DefaultFormatSettings.CurrencyString;
|
|
||||||
CbCurrSymbol.ItemIndex := CbCurrSymbol.Items.IndexOf(cs);
|
|
||||||
|
|
||||||
if varIsStr(ASample) then
|
|
||||||
FSampleText := VarToStr(ASample)
|
|
||||||
else
|
|
||||||
FSampleValue := ASample;
|
|
||||||
InitNumFormats(FWorkbook.FormatSettings);
|
|
||||||
SetNumFormatStr(ANumFormatStr);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.SetNumFormatStr(const AValue: String);
|
|
||||||
var
|
|
||||||
nfs: String;
|
|
||||||
nfp: TsNumFormatParams;
|
|
||||||
cat: TsNumFormatCategory;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
if AValue = '' then
|
|
||||||
i := NumFormats.IndexOf('General')
|
|
||||||
else
|
|
||||||
i := NumFormats.IndexOf(AValue);
|
|
||||||
if i = -1 then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
nfs := NumFormats.Strings[i];
|
|
||||||
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
|
|
||||||
try
|
|
||||||
if nfkPercent in nfp.Sections[0].Kind then
|
|
||||||
cat := nfcPercent
|
|
||||||
else
|
|
||||||
if nfkExp in nfp.Sections[0].Kind then
|
|
||||||
cat := nfcScientific
|
|
||||||
else
|
|
||||||
if nfkCurrency in nfp.Sections[0].Kind then
|
|
||||||
cat := nfcCurrency
|
|
||||||
else
|
|
||||||
if nfkFraction in nfp.Sections[0].Kind then
|
|
||||||
cat := nfcFraction
|
|
||||||
else
|
|
||||||
if nfkDate in nfp.Sections[0].Kind then
|
|
||||||
cat := nfcDate
|
|
||||||
else
|
|
||||||
if (nfp.Sections[0].Kind * [nfkDate, nfkTime] = [nfkTime]) then
|
|
||||||
cat := nfcTime
|
|
||||||
else
|
|
||||||
cat := nfcNumber;
|
|
||||||
SelectCategory(cat);
|
|
||||||
SelectFormat(FindNumFormat(cat, AValue));
|
|
||||||
UpdateControls(nfp);
|
|
||||||
ReplaceCurrSymbol;
|
|
||||||
finally
|
|
||||||
nfp.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.UpdateControls(ANumFormatParams: TsNumFormatParams);
|
|
||||||
var
|
|
||||||
cs: String;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
if ANumFormatParams = nil then
|
|
||||||
begin
|
|
||||||
EdNumFormatStr.Text := 'General';
|
|
||||||
GbOptions.Hide;
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
EdNumFormatStr.Text := ANumFormatParams.NumFormatStr;
|
|
||||||
if (ANumFormatParams.Sections[0].Kind * [nfkDate, nfkTime] <> []) then
|
|
||||||
GbOptions.Hide
|
|
||||||
else begin
|
|
||||||
GbOptions.Show;
|
|
||||||
inc(FLockCount);
|
|
||||||
EdDecimals.Value := ANumFormatParams.Sections[0].Decimals;
|
|
||||||
CbNegRed.Checked := (Length(ANumFormatParams.Sections) > 1) and
|
|
||||||
(ANumFormatParams.Sections[1].Color = scRed);
|
|
||||||
CbThousandSep.Checked := nfkHasThSep in ANumFormatParams.Sections[0].Kind;
|
|
||||||
dec(FLockCount);
|
|
||||||
end;
|
|
||||||
if (nfkCurrency in ANumFormatParams.Sections[0].Kind) then
|
|
||||||
begin
|
|
||||||
cs := ANumFormatParams.Sections[0].CurrencySymbol;
|
|
||||||
if cs <> '' then
|
|
||||||
begin
|
|
||||||
i := CbCurrSymbol.Items.IndexOf(cs);
|
|
||||||
if i = -1 then begin
|
|
||||||
RegisterCurrency(cs);
|
|
||||||
i := CbCurrSymbol.Items.Add(cs);
|
|
||||||
end;
|
|
||||||
CbCurrSymbol.ItemIndex := i;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
UpdateSample(ANumFormatParams);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TNumFormatForm.UpdateSample(ANumFormatParams: TsNumFormatParams);
|
|
||||||
begin
|
|
||||||
if (FSampleValue < 0) and
|
|
||||||
(Length(ANumFormatParams.Sections) > 1) and
|
|
||||||
(ANumFormatParams.Sections[1].Color = scRed)
|
|
||||||
then
|
|
||||||
Sample.Font.Color := clRed
|
|
||||||
else
|
|
||||||
Sample.Font.Color := clWindowText;
|
|
||||||
|
|
||||||
if IsTextFormat(ANumFormatParams) then
|
|
||||||
Sample.Caption := ApplyTextFormat(FSampleText, ANumFormatParams)
|
|
||||||
else
|
|
||||||
Sample.Caption := ConvertFloatToStr(FSampleValue, ANumFormatParams,
|
|
||||||
FWorkbook.FormatSettings);
|
|
||||||
|
|
||||||
BtnAddFormat.Enabled := (EdNumFormatStr.Text <> FNumFormatStrOfList);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
initialization
|
|
||||||
|
|
||||||
finalization
|
|
||||||
DestroyNumFormats;
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,309 +0,0 @@
|
|||||||
object SearchForm: TSearchForm
|
|
||||||
Left = 238
|
|
||||||
Height = 341
|
|
||||||
Top = 157
|
|
||||||
Width = 487
|
|
||||||
BorderStyle = bsDialog
|
|
||||||
Caption = 'Search'
|
|
||||||
ClientHeight = 341
|
|
||||||
ClientWidth = 487
|
|
||||||
FormStyle = fsStayOnTop
|
|
||||||
OnClose = FormClose
|
|
||||||
OnCreate = FormCreate
|
|
||||||
OnShow = FormShow
|
|
||||||
LCLVersion = '1.5'
|
|
||||||
object ButtonPanel: TPanel
|
|
||||||
Left = 0
|
|
||||||
Height = 38
|
|
||||||
Top = 303
|
|
||||||
Width = 487
|
|
||||||
Align = alBottom
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 38
|
|
||||||
ClientWidth = 487
|
|
||||||
TabOrder = 0
|
|
||||||
object Bevel1: TBevel
|
|
||||||
Left = 6
|
|
||||||
Height = 3
|
|
||||||
Top = 0
|
|
||||||
Width = 475
|
|
||||||
Align = alTop
|
|
||||||
BorderSpacing.Left = 6
|
|
||||||
BorderSpacing.Right = 6
|
|
||||||
Shape = bsTopLine
|
|
||||||
end
|
|
||||||
object BtnSearchBack: TBitBtn
|
|
||||||
Left = 244
|
|
||||||
Height = 25
|
|
||||||
Top = 7
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Previous'
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000000000000000
|
|
||||||
000000000000000000000000000000000000994E035C994E0399000000000000
|
|
||||||
0000000000000000000000000000000000000000000000000000000000002E2E
|
|
||||||
2E2A141414840505055C000000009E53075C9D5206CC9D5206CC000000000000
|
|
||||||
0000000000000000000000000000000000000000000000000000000000003737
|
|
||||||
3774EADADAFF433F3F9E713E0987A3580BCCFFBA16FFA3580BCC000000000000
|
|
||||||
0000000000000000000000000000000000000000000000000000000000003E3E
|
|
||||||
3E4B64606090CAA88BFF9A5813EAF7BA30FFF6B11DFFAA5F10CC000000000000
|
|
||||||
0000000000000000000000000000000000000000000000000000000000000000
|
|
||||||
0000915B2180A6631CE7ECB952FFE09E29FFE5A83AFFB16616CC000000000000
|
|
||||||
000000000000000000000000000000000000000000000000000000000000BA6F
|
|
||||||
1D5CB96E1CCCE9BD6EFFCF9240FFCF9240FFD9A352FFB26A1BD4040404560404
|
|
||||||
047904040487040404790404045604040416000000000000000000000000C277
|
|
||||||
22CCFAD589FFE9AD61FFDFA357FFD5994DFFDCA95DFFB06D22E79D9791A5EEE8
|
|
||||||
E3C4F9F3EDD6EFEAE5C5A3A09EA92928287D1111112A0000000000000000C97E
|
|
||||||
275CCA7F28CCFBD88CFFEEB266FFEEB266FFF4C276FFCD8B40F2F3E6D9CBF6ED
|
|
||||||
E4CEF6EDE4CEF6EDE4CEF7EFE6D1DFD9D3B83D3C3B7426262614000000000000
|
|
||||||
0000D1862D5CD2872ECCFDDD91FFF2B96DFFF7CA7EFFD59345F3F5E9DFCBF6ED
|
|
||||||
E4CEF6EDE4CEF6EDE4CEF6EDE4CEF6ECE2CEADA69E9D31313149000000000000
|
|
||||||
000000000000D88D335CD98E33CCFEE195FFFBD488FFDB9848F2F6EDE4CEF6ED
|
|
||||||
E4CEF6EDE4CEF6EDE4CEF6EDE4CEF6EDE4CEE7D8CAB838383865000000000000
|
|
||||||
00000000000000000000DF94385CD08C38E2FFE498FFE19E4CF2E8D2BBC0F6ED
|
|
||||||
E4CEF6EDE4CEF6EDE4CEF6EDE4CEF6EDE4CEEDDBC8C53E3E3E6F000000000000
|
|
||||||
0000000000000000000000000000A4773E99E4A14DEEE5A24FF2E8D2BBC0E8D2
|
|
||||||
BBC0E8D2BBC0E8D2BBC0E8D2BBC0E8D2BBC0E4D3C1B243434360000000000000
|
|
||||||
000000000000000000000000000049494943CB9E68B7E8AF69E6F1E3D5C8F6ED
|
|
||||||
E4CEF6EDE4CEF6EDE4CEF6EDE4CEF2E4D6C8B0A4979149494943000000000000
|
|
||||||
00000000000000000000000000004D4D4D115F5D5A64D5C1AEA1EBD8C4C2F6EC
|
|
||||||
E2CDF6EDE4CEF6EDE4CEF6ECE2CDD9C8B8A4605D5B644D4D4D11000000000000
|
|
||||||
0000000000000000000000000000000000005151512163605E62B1A3948BE6D5
|
|
||||||
C5AFF4EADFC7EDE3D9B5B6ACA28E63605E625151512100000000000000000000
|
|
||||||
0000000000000000000000000000000000000000000054545411555555405555
|
|
||||||
555A555555655555555A55555540545454110000000000000000
|
|
||||||
}
|
|
||||||
OnClick = ExecuteClick
|
|
||||||
TabOrder = 0
|
|
||||||
Visible = False
|
|
||||||
end
|
|
||||||
object BtnClose: TBitBtn
|
|
||||||
Left = 404
|
|
||||||
Height = 25
|
|
||||||
Top = 7
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Cancel = True
|
|
||||||
DefaultCaption = True
|
|
||||||
Kind = bkClose
|
|
||||||
ModalResult = 11
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object BtnSearch: TBitBtn
|
|
||||||
Left = 324
|
|
||||||
Height = 25
|
|
||||||
Top = 7
|
|
||||||
Width = 75
|
|
||||||
Anchors = [akTop, akRight]
|
|
||||||
Caption = 'Search'
|
|
||||||
Default = True
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000000000000000
|
|
||||||
0000000000000000000000000000000000000000000000000000994E0399994E
|
|
||||||
035C000000000000000000000000000000000000000000000000000000002E2E
|
|
||||||
2E2A141414840505055C000000000000000000000000000000009D5206CC9D52
|
|
||||||
06CC9E53075C0000000000000000000000000000000000000000000000003737
|
|
||||||
3774EADADAFF433F3F9E05050544000000000000000000000000A3580BCCFFBF
|
|
||||||
25FFA3580BCCA4590C5C00000000000000000000000000000000000000003E3E
|
|
||||||
3E4B64606090DDD1D1FF302E2E96040404330000000000000000AA5F10CCFBB8
|
|
||||||
21FFFBBF34FFAA5F10CCAB60115C000000000000000000000000000000000000
|
|
||||||
00003D3D3D3853515186CCC4C4FF2221218C0404042500000000B16616CCEFB3
|
|
||||||
39FFEAA41DFFF2BD4AFFB16616CCB267175C0000000000000000000000000000
|
|
||||||
0000000000003C3C3C2A4746467CBCB8B8FF161515830404042AAB651ADDE4AE
|
|
||||||
50FFD99934FFD99934FFEABB60FFB56B1BD0BA6F1D5C00000000000000000000
|
|
||||||
000000000000000000003B3B3B1F3C3C3C73AFADADFF2B292887BC7B31EDE5B4
|
|
||||||
66FFCE9244FFCD9143FFCD9143FFE7BC6FFFBB7321D400000000000000000000
|
|
||||||
0000000000000000000000000000373737244746447BDED1C4BED09045F5F5C6
|
|
||||||
7AFFE9AD61FFDFA357FFF1CC80FFCD8C42F18A602FA626262614000000000000
|
|
||||||
000000000000000000000000000031313149A89D9397EAD5BFC3D7974BF5F7CB
|
|
||||||
7FFFF1B66AFFFDDC90FFD8984CF5E6C297E0ADA69E9D31313149000000000000
|
|
||||||
000000000000000000000000000038383865E1CFBCB1E8D2BBC0DD9D50F5FBD4
|
|
||||||
88FFFFE397FFDD9D50F5E9C59BE0F6EDE4CEE7D8CAB838383865000000000000
|
|
||||||
00000000000000000000000000003E3E3E6FE9D4BEBEE8D2BBC0E19E4CF2FFE5
|
|
||||||
99FFE3A354F5ECC89DE0F6EDE4CEF6EDE4CEEDDBC8C53E3E3E6F000000000000
|
|
||||||
000000000000000000000000000043434360E0CBB6ACE8D2BBC0E5A24FF2E5A2
|
|
||||||
4FF2E6BA84D7E8D2BBC0E8D2BBC0E8D2BBC0E4D3C1B243434360000000000000
|
|
||||||
000000000000000000000000000049494943AD9F918EE8D2BBC0EBB573E9F0CC
|
|
||||||
A0E0F6EDE4CEF6EDE4CEF6EDE4CEF2E4D6C8B0A4979149494943000000000000
|
|
||||||
00000000000000000000000000004D4D4D115F5D5A64D5C1AEA1EBD8C4C2F6EC
|
|
||||||
E2CDF6EDE4CEF6EDE4CEF6ECE2CDD9C8B8A4605D5B644D4D4D11000000000000
|
|
||||||
0000000000000000000000000000000000005151512163605E62B1A3948BE6D5
|
|
||||||
C5AFF4EADFC7EDE3D9B5B6ACA28E63605E625151512100000000000000000000
|
|
||||||
0000000000000000000000000000000000000000000054545411555555405555
|
|
||||||
555A555555655555555A55555540545454110000000000000000
|
|
||||||
}
|
|
||||||
OnClick = ExecuteClick
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object TabControl: TTabControl
|
|
||||||
Left = 8
|
|
||||||
Height = 287
|
|
||||||
Top = 8
|
|
||||||
Width = 471
|
|
||||||
OnChange = TabControlChange
|
|
||||||
OnChanging = TabControlChanging
|
|
||||||
TabIndex = 0
|
|
||||||
Tabs.Strings = (
|
|
||||||
'Search'
|
|
||||||
'Replace'
|
|
||||||
)
|
|
||||||
Align = alClient
|
|
||||||
BorderSpacing.Around = 8
|
|
||||||
TabOrder = 1
|
|
||||||
object SearchTextPanel: TPanel
|
|
||||||
Left = 2
|
|
||||||
Height = 33
|
|
||||||
Top = 23
|
|
||||||
Width = 467
|
|
||||||
Align = alTop
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 33
|
|
||||||
ClientWidth = 467
|
|
||||||
ParentColor = False
|
|
||||||
TabOrder = 1
|
|
||||||
object LblSearchText: TLabel
|
|
||||||
Left = 14
|
|
||||||
Height = 15
|
|
||||||
Top = 12
|
|
||||||
Width = 53
|
|
||||||
Caption = 'Search for'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbSearchText: TComboBox
|
|
||||||
Left = 104
|
|
||||||
Height = 23
|
|
||||||
Top = 8
|
|
||||||
Width = 351
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object ReplaceTextPanel: TPanel
|
|
||||||
Left = 2
|
|
||||||
Height = 33
|
|
||||||
Top = 56
|
|
||||||
Width = 467
|
|
||||||
Align = alTop
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 33
|
|
||||||
ClientWidth = 467
|
|
||||||
ParentColor = False
|
|
||||||
TabOrder = 2
|
|
||||||
Visible = False
|
|
||||||
object LblSearchText1: TLabel
|
|
||||||
Left = 14
|
|
||||||
Height = 15
|
|
||||||
Top = 12
|
|
||||||
Width = 67
|
|
||||||
Caption = 'Replace with'
|
|
||||||
ParentColor = False
|
|
||||||
end
|
|
||||||
object CbReplaceText: TComboBox
|
|
||||||
Left = 104
|
|
||||||
Height = 23
|
|
||||||
Top = 8
|
|
||||||
Width = 351
|
|
||||||
Anchors = [akTop, akLeft, akRight]
|
|
||||||
ItemHeight = 15
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
end
|
|
||||||
object SearchParamsPanel: TPanel
|
|
||||||
Left = 2
|
|
||||||
Height = 196
|
|
||||||
Top = 89
|
|
||||||
Width = 467
|
|
||||||
Align = alClient
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 196
|
|
||||||
ClientWidth = 467
|
|
||||||
ParentColor = False
|
|
||||||
TabOrder = 3
|
|
||||||
object CgOptions: TCheckGroup
|
|
||||||
Left = 16
|
|
||||||
Height = 163
|
|
||||||
Top = 16
|
|
||||||
Width = 192
|
|
||||||
AutoFill = True
|
|
||||||
Caption = 'Options'
|
|
||||||
ChildSizing.LeftRightSpacing = 6
|
|
||||||
ChildSizing.TopBottomSpacing = 6
|
|
||||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
|
||||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
|
||||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
|
||||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
|
||||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
|
||||||
ChildSizing.ControlsPerLine = 1
|
|
||||||
ClientHeight = 143
|
|
||||||
ClientWidth = 188
|
|
||||||
Items.Strings = (
|
|
||||||
'Compare entire cell '
|
|
||||||
'Match case'
|
|
||||||
'Regular expression'
|
|
||||||
'Search along rows'
|
|
||||||
'Continue at start/end'
|
|
||||||
)
|
|
||||||
TabOrder = 0
|
|
||||||
Data = {
|
|
||||||
050000000202020202
|
|
||||||
}
|
|
||||||
end
|
|
||||||
object RgSearchWithin: TRadioGroup
|
|
||||||
Left = 232
|
|
||||||
Height = 67
|
|
||||||
Top = 16
|
|
||||||
Width = 223
|
|
||||||
AutoFill = True
|
|
||||||
Caption = 'Search within'
|
|
||||||
ChildSizing.LeftRightSpacing = 6
|
|
||||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
|
||||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
|
||||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
|
||||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
|
||||||
ChildSizing.Layout = cclTopToBottomThenLeftToRight
|
|
||||||
ChildSizing.ControlsPerLine = 2
|
|
||||||
ClientHeight = 47
|
|
||||||
ClientWidth = 219
|
|
||||||
ColumnLayout = clVerticalThenHorizontal
|
|
||||||
Columns = 2
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'workbook'
|
|
||||||
'worksheet'
|
|
||||||
'column'
|
|
||||||
'row'
|
|
||||||
)
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object RgSearchStart: TRadioGroup
|
|
||||||
Left = 232
|
|
||||||
Height = 56
|
|
||||||
Top = 123
|
|
||||||
Width = 223
|
|
||||||
AutoFill = True
|
|
||||||
Caption = 'Start search at'
|
|
||||||
ChildSizing.LeftRightSpacing = 6
|
|
||||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
|
||||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
|
||||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
|
||||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
|
||||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
|
||||||
ChildSizing.ControlsPerLine = 2
|
|
||||||
ClientHeight = 36
|
|
||||||
ClientWidth = 219
|
|
||||||
Columns = 2
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'active cell'
|
|
||||||
'beginning/end'
|
|
||||||
)
|
|
||||||
TabOrder = 2
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,372 +0,0 @@
|
|||||||
unit sSearchForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
|
||||||
StdCtrls, ExtCtrls, Buttons, ComCtrls, fpsTypes, fpspreadsheet, fpsSearch;
|
|
||||||
|
|
||||||
type
|
|
||||||
TsSearchEvent = procedure (Sender: TObject; AFound: Boolean;
|
|
||||||
AWorksheet: TsWorksheet; ARow, ACol: Cardinal) of object;
|
|
||||||
|
|
||||||
{ TSearchForm }
|
|
||||||
|
|
||||||
TSearchForm = class(TForm)
|
|
||||||
Bevel1: TBevel;
|
|
||||||
BtnSearchBack: TBitBtn;
|
|
||||||
BtnClose: TBitBtn;
|
|
||||||
BtnSearch: TBitBtn;
|
|
||||||
CbSearchText: TComboBox;
|
|
||||||
CbReplaceText: TComboBox;
|
|
||||||
CgOptions: TCheckGroup;
|
|
||||||
LblSearchText: TLabel;
|
|
||||||
ButtonPanel: TPanel;
|
|
||||||
LblSearchText1: TLabel;
|
|
||||||
SearchParamsPanel: TPanel;
|
|
||||||
SearchTextPanel: TPanel;
|
|
||||||
RgSearchStart: TRadioGroup;
|
|
||||||
RgSearchWithin: TRadioGroup;
|
|
||||||
ReplaceTextPanel: TPanel;
|
|
||||||
TabControl: TTabControl;
|
|
||||||
procedure ExecuteClick(Sender: TObject);
|
|
||||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
||||||
procedure FormCreate(Sender: TObject);
|
|
||||||
procedure FormShow(Sender: TObject);
|
|
||||||
procedure TabControlChange(Sender: TObject);
|
|
||||||
procedure TabControlChanging(Sender: TObject; var AllowChange: Boolean);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
FSearchEngine: TsSearchEngine;
|
|
||||||
FWorkbook: TsWorkbook;
|
|
||||||
FFoundWorksheet: TsWorksheet;
|
|
||||||
FFoundRow, FFoundCol: Cardinal;
|
|
||||||
FSearchParams: TsSearchParams;
|
|
||||||
FReplaceParams: TsReplaceParams;
|
|
||||||
FOnFound: TsSearchEvent;
|
|
||||||
function GetReplaceParams: TsReplaceParams;
|
|
||||||
function GetSearchParams: TsSearchParams;
|
|
||||||
procedure SetReplaceParams(const AValue: TsReplaceParams);
|
|
||||||
procedure SetSearchParams(const AValue: TsSearchParams);
|
|
||||||
protected
|
|
||||||
procedure ConfirmReplacementHandler(Sender: TObject; AWorksheet: TsWorksheet;
|
|
||||||
ARow, ACol: Cardinal; const ASearchText, AReplaceText: String;
|
|
||||||
var AConfirmReplacement: TsConfirmReplacementResult);
|
|
||||||
procedure PopulateOptions;
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
procedure Execute(AWorkbook: TsWorkbook);
|
|
||||||
property Workbook: TsWorkbook read FWorkbook;
|
|
||||||
property SearchParams: TsSearchParams read GetSearchParams write SetSearchParams;
|
|
||||||
property ReplaceParams: TsReplaceParams read GetReplaceParams write SetReplaceParams;
|
|
||||||
property OnFound: TsSearchEvent read FOnFound write FOnFound;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
SearchForm: TSearchForm;
|
|
||||||
|
|
||||||
DefaultSearchParams: TsSearchParams = (
|
|
||||||
SearchText: '';
|
|
||||||
Options: [];
|
|
||||||
Within: swWorksheet
|
|
||||||
);
|
|
||||||
DefaultReplaceParams: TsReplaceParams = (
|
|
||||||
ReplaceText: '';
|
|
||||||
Options: [roConfirm]
|
|
||||||
);
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
fpsUtils;
|
|
||||||
|
|
||||||
const
|
|
||||||
MAX_SEARCH_ITEMS = 10;
|
|
||||||
|
|
||||||
// Search & replace
|
|
||||||
COMPARE_ENTIRE_CELL = 0;
|
|
||||||
MATCH_CASE = 1;
|
|
||||||
REGULAR_EXPRESSION = 2;
|
|
||||||
SEARCH_ALONG_ROWS = 3;
|
|
||||||
CONTINUE_AT_START_END = 4;
|
|
||||||
// Replace only
|
|
||||||
REPLACE_ENTIRE_CELL = 5;
|
|
||||||
REPLACE_ALL = 6;
|
|
||||||
CONFIRM_REPLACEMENT = 7;
|
|
||||||
|
|
||||||
BASE_HEIGHT = 340; // Design height of SearchForm
|
|
||||||
|
|
||||||
SEARCH_TAB = 0;
|
|
||||||
REPLACE_TAB = 1;
|
|
||||||
|
|
||||||
var
|
|
||||||
CONFIRM_REPLACEMENT_DLG_X: Integer = -1;
|
|
||||||
CONFIRM_REPLACEMENT_DLG_Y: Integer = -1;
|
|
||||||
|
|
||||||
{ TSearchForms }
|
|
||||||
|
|
||||||
procedure TSearchForm.ConfirmReplacementHandler(Sender: TObject;
|
|
||||||
AWorksheet: TsWorksheet; ARow, ACol: Cardinal; const ASearchText, AReplaceText: String;
|
|
||||||
var AConfirmReplacement: TsConfirmReplacementResult);
|
|
||||||
var
|
|
||||||
F: TForm;
|
|
||||||
begin
|
|
||||||
Unused(AWorksheet, ARow, ACol);
|
|
||||||
Unused(ASearchText, AReplaceText);
|
|
||||||
F := CreateMessageDialog('Replace?', mtConfirmation, [mbYes, mbNo, mbCancel]);
|
|
||||||
try
|
|
||||||
if (CONFIRM_REPLACEMENT_DLG_X = -1) then
|
|
||||||
F.Position := poMainformCenter
|
|
||||||
else begin
|
|
||||||
F.Position := poDesigned;
|
|
||||||
F.Left := CONFIRM_REPLACEMENT_DLG_X;
|
|
||||||
F.Top := CONFIRM_REPLACEMENT_DLG_Y;
|
|
||||||
end;
|
|
||||||
case F.ShowModal of
|
|
||||||
mrYes: AConfirmReplacement := crReplace;
|
|
||||||
mrNo : AConfirmReplacement := crIgnore;
|
|
||||||
mrCancel: AConfirmReplacement := crAbort;
|
|
||||||
end;
|
|
||||||
CONFIRM_REPLACEMENT_DLG_X := F.Left;
|
|
||||||
CONFIRM_REPLACEMENT_DLG_Y := F.Top;
|
|
||||||
finally
|
|
||||||
F.Free;
|
|
||||||
end;
|
|
||||||
{
|
|
||||||
case MessageDlg('Replace?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
|
|
||||||
mrYes: AConfirmReplacement := crReplace;
|
|
||||||
mrNo : AConfirmReplacement := crIgnore;
|
|
||||||
mrCancel: AConfirmReplacement := crAbort;
|
|
||||||
end;
|
|
||||||
}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.Execute(AWorkbook: TsWorkbook);
|
|
||||||
begin
|
|
||||||
FWorkbook := AWorkbook;
|
|
||||||
Show;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.ExecuteClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
sp: TsSearchParams;
|
|
||||||
rp: TsReplaceParams;
|
|
||||||
found: Boolean;
|
|
||||||
crs: TCursor;
|
|
||||||
begin
|
|
||||||
sp := GetSearchParams;
|
|
||||||
if sp.SearchText = '' then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if TabControl.TabIndex = REPLACE_TAB then
|
|
||||||
rp := GetReplaceParams;
|
|
||||||
|
|
||||||
if CbSearchText.Items.IndexOf(sp.SearchText) = -1 then
|
|
||||||
begin
|
|
||||||
CbSearchText.Items.Insert(0, sp.SearchText);
|
|
||||||
while CbSearchText.Items.Count > MAX_SEARCH_ITEMS do
|
|
||||||
CbSearchText.Items.Delete(CbSearchText.Items.Count-1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
if (TabControl.TabIndex = REPLACE_TAB) and
|
|
||||||
(CbReplaceText.Items.IndexOf(rp.ReplaceText) = -1) then
|
|
||||||
begin
|
|
||||||
CbReplaceText.items.Insert(0, rp.ReplaceText);
|
|
||||||
while CbReplaceText.Items.Count > MAX_SEARCH_ITEMS do
|
|
||||||
CbReplaceText.Items.Delete(CbReplaceText.Items.Count-1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
crs := Screen.Cursor;
|
|
||||||
try
|
|
||||||
Screen.Cursor := crHourglass;
|
|
||||||
if FSearchEngine = nil then
|
|
||||||
begin
|
|
||||||
FSearchEngine := TsSearchEngine.Create(FWorkbook);
|
|
||||||
FSearchEngine.OnConfirmReplacement := @ConfirmReplacementHandler;
|
|
||||||
if (soBackward in sp.Options) then
|
|
||||||
Include(sp.Options, soBackward) else
|
|
||||||
Exclude(sp.Options, soBackward);
|
|
||||||
case Tabcontrol.TabIndex of
|
|
||||||
0: found := FSearchEngine.FindFirst(sp, FFoundWorksheet, FFoundRow, FFoundCol);
|
|
||||||
1: found := FSearchEngine.ReplaceFirst(sp, rp, FFoundWorksheet, FFoundRow, FFoundCol);
|
|
||||||
end;
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
// Adjust "backward" option according to the button clicked
|
|
||||||
if (Sender = BtnSearchBack) then
|
|
||||||
Include(sp.Options, soBackward) else
|
|
||||||
Exclude(sp.Options, soBackward);
|
|
||||||
// Begin searching at current position
|
|
||||||
Exclude(sp.Options, soEntireDocument);
|
|
||||||
// User may select a different worksheet/different cell to continue search!
|
|
||||||
FFoundWorksheet := FWorkbook.ActiveWorksheet;
|
|
||||||
FFoundRow := FFoundWorksheet.ActiveCellRow;
|
|
||||||
FFoundCol := FFoundWorksheet.ActiveCellCol;
|
|
||||||
case TabControl.TabIndex of
|
|
||||||
0: found := FSearchEngine.FindFirst(sp, FFoundWorksheet, FFoundRow, FFoundCol);
|
|
||||||
1: found := FSearchEngine.ReplaceFirst(sp, rp, FFoundWorksheet, FFoundRow, FFoundCol);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
finally
|
|
||||||
Screen.Cursor := crs;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if Assigned(FOnFound) then
|
|
||||||
FOnFound(self, found, FFoundWorksheet, FFoundRow, FFoundCol);
|
|
||||||
|
|
||||||
BtnSearchBack.Visible := true;
|
|
||||||
BtnSearch.Caption := 'Next';
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
||||||
var
|
|
||||||
P: TPoint;
|
|
||||||
begin
|
|
||||||
Unused(CloseAction);
|
|
||||||
FreeAndNil(FSearchEngine);
|
|
||||||
P.X := Left;
|
|
||||||
P.Y := Top;
|
|
||||||
Position := poDesigned;
|
|
||||||
Left := P.X;
|
|
||||||
Top := P.Y;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.FormCreate(Sender: TObject);
|
|
||||||
begin
|
|
||||||
{$IFDEF MSWINDOWS}
|
|
||||||
SearchTextPanel.Color := clNone;
|
|
||||||
ReplaceTextPanel.Color := clNone;
|
|
||||||
SearchParamsPanel.Color := clNone;
|
|
||||||
{$ENDIF}
|
|
||||||
Position := poMainFormCenter;
|
|
||||||
PopulateOptions;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.FormShow(Sender: TObject);
|
|
||||||
begin
|
|
||||||
BtnSearch.Caption := 'Search';
|
|
||||||
BtnSearchBack.Visible := false;
|
|
||||||
|
|
||||||
FFoundCol := UNASSIGNED_ROW_COL_INDEX;
|
|
||||||
FFoundRow := UNASSIGNED_ROW_COL_INDEX;
|
|
||||||
FFoundWorksheet := nil;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TSearchForm.GetReplaceParams: TsReplaceParams;
|
|
||||||
begin
|
|
||||||
if TabControl.TabIndex = 0 then
|
|
||||||
Result := FReplaceParams
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Result.ReplaceText := CbReplaceText.Text;
|
|
||||||
Result.Options := [];
|
|
||||||
if CgOptions.Checked[REPLACE_ENTIRE_CELL] then
|
|
||||||
Include(Result.Options, roReplaceEntireCell);
|
|
||||||
if CgOptions.Checked[REPLACE_ALL] then
|
|
||||||
Include(Result.Options, roReplaceAll);
|
|
||||||
if CgOptions.Checked[CONFIRM_REPLACEMENT] then
|
|
||||||
Include(Result.Options, roConfirm);
|
|
||||||
FReplaceParams := Result;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TSearchForm.GetSearchParams: TsSearchParams;
|
|
||||||
begin
|
|
||||||
Result.SearchText := CbSearchText.Text;
|
|
||||||
Result.Options := [];
|
|
||||||
if CgOptions.Checked[COMPARE_ENTIRE_CELL] then
|
|
||||||
Include(Result.Options, soCompareEntireCell);
|
|
||||||
if CgOptions.Checked[MATCH_CASE] then
|
|
||||||
Include(Result.Options, soMatchCase);
|
|
||||||
if CgOptions.Checked[REGULAR_EXPRESSION] then
|
|
||||||
Include(Result.Options, soRegularExpr);
|
|
||||||
if CgOptions.Checked[SEARCH_ALONG_ROWS] then
|
|
||||||
Include(Result.Options, soAlongRows);
|
|
||||||
if CgOptions.Checked[CONTINUE_AT_START_END] then
|
|
||||||
Include(Result.Options, soWrapDocument);
|
|
||||||
if RgSearchStart.ItemIndex = 1 then
|
|
||||||
Include(Result.Options, soEntireDocument);
|
|
||||||
Result.Within := TsSearchWithin(RgSearchWithin.ItemIndex);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.PopulateOptions;
|
|
||||||
begin
|
|
||||||
with CgOptions.Items do
|
|
||||||
begin
|
|
||||||
Clear;
|
|
||||||
Add('Compare entire cell');
|
|
||||||
Add('Match case');
|
|
||||||
Add('Regular expression');
|
|
||||||
Add('Search along rows');
|
|
||||||
Add('Continue at start/end');
|
|
||||||
if TabControl.TabIndex = REPLACE_TAB then
|
|
||||||
begin
|
|
||||||
Add('Replace entire cell');
|
|
||||||
Add('Replace all');
|
|
||||||
Add('Confirm replacement');
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.SetSearchParams(const AValue: TsSearchParams);
|
|
||||||
begin
|
|
||||||
CbSearchText.Text := Avalue.SearchText;
|
|
||||||
CgOptions.Checked[COMPARE_ENTIRE_CELL] := (soCompareEntireCell in AValue.Options);
|
|
||||||
CgOptions.Checked[MATCH_CASE] := (soMatchCase in AValue.Options);
|
|
||||||
CgOptions.Checked[REGULAR_EXPRESSION] := (soRegularExpr in Avalue.Options);
|
|
||||||
CgOptions.Checked[SEARCH_ALONG_ROWS] := (soAlongRows in AValue.Options);
|
|
||||||
CgOptions.Checked[CONTINUE_AT_START_END] := (soWrapDocument in Avalue.Options);
|
|
||||||
RgSearchWithin.ItemIndex := ord(AValue.Within);
|
|
||||||
RgSearchStart.ItemIndex := ord(soEntireDocument in AValue.Options);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.SetReplaceParams(const AValue: TsReplaceParams);
|
|
||||||
begin
|
|
||||||
FReplaceParams := AValue;
|
|
||||||
if TabControl.TabIndex = REPLACE_TAB then
|
|
||||||
begin
|
|
||||||
CbReplaceText.Text := AValue.ReplaceText;
|
|
||||||
CgOptions.Checked[REPLACE_ENTIRE_CELL] := (roReplaceEntireCell in AValue.Options);
|
|
||||||
CgOptions.Checked[REPLACE_ALL] := (roReplaceAll in AValue.Options);
|
|
||||||
CgOptions.Checked[CONFIRM_REPLACEMENT] := (roConfirm in AValue.Options);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.TabControlChange(Sender: TObject);
|
|
||||||
var
|
|
||||||
h, d: Integer;
|
|
||||||
begin
|
|
||||||
ReplaceTextPanel.Visible := (TabControl.TabIndex = REPLACE_TAB);
|
|
||||||
PopulateOptions;
|
|
||||||
SetSearchParams(FSearchParams);
|
|
||||||
SetReplaceParams(FReplaceParams);
|
|
||||||
h := RgSearchStart.Top + RgSearchStart.Height - CgOptions.Top;
|
|
||||||
if TabControl.TabIndex = 0 then
|
|
||||||
begin
|
|
||||||
CgOptions.Height := h;
|
|
||||||
Height := BASE_HEIGHT - ReplaceTextPanel.Height;
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
d := 3 * 16;
|
|
||||||
CgOptions.Height := h + d;
|
|
||||||
Height := BASE_HEIGHT + d;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSearchForm.TabControlChanging(Sender: TObject;
|
|
||||||
var AllowChange: Boolean);
|
|
||||||
begin
|
|
||||||
AllowChange := true;
|
|
||||||
FSearchParams := GetSearchParams;
|
|
||||||
FReplaceParams := GetReplaceParams;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
@ -1,201 +0,0 @@
|
|||||||
object SortParamsForm: TSortParamsForm
|
|
||||||
Left = 434
|
|
||||||
Height = 314
|
|
||||||
Top = 274
|
|
||||||
Width = 485
|
|
||||||
Caption = 'Sorting criteria'
|
|
||||||
ClientHeight = 314
|
|
||||||
ClientWidth = 485
|
|
||||||
LCLVersion = '1.3'
|
|
||||||
object ButtonPanel: TButtonPanel
|
|
||||||
Left = 6
|
|
||||||
Height = 38
|
|
||||||
Top = 270
|
|
||||||
Width = 473
|
|
||||||
OKButton.Name = 'OKButton'
|
|
||||||
OKButton.DefaultCaption = True
|
|
||||||
OKButton.OnClick = OKButtonClick
|
|
||||||
HelpButton.Name = 'HelpButton'
|
|
||||||
HelpButton.DefaultCaption = True
|
|
||||||
CloseButton.Name = 'CloseButton'
|
|
||||||
CloseButton.DefaultCaption = True
|
|
||||||
CancelButton.Name = 'CancelButton'
|
|
||||||
CancelButton.DefaultCaption = True
|
|
||||||
TabOrder = 0
|
|
||||||
ShowButtons = [pbOK, pbCancel]
|
|
||||||
end
|
|
||||||
object Grid: TStringGrid
|
|
||||||
Left = 0
|
|
||||||
Height = 214
|
|
||||||
Top = 50
|
|
||||||
Width = 485
|
|
||||||
Align = alClient
|
|
||||||
ColCount = 4
|
|
||||||
Columns = <
|
|
||||||
item
|
|
||||||
ButtonStyle = cbsPickList
|
|
||||||
Title.Caption = 'Column'
|
|
||||||
Width = 120
|
|
||||||
end
|
|
||||||
item
|
|
||||||
ButtonStyle = cbsCheckboxColumn
|
|
||||||
PickList.Strings = (
|
|
||||||
'ascending'
|
|
||||||
'descending'
|
|
||||||
)
|
|
||||||
Title.Alignment = taCenter
|
|
||||||
Title.Caption = 'Descending'
|
|
||||||
Width = 120
|
|
||||||
end
|
|
||||||
item
|
|
||||||
ButtonStyle = cbsCheckboxColumn
|
|
||||||
Title.Alignment = taCenter
|
|
||||||
Title.Caption = 'Ignore case'
|
|
||||||
Width = 120
|
|
||||||
end>
|
|
||||||
DefaultColWidth = 120
|
|
||||||
Options = [goFixedVertLine, goFixedHorzLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]
|
|
||||||
RowCount = 2
|
|
||||||
TabOrder = 1
|
|
||||||
TitleStyle = tsNative
|
|
||||||
OnSelectEditor = GridSelectEditor
|
|
||||||
Cells = (
|
|
||||||
1
|
|
||||||
0
|
|
||||||
1
|
|
||||||
'Sort by'
|
|
||||||
)
|
|
||||||
end
|
|
||||||
object TopPanel: TPanel
|
|
||||||
Left = 0
|
|
||||||
Height = 50
|
|
||||||
Top = 0
|
|
||||||
Width = 485
|
|
||||||
Align = alTop
|
|
||||||
BevelOuter = bvNone
|
|
||||||
ClientHeight = 50
|
|
||||||
ClientWidth = 485
|
|
||||||
TabOrder = 2
|
|
||||||
object BtnAdd: TBitBtn
|
|
||||||
Left = 7
|
|
||||||
Height = 30
|
|
||||||
Top = 10
|
|
||||||
Width = 83
|
|
||||||
Caption = 'Add'
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0041924E233D8F497D3A8C44DB368940F332873CF32F84
|
|
||||||
37DB2C81337D287F3023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0049995853459653E6419950FF7DC28FFF96D0A6FF96CFA6FF78BE
|
|
||||||
89FF368D42FF2C8134E6297F3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00519F61534D9C5DF464B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
|
|
||||||
98FFA5D9B4FF58AA6BFF2C8134F4297F3053FFFFFF00FFFFFF00FFFFFF0059A6
|
|
||||||
6B2256A366E56AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
|
|
||||||
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234E5297F3022FFFFFF00FFFFFF005DA9
|
|
||||||
707E53AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF58B56EFF5CB774FFA6DAB4FF388F43FF2C82347EFFFFFF00FFFFFF0061AC
|
|
||||||
75DB8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
|
|
||||||
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539DBFFFFFF00FFFFFF0065AF
|
|
||||||
7AF6A9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DF6FFFFFF00FFFFFF0069B2
|
|
||||||
7EF6B6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42F6FFFFFF00FFFFFF006DB5
|
|
||||||
83DBACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
|
|
||||||
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47DBFFFFFF00FFFFFF0070B8
|
|
||||||
877E85C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
|
|
||||||
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF40914C7EFFFFFF00FFFFFF0073BA
|
|
||||||
8A2270B887E5AADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
|
|
||||||
95FF83D28EFFAFE0B7FF6BB97DFF489856E544945122FFFFFF00FFFFFF00FFFF
|
|
||||||
FF0073BB8B5370B887F4AFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
|
|
||||||
AFFFC0E8C5FF79C28AFF509E5FF44C9B5B53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF0073BB8B5371B887E694CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
|
|
||||||
B8FF6DB97FFF58A569E654A16553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF0074BB8B2371B9887D6EB684DB6AB380F367B17CF363AE
|
|
||||||
77DB60AB737D5CA86E23FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnAddClick
|
|
||||||
TabOrder = 0
|
|
||||||
end
|
|
||||||
object BtnDelete: TBitBtn
|
|
||||||
Left = 96
|
|
||||||
Height = 30
|
|
||||||
Top = 10
|
|
||||||
Width = 83
|
|
||||||
Caption = 'Delete'
|
|
||||||
Glyph.Data = {
|
|
||||||
36040000424D3604000000000000360000002800000010000000100000000100
|
|
||||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF003F54C3233A50C27D3853BEDB3551BDF3304BBCF32E4E
|
|
||||||
B8DB2B4CB77D2748B523FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF004658C8534255C6E63C52CCFF757AE8FF8F92EEFF8F92EEFF7178
|
|
||||||
E4FF334DC1FF2B4AB7E6294BB553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF004D5ACD534959CBF45C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
|
|
||||||
EEFF9EA0F4FF515DD7FF2B4AB7F4294BB553FFFFFF00FFFFFF00FFFFFF00545F
|
|
||||||
D2225361CFE5616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
|
|
||||||
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8E5294BB522FFFFFF00FFFFFF005860
|
|
||||||
D47E4B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF2A4AB87EFFFFFF00FFFFFF005C62
|
|
||||||
D7DB818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
|
|
||||||
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBADBFFFFFF00FFFFFF005F63
|
|
||||||
DAF6A1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCF6FFFFFF00FFFFFF006469
|
|
||||||
DBF6AFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
|
||||||
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEF6FFFFFF00FFFFFF00676A
|
|
||||||
DEDBA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
|
|
||||||
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0DBFFFFFF00FFFFFF006A69
|
|
||||||
E07E7D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
|
|
||||||
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF3E54C27EFFFFFF00FFFFFF006C6C
|
|
||||||
E1226A69E0E5A3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
|
|
||||||
F9FF768CF8FFA8B6F8FF636EE3FF4557C7E54156C522FFFFFF00FFFFFF00FFFF
|
|
||||||
FF006D6CE3536A69E0F4AAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
|
|
||||||
FBFFBAC7FCFF707BE9FF4C5BCCF44858CA53FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF006D6CE3536A6ADFE68E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
|
|
||||||
F4FF6670E2FF535ED1E6505DCE53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF006D6DE2236B6AE17D686ADDDB6364DCF36164DAF35D63
|
|
||||||
D9DB5B63D67D5862D423FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
|
||||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
|
||||||
}
|
|
||||||
OnClick = BtnDeleteClick
|
|
||||||
TabOrder = 1
|
|
||||||
end
|
|
||||||
object CbSortColsRows: TComboBox
|
|
||||||
Left = 185
|
|
||||||
Height = 28
|
|
||||||
Top = 11
|
|
||||||
Width = 160
|
|
||||||
ItemHeight = 20
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'Sort top to bottom'
|
|
||||||
'Sort left to right'
|
|
||||||
)
|
|
||||||
OnChange = CbSortColsRowsChange
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 2
|
|
||||||
Text = 'Sort top to bottom'
|
|
||||||
end
|
|
||||||
object CbPriority: TComboBox
|
|
||||||
Left = 353
|
|
||||||
Height = 28
|
|
||||||
Top = 11
|
|
||||||
Width = 120
|
|
||||||
ItemHeight = 20
|
|
||||||
ItemIndex = 0
|
|
||||||
Items.Strings = (
|
|
||||||
'Numbers first'
|
|
||||||
'Text first'
|
|
||||||
)
|
|
||||||
Style = csDropDownList
|
|
||||||
TabOrder = 3
|
|
||||||
Text = 'Numbers first'
|
|
||||||
end
|
|
||||||
end
|
|
||||||
end
|
|
||||||
@ -1,257 +0,0 @@
|
|||||||
unit sSortParamsForm;
|
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
uses
|
|
||||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
||||||
ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls,
|
|
||||||
fpstypes, fpspreadsheet, fpspreadsheetgrid;
|
|
||||||
|
|
||||||
type
|
|
||||||
|
|
||||||
{ TSortParamsForm }
|
|
||||||
|
|
||||||
TSortParamsForm = class(TForm)
|
|
||||||
BtnAdd: TBitBtn;
|
|
||||||
BtnDelete: TBitBtn;
|
|
||||||
ButtonPanel: TButtonPanel;
|
|
||||||
CbSortColsRows: TComboBox;
|
|
||||||
CbPriority: TComboBox;
|
|
||||||
TopPanel: TPanel;
|
|
||||||
Grid: TStringGrid;
|
|
||||||
procedure BtnAddClick(Sender: TObject);
|
|
||||||
procedure BtnDeleteClick(Sender: TObject);
|
|
||||||
procedure CbSortColsRowsChange(Sender: TObject);
|
|
||||||
procedure GridSelectEditor(Sender: TObject; aCol, aRow: Integer;
|
|
||||||
var Editor: TWinControl);
|
|
||||||
procedure OKButtonClick(Sender: TObject);
|
|
||||||
private
|
|
||||||
{ private declarations }
|
|
||||||
FWorksheetGrid: TsWorksheetGrid;
|
|
||||||
function GetSortParams: TsSortParams;
|
|
||||||
procedure SetWorksheetGrid(AValue: TsWorksheetGrid);
|
|
||||||
procedure UpdateColRowList;
|
|
||||||
procedure UpdateCmds;
|
|
||||||
function ValidParams(out AMsg: String): Boolean;
|
|
||||||
public
|
|
||||||
{ public declarations }
|
|
||||||
property SortParams: TsSortParams read GetSortParams;
|
|
||||||
property WorksheetGrid: TsWorksheetGrid read FWorksheetGrid write SetWorksheetGrid;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
SortParamsForm: TSortParamsForm;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
{$R *.lfm}
|
|
||||||
|
|
||||||
uses
|
|
||||||
fpsutils;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.CbSortColsRowsChange(Sender: TObject);
|
|
||||||
begin
|
|
||||||
UpdateColRowList;
|
|
||||||
UpdateCmds;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.GridSelectEditor(Sender: TObject;
|
|
||||||
aCol, aRow: Integer; var Editor: TWinControl);
|
|
||||||
begin
|
|
||||||
Unused(aCol, aRow);
|
|
||||||
if (Editor is TCustomComboBox) then
|
|
||||||
(Editor as TCustomComboBox).Style := csDropDownList;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.OKButtonClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
msg: String;
|
|
||||||
begin
|
|
||||||
if not ValidParams(msg) then begin
|
|
||||||
MessageDlg(msg, mtError, [mbOK], 0);
|
|
||||||
ModalResult := mrNone;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.BtnAddClick(Sender: TObject);
|
|
||||||
var
|
|
||||||
numConditions: Integer;
|
|
||||||
begin
|
|
||||||
case CbSortColsRows.ItemIndex of
|
|
||||||
0: numConditions := FWorksheetGrid.Selection.Right - FWorksheetGrid.Selection.Left + 1;
|
|
||||||
1: numConditions := FWorksheetGrid.Selection.Bottom - FWorksheetGrid.Selection.Top + 1;
|
|
||||||
end;
|
|
||||||
if Grid.RowCount - Grid.FixedRows >= numConditions then
|
|
||||||
exit; // there can't be more conditions than defined by the worksheetgrid selection
|
|
||||||
Grid.RowCount := Grid.RowCount + 1;
|
|
||||||
Grid.Cells[0, Grid.RowCount-1] := 'Then by';
|
|
||||||
Grid.Cells[1, Grid.RowCount-1] := '';
|
|
||||||
Grid.Cells[2, Grid.RowCount-1] := '0';
|
|
||||||
Grid.Cells[3, Grid.RowCount-1] := '0';
|
|
||||||
UpdateCmds;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.BtnDeleteClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
if Grid.RowCount = Grid.FixedRows + 1 then
|
|
||||||
exit; // 1 condition must remain
|
|
||||||
Grid.DeleteRow(Grid.Row);
|
|
||||||
Grid.Cells[0, 1] := 'Sort by';
|
|
||||||
UpdateCmds;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TSortParamsForm.GetSortParams: TsSortParams;
|
|
||||||
var
|
|
||||||
i, p: Integer;
|
|
||||||
n: Cardinal;
|
|
||||||
sortOptions: TsSortOptions;
|
|
||||||
s: String;
|
|
||||||
begin
|
|
||||||
// Sort by column or rows?
|
|
||||||
Result := InitSortParams(CbSortColsRows.ItemIndex = 0, 0);
|
|
||||||
|
|
||||||
// Number before Text, or reversed?
|
|
||||||
Result.Priority := TsSortPriority(CbPriority.ItemIndex);
|
|
||||||
|
|
||||||
for i:=Grid.FixedRows to Grid.RowCount-1 do
|
|
||||||
begin
|
|
||||||
sortOptions := [];
|
|
||||||
|
|
||||||
// Sort index column
|
|
||||||
s := Grid.Cells[1, i]; // the cell text is "Column A" or "Row A"
|
|
||||||
if s = '' then
|
|
||||||
raise Exception.Create('[TSortParamsForm.GetSortParams] No sort index selected.');
|
|
||||||
// This case should have been detected already by the ValidParams method.
|
|
||||||
|
|
||||||
p := pos(' ', s); // we look for the space and extract column/row index
|
|
||||||
if p = 0 then
|
|
||||||
raise Exception.Create('[TSortParamsForm.GetSortParams] Unexpected string in grid.');
|
|
||||||
s := copy(s, p+1, Length(s));
|
|
||||||
case CbSortColsRows.ItemIndex of
|
|
||||||
0: if not ParseCellColString(s, n) then
|
|
||||||
raise Exception.CreateFmt('[TSortParamsForm.GetSortParams] '+
|
|
||||||
'Unexpected column identifier in row %d', [i]);
|
|
||||||
1: if TryStrToInt(s, LongInt(n)) then
|
|
||||||
dec(n)
|
|
||||||
else
|
|
||||||
raise Exception.CreateFmt('[TSortParamsForm.GetSortParams] ' +
|
|
||||||
'Unexpected row identifier in row %s', [i]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Sort order column
|
|
||||||
s := Grid.Cells[2, i];
|
|
||||||
if s = '' then
|
|
||||||
raise Exception.Create('[TSortParamsForm.GetSortParams] No sort direction selected.');
|
|
||||||
if s = '1' then
|
|
||||||
Include(sortOptions, ssoDescending);
|
|
||||||
|
|
||||||
// Case sensitivity column
|
|
||||||
s := Grid.Cells[3, i];
|
|
||||||
if s = '1' then
|
|
||||||
Include(sortOptions, ssoCaseInsensitive);
|
|
||||||
|
|
||||||
SetLength(Result.Keys, Length(Result.Keys) + 1);
|
|
||||||
with Result.Keys[Length(Result.Keys)-1] do
|
|
||||||
begin
|
|
||||||
Options := sortOptions;
|
|
||||||
ColRowIndex := n;
|
|
||||||
end;
|
|
||||||
end; // for
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.SetWorksheetGrid(AValue: TsWorksheetGrid);
|
|
||||||
begin
|
|
||||||
FWorksheetGrid := AValue;
|
|
||||||
UpdateColRowList;
|
|
||||||
UpdateCmds;
|
|
||||||
Grid.Cells[1, 1] := Grid.Columns[0].PickList[0]; // Sorting index
|
|
||||||
Grid.Cells[2, 1] := '0'; // Ascending sort order Grid.Columns[1].CheckedPickList[0];
|
|
||||||
Grid.Cells[3, 1] := '0'; // case-sensitive comparisons
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.UpdateColRowList;
|
|
||||||
var
|
|
||||||
L: TStrings;
|
|
||||||
r,c: LongInt;
|
|
||||||
r1,c1, r2,c2: Cardinal;
|
|
||||||
begin
|
|
||||||
with FWorksheetGrid do begin
|
|
||||||
r1 := GetWorksheetRow(Selection.Top);
|
|
||||||
c1 := GetWorksheetCol(Selection.Left);
|
|
||||||
r2 := GetWorksheetRow(Selection.Bottom);
|
|
||||||
c2 := GetWorksheetCol(Selection.Right);
|
|
||||||
end;
|
|
||||||
L := TStringList.Create;
|
|
||||||
try
|
|
||||||
case CbSortColsRows.ItemIndex of
|
|
||||||
0: begin
|
|
||||||
Grid.RowCount := Grid.FixedRows + 1;
|
|
||||||
Grid.Columns[0].Title.Caption := 'Columns';
|
|
||||||
for c := c1 to c2 do
|
|
||||||
L.Add('Column ' + GetColString(c));
|
|
||||||
end;
|
|
||||||
1: begin
|
|
||||||
Grid.RowCount := Grid.FixedRows + 1;
|
|
||||||
Grid.Columns[0].Title.Caption := 'Rows';
|
|
||||||
for r := r1 to r2 do
|
|
||||||
L.Add('Row ' + IntToStr(r+1));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Grid.Columns[0].PickList.Assign(L);
|
|
||||||
for r := Grid.FixedRows to Grid.RowCount-1 do
|
|
||||||
begin
|
|
||||||
Grid.Cells[1, r] := '';
|
|
||||||
Grid.Cells[2, r] := ''
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
L.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TSortParamsForm.UpdateCmds;
|
|
||||||
var
|
|
||||||
r1,c1,r2,c2: Cardinal;
|
|
||||||
numConditions: Integer;
|
|
||||||
begin
|
|
||||||
with FWorksheetGrid do begin
|
|
||||||
r1 := GetWorksheetRow(Selection.Top);
|
|
||||||
c1 := GetWorksheetCol(Selection.Left);
|
|
||||||
r2 := GetWorksheetRow(Selection.Bottom);
|
|
||||||
c2 := GetWorksheetCol(Selection.Right);
|
|
||||||
end;
|
|
||||||
numConditions := Grid.RowCount - Grid.FixedRows;
|
|
||||||
case CbSortColsRows.ItemIndex of
|
|
||||||
0: BtnAdd.Enabled := numConditions < c2-c1+1;
|
|
||||||
1: BtnAdd.Enabled := numConditions < r2-r1+1;
|
|
||||||
end;
|
|
||||||
BtnDelete.Enabled := numConditions > 1;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TSortParamsForm.ValidParams(out AMsg: String): Boolean;
|
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
Result := false;
|
|
||||||
for i:=Grid.FixedRows to Grid.RowCount-1 do
|
|
||||||
begin
|
|
||||||
if Grid.Cells[1, i] = '' then
|
|
||||||
begin
|
|
||||||
AMsg := Format('No sorting criteria selected in row %d.', [i]);
|
|
||||||
Grid.SetFocus;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if Grid.Cells[2, i] = '' then
|
|
||||||
begin
|
|
||||||
AMsg := Format('No sort order specified in row %d.', [i]);
|
|
||||||
Grid.SetFocus;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Result := true;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
end.
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user