You've already forked lazarus-ccr
spready: extended version of the fpspreadsheet demo project fpsctrls - initial upload
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5277 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
673
applications/spready/fpssylk.pas
Normal file
673
applications/spready/fpssylk.pas
Normal file
@ -0,0 +1,673 @@
|
||||
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.
|
||||
|
||||
2
applications/spready/readme.txt
Normal file
2
applications/spready/readme.txt
Normal file
@ -0,0 +1,2 @@
|
||||
spready is a relatively complex demonstration of the fpspreadsheet library
|
||||
and its visual controls.
|
||||
140
applications/spready/sabout.lfm
Normal file
140
applications/spready/sabout.lfm
Normal file
@ -0,0 +1,140 @@
|
||||
object AboutForm: TAboutForm
|
||||
Left = 338
|
||||
Height = 294
|
||||
Top = 153
|
||||
Width = 375
|
||||
BorderStyle = bsSizeToolWin
|
||||
Caption = 'About Spready'
|
||||
ClientHeight = 294
|
||||
ClientWidth = 375
|
||||
Color = clWindow
|
||||
Constraints.MinHeight = 275
|
||||
Constraints.MinWidth = 330
|
||||
OnCreate = FormCreate
|
||||
Position = poMainFormCenter
|
||||
LCLVersion = '1.7'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 90
|
||||
Top = 0
|
||||
Width = 375
|
||||
Align = alTop
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 90
|
||||
ClientWidth = 375
|
||||
Color = clWindow
|
||||
ParentColor = False
|
||||
TabOrder = 0
|
||||
object IconImage: TImage
|
||||
Left = 8
|
||||
Height = 64
|
||||
Top = 16
|
||||
Width = 64
|
||||
end
|
||||
object BtnClose: TButton
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = IconImage
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 292
|
||||
Height = 29
|
||||
Top = 51
|
||||
Width = 75
|
||||
Anchors = [akRight, akBottom]
|
||||
BorderSpacing.Right = 8
|
||||
Cancel = True
|
||||
Caption = 'Close'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
object LblVersion: TLabel
|
||||
AnchorSideLeft.Control = IconImage
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = IconImage
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 84
|
||||
Height = 15
|
||||
Top = 65
|
||||
Width = 54
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'LblVersion'
|
||||
Font.Color = clNavy
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Image1: TImage
|
||||
AnchorSideLeft.Control = IconImage
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideBottom.Control = LblVersion
|
||||
Left = 84
|
||||
Height = 44
|
||||
Top = 21
|
||||
Width = 156
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
Picture.Data = {
|
||||
1754506F727461626C654E6574776F726B47726170686963B805000089504E47
|
||||
0D0A1A0A0000000D494844520000009C0000002C08060000009072D138000000
|
||||
097048597300000EC300000EC301C76FA8640000056A4944415478DAED5CDB6D
|
||||
5B310CF5000182204FE7A30B74824EE00D324137F002052E50B46EF2D311BA42
|
||||
47E80CDDA15BB8396804B034251D52F73A06C20F02ADE32B51D4111F47BC5EED
|
||||
F7FB554ACAB1248DF016377DF5695FE4E6E6DBF6A4007777F7B879566ABABCDC
|
||||
FD948A42CECFBFFCC6E7507ABD7E7A9F9B99800B030E4003A034C85A929B9980
|
||||
0B01EEFA7AF7DD03B4045C022E0C3828A08104003E7BBC87F5FAF183147CF7E2
|
||||
E2EBAF045C022E04B8FBFBA77752198089C9CDF0DCD5D5EE476E6602CE053819
|
||||
4ACFCE3EFF0190728312708B014E1609005F6E4E026E51C0BDA6222909B8045C
|
||||
02EE78211505C3B116890A184507F246492A23ACA31A1E9D03B928C6F2AEEFF6
|
||||
F6F12388ED51BDA41E18136BD51C671917FC67C4BE18DB22E8B14E6DEFD65E48
|
||||
D601EB8EE82275D0766EF26F00C292804305CC90CB6C056CCD813548C030BC21
|
||||
40517B460A0CCB82C1C36DB2E30A2A6BEA8D89F594FDEC1DFE110C68A6433FDF
|
||||
FC3204C65F0270001BB3A91E8FA4E780B7F012D55ED29BF10211129D8D30D223
|
||||
3102CFDC0BA9725FBC7497E4712DDB50C42F4E5C248434C0309545C1605618B1
|
||||
3C536FF1B539A0BF9C0360B7C6D29EC2D2CDF2563D8F6490E807EB857D35787A
|
||||
F995D603D1C2F248F8AC44121D51AC39F4B89E7DEE311DAEAB2D7C1EE5E66AE3
|
||||
794F700BF8DAF81E7A479FFCDE73F0FC6CE829A0646C2737ACE53DB5F7663CA2
|
||||
E50D2DC0E14046A29CB6A17569D0BABCAFE63E11E045F314BDF81610A261295A
|
||||
30C9E4B8E57D3D9CA6CEA16A373D525FFC9B1D5FEF69CD8B46EC211D55ED19D7
|
||||
203A77F194D4FA790F60F50D083B079B061C9E4CEE390D8E39725D23E9DEF40E
|
||||
A127B1D79EB9B687FA7BCC7E4930D7745AB15EC6EA87F3A03FEA79ACF0513BF5
|
||||
3AA446AA3C8F6E1A1CA3792ECB93497DBDD485D6B9E534744ECC1EBEA653F028
|
||||
0B835AC0C304BD4B7E8FF291536F25E711DEC8AB5BD4D3604DB0273C09361D21
|
||||
D9B2AD0508F93D2F85E2217E6564E91D60991F36D39EC809C486EB5CA0A7D028
|
||||
BBCD3C1F9D23425B58D29BB310C9A3634ADB2F654BB608B03D7DDDF90CB97EA3
|
||||
8C9F12707122B978ACDE98C7B0A5A7A1C393920CE71B1A7409B8FE2D40B9C62A
|
||||
E4B4CEFD4E0970B278A8E5661294BDB46218708709BD9D388F18894DCEE700DC
|
||||
9C97D93A24FD6B68ED1716A70438234FDDD4F69FBA753956F7C188912255AA67
|
||||
0EE9A5BD45034BE778AA664F0EE7ED5BF454A9D63A34DF28FFC6E8F22A80F31A
|
||||
89A501A280831197E89251C9FD1421BA7B55AA07C81677C8D8491FF89ACD99D7
|
||||
1166081BFF1B8809775EEE88BD4C8E022E42722E15AAF55D76252FDC46F93FA6
|
||||
2861F334095E969E095FC1D492E2DA66792984887147C2F6487BD05CDC236CC7
|
||||
5C3DE943CEEA6B75CF44F6A1CC27531196833C3050ADE380F10CACF76195D4EE
|
||||
DFD395E1059CBEC2630F5FEB8D35DDCCD8F39CECE5BAE5A97AFAD6DAC1583B59
|
||||
5C5B246235C31E0C0950F5DE47650C6A75721443E9D88FFF6B00046E33DCD59B
|
||||
D5855B3B14F0165247E640CA2648ED3D0A18643ED95A87F672561B96E804DECA
|
||||
F1E6C875A3B733B3F0511130781A1D5F366AB334BDE16D0A65F8474F83642958
|
||||
D875E808C0761247ED546B68F5E4BCD593C60A50CF4C682D92011DBC0CFB4339
|
||||
73F069588BE7FA89494118D0C974C1B30EEB9AB1424A4F73D84947016FBE5B25
|
||||
2CA10806D313C07825D4BA905D5924E602F0F48B2A98C3DB4F3F27815BF4B252
|
||||
87975F8C9A3C2FBC582F0A95B4458F135987754F0BDDAD9465C44E3A24BBF7E8
|
||||
2DBC9A96329FF4DE5948C0A5CC2A11323B019712BD377F1825C8137029A18221
|
||||
4A8E27E052429D2FD197E413702947F36E09B8148AEC3D7C3738FE03E209B814
|
||||
5707F4E8EFCD24E05268C0CDF1E34609B894EE5BFD233FF1F16A804B4981FC05
|
||||
9DCF04A745BF70B30000000049454E44AE426082
|
||||
}
|
||||
end
|
||||
end
|
||||
object Bevel1: TBevel
|
||||
Left = 0
|
||||
Height = 6
|
||||
Top = 90
|
||||
Width = 375
|
||||
Align = alTop
|
||||
Shape = bsTopLine
|
||||
end
|
||||
end
|
||||
130
applications/spready/sabout.pas
Normal file
130
applications/spready/sabout.pas
Normal file
@ -0,0 +1,130 @@
|
||||
unit sAbout;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, IpHtml, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TAboutForm }
|
||||
|
||||
TAboutForm = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
BtnClose: TButton;
|
||||
IconImage: TImage;
|
||||
Image1: TImage;
|
||||
LblVersion: TLabel;
|
||||
Panel1: TPanel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure HTMLViewerHotClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
FHTMLViewer: TIpHtmlPanel;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
AboutForm: TAboutForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
LCLIntf, Types, resource, versiontypes, versionresource;
|
||||
|
||||
const
|
||||
LE = LineEnding;
|
||||
|
||||
HTMLStr =
|
||||
'<!DOCTYPE html ' +
|
||||
'PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" '+
|
||||
'"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> '+ LE +
|
||||
'<html xmlns="http://www.w3.org/1999/xhtml">'+LE+
|
||||
'<head>' + LE +
|
||||
' <meta http-equiv="content-type" content="text/html; charset=UTF-8">' + LE +
|
||||
' <style type="text/css">' + LE +
|
||||
' body {background-color:ffffff;}' + LE +
|
||||
' h3{color:003366;}' + LE +
|
||||
' li{font-size:9pt}' + LE +
|
||||
' </style>' + LE +
|
||||
'<body>' + LE +
|
||||
' <h3>Compiler and libaries:</h3>' + LE +
|
||||
' <ul>'+ LE +
|
||||
' <li><a href="www.freepascal.org">Free Pascal</a></li>' + LE +
|
||||
' <li><a href="www.lazarus.freepascal.org">Lazarus</a></li>' + LE +
|
||||
' <li><a href="http://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/fpspreadsheet/">fpspreadsheet</a></li>' + LE +
|
||||
' </ul>' + LE +
|
||||
' <h3>Icons:</h3>' + LE +
|
||||
' <ul>' + LE +
|
||||
' <li><a href="p.yusukekamiyamane.com">Fugue Icons</a></li>' + LE +
|
||||
' <li><a href="www.famfamfam.com/lab/icons/silk/">famfamfam silk icons</a></li>' + LE +
|
||||
' <li><a href="http://tango.freedesktop.org/Tango_Icon_Library">Tango icon library</a></li>' + LE +
|
||||
// ' <li><a href="https://github.com/pasnox/oxygen-icons-png">Oxygen cons</a></li>' + LE +
|
||||
' </ul>' + LE +
|
||||
'</body>' + LE +
|
||||
'</html>';
|
||||
|
||||
|
||||
function ResourceVersionInfo: String;
|
||||
var
|
||||
Stream: TResourceStream;
|
||||
vr: TVersionResource;
|
||||
fi: TVersionFixedInfo;
|
||||
begin
|
||||
Result := '';
|
||||
try
|
||||
{ This raises an exception if version info has not been incorporated into the
|
||||
binary (Lazarus Project -> Project Options -> Version Info -> Version numbering). }
|
||||
Stream:= TResourceStream.CreateFromID(HINSTANCE, 1, PChar(RT_VERSION));
|
||||
try
|
||||
vr := TVersionResource.Create;
|
||||
try
|
||||
vr.SetCustomRawDataStream(Stream);
|
||||
fi := vr.FixedInfo;
|
||||
Result := Format('%d.%d', [
|
||||
fi.FileVersion[0], fi.FileVersion[1]
|
||||
]);
|
||||
vr.SetCustomRawDataStream(nil)
|
||||
finally
|
||||
vr.Free
|
||||
end;
|
||||
finally
|
||||
Stream.Free
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAboutForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
sz: TSize;
|
||||
begin
|
||||
sz.cx := 64; //128;
|
||||
sz.cy := 64; //128;
|
||||
|
||||
IconImage.Picture.Icon := Application.Icon;
|
||||
IconImage.Picture.Icon.Current := Application.Icon.GetBestIndexForSize(sz); //4;
|
||||
LblVersion.Caption := 'Version ' + ResourceVersionInfo;
|
||||
|
||||
FHTMLViewer := TIpHtmlPanel.Create(self);
|
||||
FHTMLViewer.Parent := self;
|
||||
FHTMLViewer.Align := alClient;
|
||||
FHTMLViewer.DefaultFontSize := 9;
|
||||
FHTMLViewer.OnHotClick := @HTMLViewerHotClick;
|
||||
FHTMLViewer.SetHtmlFromStr(HTMLStr);
|
||||
end;
|
||||
|
||||
procedure TAboutForm.HTMLViewerHotClick(Sender: TObject);
|
||||
begin
|
||||
OpenURL((Sender as TIpHtmlPanel).HotURL);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
109
applications/spready/scolwidthform.lfm
Normal file
109
applications/spready/scolwidthform.lfm
Normal file
@ -0,0 +1,109 @@
|
||||
object ColWidthForm: TColWidthForm
|
||||
Left = 479
|
||||
Height = 178
|
||||
Top = 289
|
||||
Width = 349
|
||||
HorzScrollBar.Page = 320
|
||||
HorzScrollBar.Range = 320
|
||||
VertScrollBar.Page = 141
|
||||
VertScrollBar.Range = 141
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'ColWidthForm'
|
||||
ClientHeight = 178
|
||||
ClientWidth = 349
|
||||
OnCreate = FormCreate
|
||||
Position = poMainFormCenter
|
||||
LCLVersion = '1.7'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 34
|
||||
Top = 138
|
||||
Width = 337
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.Caption = 'Close'
|
||||
CloseButton.DefaultCaption = False
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 0
|
||||
ShowButtons = [pbOK, pbCancel]
|
||||
end
|
||||
object EdColWidth: TFloatSpinEdit
|
||||
AnchorSideLeft.Control = LblColWidth
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = RbCustom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 124
|
||||
Height = 23
|
||||
Top = 94
|
||||
Width = 74
|
||||
Alignment = taRightJustify
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 24
|
||||
BorderSpacing.Bottom = 24
|
||||
Increment = 1
|
||||
MaxValue = 100
|
||||
MinValue = 0
|
||||
TabOrder = 1
|
||||
Value = 15
|
||||
end
|
||||
object LblColWidth: TLabel
|
||||
AnchorSideTop.Control = EdColWidth
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 24
|
||||
Height = 15
|
||||
Top = 98
|
||||
Width = 76
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Bottom = 24
|
||||
Caption = 'Column width'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbUnits: TComboBox
|
||||
AnchorSideLeft.Control = EdColWidth
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = EdColWidth
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 206
|
||||
Height = 23
|
||||
Top = 94
|
||||
Width = 114
|
||||
BorderSpacing.Left = 8
|
||||
ItemHeight = 15
|
||||
OnChange = CbUnitsChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
end
|
||||
object RbDefault: TRadioButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 24
|
||||
Width = 58
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 24
|
||||
Caption = 'Default'
|
||||
OnChange = ColWidthTypeChanged
|
||||
TabOrder = 3
|
||||
end
|
||||
object RbCustom: TRadioButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = RbDefault
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 51
|
||||
Width = 62
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Custom'
|
||||
Checked = True
|
||||
OnChange = ColWidthTypeChanged
|
||||
TabOrder = 4
|
||||
TabStop = True
|
||||
end
|
||||
end
|
||||
139
applications/spready/scolwidthform.pas
Normal file
139
applications/spready/scolwidthform.pas
Normal file
@ -0,0 +1,139 @@
|
||||
unit sColWidthForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
||||
StdCtrls, Spin, ExtCtrls, fpsTypes, fpspreadsheet;
|
||||
|
||||
type
|
||||
|
||||
{ TColWidthForm }
|
||||
|
||||
TColWidthForm = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
CbUnits: TComboBox;
|
||||
EdColWidth: TFloatSpinEdit;
|
||||
LblColWidth: TLabel;
|
||||
RbDefault: TRadioButton;
|
||||
RbCustom: TRadioButton;
|
||||
procedure CbUnitsChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ColWidthTypeChanged(Sender: TObject);
|
||||
private
|
||||
FWorkbook: TsWorkbook;
|
||||
FOldUnits: TsSizeUnits;
|
||||
function GetColWidth: Single;
|
||||
function GetColWidthType: TsColWidthType;
|
||||
function GetUnits: TsSizeUnits;
|
||||
procedure SetColWidth(AValue: Single);
|
||||
procedure SetColWidthType(AValue: TsColWidthType);
|
||||
procedure SetUnits(AValue: TsSizeUnits);
|
||||
procedure SetWorkbook(AValue: TsWorkbook);
|
||||
protected
|
||||
|
||||
public
|
||||
procedure SetData(AWorkbook: TsWorkbook; AColWidth: single;
|
||||
AColWidthType: TsColWidthType);
|
||||
property ColWidth: Single read GetColWidth;
|
||||
property ColWidthType: TsColWidthType read GetColWidthType;
|
||||
property Units: TsSizeUnits read GetUnits;
|
||||
end;
|
||||
|
||||
var
|
||||
ColWidthForm: TColWidthForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TColWidthForm }
|
||||
|
||||
procedure TColWidthForm.CbUnitsChange(Sender: TObject);
|
||||
begin
|
||||
if FWorkbook <> nil then
|
||||
EdColWidth.Value := FWorkbook.ConvertUnits(EdColWidth.Value, FOldUnits, GetUnits);
|
||||
FOldUnits := GetUnits;
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
CbUnits.Items.Clear;
|
||||
CbUnits.Items.AddObject('Characters', TObject(PtrInt(ord(suChars))));
|
||||
CbUnits.Items.AddObject('mm', TObject(PtrInt(ord(suMillimeters))));
|
||||
CbUnits.Items.AddObject('cm', TObject(PtrInt(ord(suCentimeters))));
|
||||
CbUnits.Items.AddObject('Points', TObject(PtrInt(ord(suPoints))));
|
||||
CbUnits.Items.AddObject('Inches', TObject(PtrInt(ord(suInches))));
|
||||
end;
|
||||
|
||||
function TColWidthForm.GetColWidth: Single;
|
||||
begin
|
||||
Result := EdColWidth.Value;
|
||||
end;
|
||||
|
||||
function TColWidthForm.GetColWidthType: TsColWidthType;
|
||||
begin
|
||||
if RbDefault.Checked then
|
||||
Result := cwtDefault
|
||||
else
|
||||
Result := cwtCustom;
|
||||
end;
|
||||
|
||||
function TColWidthForm.GetUnits: TsSizeUnits;
|
||||
begin
|
||||
if CbUnits.ItemIndex = -1 then
|
||||
Result := FWorkbook.Units else
|
||||
Result := TsSizeUnits(IntPtr(CbUnits.Items.Objects[CbUnits.ItemIndex]));
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.ColWidthTypeChanged(Sender: TObject);
|
||||
begin
|
||||
LblColWidth.Enabled := RbCustom.Checked;
|
||||
EdColWidth.Enabled := RbCustom.Checked;
|
||||
CbUnits.Enabled := RbCustom.Checked;
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.SetData(AWorkbook: TsWorkbook; AColWidth: Single;
|
||||
AColWidthType: TsColWidthType);
|
||||
begin
|
||||
SetWorkbook(AWorkbook);
|
||||
SetColWidth(AColWidth);
|
||||
SetUnits(AWorkbook.Units);
|
||||
SetColWidthType(AColWidthType);
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.SetColWidth(AValue: Single);
|
||||
begin
|
||||
EdColWidth.Value := AValue;
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.SetColWidthType(AValue: TsColWidthType);
|
||||
begin
|
||||
RbDefault.Checked := AValue = cwtDefault;
|
||||
RbCustom.Checked := AValue = cwtCustom;
|
||||
ColWidthTypeChanged(nil);
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.SetUnits(AValue: TsSizeUnits);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FOldUnits := GetUnits;
|
||||
for i:=0 to CbUnits.Items.Count-1 do
|
||||
if TsSizeUnits(IntPtr(CbUnits.Items.Objects[i])) = AValue then
|
||||
begin
|
||||
CbUnits.ItemIndex := i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TColWidthForm.SetWorkbook(AValue: TsWorkbook);
|
||||
begin
|
||||
FWorkbook := AValue;
|
||||
FOldUnits := FWorkbook.Units;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
554
applications/spready/scsvparamsform.lfm
Normal file
554
applications/spready/scsvparamsform.lfm
Normal file
@ -0,0 +1,554 @@
|
||||
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
|
||||
594
applications/spready/scsvparamsform.pas
Normal file
594
applications/spready/scsvparamsform.pas
Normal file
@ -0,0 +1,594 @@
|
||||
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.
|
||||
|
||||
326
applications/spready/sctrls.pas
Normal file
326
applications/spready/sctrls.pas
Normal file
@ -0,0 +1,326 @@
|
||||
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.
|
||||
|
||||
172
applications/spready/scurrencyform.lfm
Normal file
172
applications/spready/scurrencyform.lfm
Normal file
@ -0,0 +1,172 @@
|
||||
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
|
||||
100
applications/spready/scurrencyform.pas
Normal file
100
applications/spready/scurrencyform.pas
Normal file
@ -0,0 +1,100 @@
|
||||
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.
|
||||
|
||||
|
||||
|
||||
394
applications/spready/sformatsettingsform.lfm
Normal file
394
applications/spready/sformatsettingsform.lfm
Normal file
@ -0,0 +1,394 @@
|
||||
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
|
||||
470
applications/spready/sformatsettingsform.pas
Normal file
470
applications/spready/sformatsettingsform.pas
Normal file
@ -0,0 +1,470 @@
|
||||
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.
|
||||
|
||||
813
applications/spready/shyperlinkform.lfm
Normal file
813
applications/spready/shyperlinkform.lfm
Normal file
@ -0,0 +1,813 @@
|
||||
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
|
||||
550
applications/spready/shyperlinkform.pas
Normal file
550
applications/spready/shyperlinkform.pas
Normal file
@ -0,0 +1,550 @@
|
||||
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.
|
||||
|
||||
4869
applications/spready/smain.lfm
Normal file
4869
applications/spready/smain.lfm
Normal file
File diff suppressed because it is too large
Load Diff
1198
applications/spready/smain.pas
Normal file
1198
applications/spready/smain.pas
Normal file
File diff suppressed because it is too large
Load Diff
387
applications/spready/snumformatform.lfm
Normal file
387
applications/spready/snumformatform.lfm
Normal file
@ -0,0 +1,387 @@
|
||||
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
|
||||
829
applications/spready/snumformatform.pas
Normal file
829
applications/spready/snumformatform.pas
Normal file
@ -0,0 +1,829 @@
|
||||
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.
|
||||
|
||||
BIN
applications/spready/spready.ico
Normal file
BIN
applications/spready/spready.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 129 KiB |
191
applications/spready/spready.lpi
Normal file
191
applications/spready/spready.lpi
Normal file
@ -0,0 +1,191 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="spready"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<UseVersionInfo Value="True"/>
|
||||
<AutoIncrementBuild Value="True"/>
|
||||
<MajorVersionNr Value="1"/>
|
||||
<MinorVersionNr Value="7"/>
|
||||
<BuildNr Value="2"/>
|
||||
<StringTable InternalName="Spready" ProductName="Spready" ProductVersion="0.0.0.0"/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="2">
|
||||
<Item1 Name="Debug" Default="True"/>
|
||||
<Item2 Name="Release">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<StripSymbols Value="True"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="TurboPowerIPro"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="lazmrumenu"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="laz_fpspreadsheet_visual"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="14">
|
||||
<Unit0>
|
||||
<Filename Value="spready.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="smain.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="scsvparamsform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="sctrls.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="scurrencyform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="sformatsettingsform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="shyperlinkform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="snumformatform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="ssearchform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="ssortparamsform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="SortParamsForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sSortParamsForm"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="sutils.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="sabout.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="AboutForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sAbout"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="scolwidthform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="ColWidthForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sColWidthForm"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="srowheightform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="RowHeightForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="sRowHeightForm"/>
|
||||
</Unit13>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="bin\$(TargetCPU)-$(TargetOS)\spready"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
applications/spready/spready.lpr
Normal file
21
applications/spready/spready.lpr
Normal file
@ -0,0 +1,21 @@
|
||||
program spready;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, smain, sColWidthForm;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
MainForm.BeforeRun;
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
BIN
applications/spready/spready.res
Normal file
BIN
applications/spready/spready.res
Normal file
Binary file not shown.
123
applications/spready/srowheightform.lfm
Normal file
123
applications/spready/srowheightform.lfm
Normal file
@ -0,0 +1,123 @@
|
||||
object RowHeightForm: TRowHeightForm
|
||||
Left = 479
|
||||
Height = 203
|
||||
Top = 289
|
||||
Width = 325
|
||||
HorzScrollBar.Page = 304
|
||||
HorzScrollBar.Range = 304
|
||||
VertScrollBar.Page = 168
|
||||
VertScrollBar.Range = 168
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'RowHeightForm'
|
||||
ClientHeight = 203
|
||||
ClientWidth = 325
|
||||
OnCreate = FormCreate
|
||||
Position = poMainFormCenter
|
||||
LCLVersion = '1.7'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 34
|
||||
Top = 163
|
||||
Width = 313
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.Caption = 'Close'
|
||||
CloseButton.DefaultCaption = False
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 0
|
||||
ShowButtons = [pbOK, pbCancel]
|
||||
end
|
||||
object EdRowHeight: TFloatSpinEdit
|
||||
AnchorSideLeft.Control = LblRowHeight
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = RbCustom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 108
|
||||
Height = 23
|
||||
Top = 121
|
||||
Width = 74
|
||||
Alignment = taRightJustify
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 24
|
||||
BorderSpacing.Bottom = 24
|
||||
Increment = 1
|
||||
MaxValue = 100
|
||||
MinValue = 0
|
||||
TabOrder = 1
|
||||
Value = 15
|
||||
end
|
||||
object LblRowHeight: TLabel
|
||||
AnchorSideTop.Control = EdRowHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 24
|
||||
Height = 15
|
||||
Top = 125
|
||||
Width = 60
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Bottom = 24
|
||||
Caption = 'Row height'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbUnits: TComboBox
|
||||
AnchorSideLeft.Control = EdRowHeight
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = EdRowHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 190
|
||||
Height = 23
|
||||
Top = 121
|
||||
Width = 114
|
||||
BorderSpacing.Left = 8
|
||||
ItemHeight = 15
|
||||
OnChange = CbUnitsChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
end
|
||||
object RbDefault: TRadioButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 24
|
||||
Width = 102
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 24
|
||||
Caption = 'Reset to default'
|
||||
OnChange = RowHeightTypeChanged
|
||||
TabOrder = 3
|
||||
end
|
||||
object RbAuto: TRadioButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = RbDefault
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 51
|
||||
Width = 76
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Automatic'
|
||||
OnChange = RowHeightTypeChanged
|
||||
TabOrder = 4
|
||||
end
|
||||
object RbCustom: TRadioButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = RbAuto
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 78
|
||||
Width = 62
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Custom'
|
||||
Checked = True
|
||||
OnChange = RowHeightTypeChanged
|
||||
TabOrder = 5
|
||||
TabStop = True
|
||||
end
|
||||
end
|
||||
143
applications/spready/srowheightform.pas
Normal file
143
applications/spready/srowheightform.pas
Normal file
@ -0,0 +1,143 @@
|
||||
unit sRowHeightForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
||||
StdCtrls, Spin, ExtCtrls, fpsTypes, fpspreadsheet;
|
||||
|
||||
type
|
||||
|
||||
{ TRowHeightForm }
|
||||
|
||||
TRowHeightForm = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
CbUnits: TComboBox;
|
||||
EdRowHeight: TFloatSpinEdit;
|
||||
LblRowHeight: TLabel;
|
||||
RbDefault: TRadioButton;
|
||||
RbAuto: TRadioButton;
|
||||
RbCustom: TRadioButton;
|
||||
procedure CbUnitsChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure RowHeightTypeChanged(Sender: TObject);
|
||||
private
|
||||
FWorkbook: TsWorkbook;
|
||||
FOldUnits: TsSizeUnits;
|
||||
function GetRowHeight: Single;
|
||||
function GetRowHeightType: TsRowHeightType;
|
||||
function GetUnits: TsSizeUnits;
|
||||
procedure SetRowHeight(AValue: Single);
|
||||
procedure SetRowHeightType(AValue: TsRowHeightType);
|
||||
procedure SetUnits(AValue: TsSizeUnits);
|
||||
procedure SetWorkbook(AValue: TsWorkbook);
|
||||
protected
|
||||
|
||||
public
|
||||
procedure SetData(AWorkbook: TsWorkbook; ARowHeight: single;
|
||||
ARowHeightType: TsRowHeightType);
|
||||
property RowHeight: Single read GetRowHeight;
|
||||
property RowHeightType: TsRowHeightType read GetRowHeightType;
|
||||
property Units: TsSizeUnits read GetUnits;
|
||||
end;
|
||||
|
||||
var
|
||||
RowHeightForm: TRowHeightForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TRowHeightForm }
|
||||
|
||||
procedure TRowHeightForm.CbUnitsChange(Sender: TObject);
|
||||
begin
|
||||
if FWorkbook <> nil then
|
||||
EdRowHeight.Value := FWorkbook.ConvertUnits(EdRowHeight.Value, FOldUnits, GetUnits);
|
||||
FOldUnits := GetUnits;
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
CbUnits.Items.Clear;
|
||||
CbUnits.Items.AddObject('Lines', TObject(PtrInt(ord(suLines))));
|
||||
CbUnits.Items.AddObject('mm', TObject(PtrInt(ord(suMillimeters))));
|
||||
CbUnits.Items.AddObject('cm', TObject(PtrInt(ord(suCentimeters))));
|
||||
CbUnits.Items.AddObject('Points', TObject(PtrInt(ord(suPoints))));
|
||||
CbUnits.Items.AddObject('Inches', TObject(PtrInt(ord(suInches))));
|
||||
end;
|
||||
|
||||
function TRowHeightForm.GetRowHeight: Single;
|
||||
begin
|
||||
Result := EdRowHeight.Value;
|
||||
end;
|
||||
|
||||
function TRowHeightForm.GetRowHeightType: TsRowHeightType;
|
||||
begin
|
||||
if RbDefault.Checked then
|
||||
Result := rhtDefault
|
||||
else if RbAuto.Checked then
|
||||
Result := rhtAuto
|
||||
else
|
||||
Result := rhtCustom;
|
||||
end;
|
||||
|
||||
function TRowHeightForm.GetUnits: TsSizeUnits;
|
||||
begin
|
||||
if CbUnits.ItemIndex = -1 then
|
||||
Result := FWorkbook.Units else
|
||||
Result := TsSizeUnits(IntPtr(CbUnits.Items.Objects[CbUnits.ItemIndex]));
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.RowHeightTypeChanged(Sender: TObject);
|
||||
begin
|
||||
LblRowHeight.Enabled := RbCustom.Checked;
|
||||
EdRowHeight.Enabled := RbCustom.Checked;
|
||||
CbUnits.Enabled := RbCustom.Checked;
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.SetData(AWorkbook: TsWorkbook; ARowHeight: Single;
|
||||
ARowHeightType: TsRowHeightType);
|
||||
begin
|
||||
SetWorkbook(AWorkbook);
|
||||
SetRowHeight(ARowHeight);
|
||||
SetUnits(AWorkbook.Units);
|
||||
SetRowHeightType(ARowHeightType);
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.SetRowHeight(AValue: Single);
|
||||
begin
|
||||
EdRowHeight.Value := AValue;
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.SetRowHeightType(AValue: TsRowHeightType);
|
||||
begin
|
||||
RbDefault.Checked := AValue = rhtDefault;
|
||||
RbAuto.Checked := AValue= rhtAuto;
|
||||
RbCustom.Checked := AValue = rhtCustom;
|
||||
RowHeightTypeChanged(nil);
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.SetUnits(AValue: TsSizeUnits);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FOldUnits := GetUnits;
|
||||
for i:=0 to CbUnits.Items.Count-1 do
|
||||
if TsSizeUnits(IntPtr(CbUnits.Items.Objects[i])) = AValue then
|
||||
begin
|
||||
CbUnits.ItemIndex := i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRowHeightForm.SetWorkbook(AValue: TsWorkbook);
|
||||
begin
|
||||
FWorkbook := AValue;
|
||||
FOldUnits := FWorkbook.Units;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
309
applications/spready/ssearchform.lfm
Normal file
309
applications/spready/ssearchform.lfm
Normal file
@ -0,0 +1,309 @@
|
||||
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
|
||||
372
applications/spready/ssearchform.pas
Normal file
372
applications/spready/ssearchform.pas
Normal file
@ -0,0 +1,372 @@
|
||||
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.
|
||||
|
||||
218
applications/spready/ssortparamsform.lfm
Normal file
218
applications/spready/ssortparamsform.lfm
Normal file
@ -0,0 +1,218 @@
|
||||
object SortParamsForm: TSortParamsForm
|
||||
Left = 434
|
||||
Height = 314
|
||||
Top = 274
|
||||
Width = 496
|
||||
Caption = 'Sorting criteria'
|
||||
ClientHeight = 314
|
||||
ClientWidth = 496
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '1.7'
|
||||
object ButtonPanel: TButtonPanel
|
||||
Left = 6
|
||||
Height = 34
|
||||
Top = 274
|
||||
Width = 484
|
||||
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 = 226
|
||||
Top = 42
|
||||
Width = 496
|
||||
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 = 42
|
||||
Top = 0
|
||||
Width = 496
|
||||
Align = alTop
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 42
|
||||
ClientWidth = 496
|
||||
TabOrder = 2
|
||||
object BtnAdd: TBitBtn
|
||||
AnchorSideTop.Control = TopPanel
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 7
|
||||
Height = 30
|
||||
Top = 6
|
||||
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
|
||||
AnchorSideLeft.Control = BtnAdd
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BtnAdd
|
||||
Left = 96
|
||||
Height = 30
|
||||
Top = 6
|
||||
Width = 83
|
||||
BorderSpacing.Left = 6
|
||||
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
|
||||
AnchorSideLeft.Control = BtnDelete
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BtnAdd
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 187
|
||||
Height = 23
|
||||
Top = 10
|
||||
Width = 160
|
||||
BorderSpacing.Left = 8
|
||||
ItemHeight = 15
|
||||
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
|
||||
AnchorSideLeft.Control = CbSortColsRows
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BtnAdd
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 355
|
||||
Height = 23
|
||||
Top = 10
|
||||
Width = 120
|
||||
BorderSpacing.Left = 8
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Numbers first'
|
||||
'Text first'
|
||||
)
|
||||
Style = csDropDownList
|
||||
TabOrder = 3
|
||||
Text = 'Numbers first'
|
||||
end
|
||||
end
|
||||
end
|
||||
268
applications/spready/ssortparamsform.pas
Normal file
268
applications/spready/ssortparamsform.pas
Normal file
@ -0,0 +1,268 @@
|
||||
unit sSortParamsForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
ButtonPanel, Grids, ExtCtrls, Buttons, StdCtrls,
|
||||
fpstypes, 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 FormCreate(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.FormCreate(Sender: TObject);
|
||||
begin
|
||||
{$IFDEF WINDOWS}
|
||||
if Win32MajorVersion >= 10 then begin
|
||||
// avoid the ugly themed grid of Win10...
|
||||
Grid.TitleStyle := tsLazarus;
|
||||
end;
|
||||
{$ENDIF}
|
||||
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.
|
||||
|
||||
166
applications/spready/sutils.pas
Normal file
166
applications/spready/sutils.pas
Normal file
@ -0,0 +1,166 @@
|
||||
unit sutils;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
fpstypes, fpspreadsheet;
|
||||
|
||||
function GetCellFormatAsString(AWorkbook: TsWorkbook; AIndex: Integer): String;
|
||||
function GetColorName(AColor: TsColor): String;
|
||||
function GetFontAsString(AFont: TsFont): String;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Determines the name of a color from its rgb value
|
||||
-------------------------------------------------------------------------------}
|
||||
function GetColorName(AColor: TsColor): string;
|
||||
var
|
||||
rgba: TRGBA absolute AColor;
|
||||
begin
|
||||
case AColor of
|
||||
scAqua : Result := rsAqua;
|
||||
scBeige : Result := rsBeige;
|
||||
scBlack : Result := rsBlack;
|
||||
scBlue : Result := rsBlue;
|
||||
scBlueGray : Result := rsBlueGray;
|
||||
scBrown : Result := rsBrown;
|
||||
scCoral : Result := rsCoral;
|
||||
scCyan : Result := rsCyan;
|
||||
scDarkBlue : Result := rsDarkBlue;
|
||||
scDarkGreen : Result := rsDarkGreen;
|
||||
scDarkPurple : Result := rsDarkPurple;
|
||||
scDarkRed : Result := rsDarkRed;
|
||||
scDarkTeal : Result := rsDarkTeal;
|
||||
scGold : Result := rsGold;
|
||||
scGray : Result := rsGray;
|
||||
scGray10pct : Result := rsGray10pct;
|
||||
scGray20pct : Result := rsGray20pct;
|
||||
scGray40pct : Result := rsGray40pct;
|
||||
scGray80pct : Result := rsGray80pct;
|
||||
scGreen : Result := rsGreen;
|
||||
scIceBlue : Result := rsIceBlue;
|
||||
scIndigo : Result := rsIndigo;
|
||||
scIvory : Result := rsIvory;
|
||||
scLavander : Result := rsLavander;
|
||||
scLightBlue : Result := rsLightBlue;
|
||||
scLightGreen : Result := rsLightGreen;
|
||||
scLightOrange: Result := rsLightOrange;
|
||||
scLightTurquoise: Result := rsLightTurquoise;
|
||||
scLightYellow: Result := rsLightYellow;
|
||||
scLime : Result := rsLime;
|
||||
scMagenta : Result := rsMagenta;
|
||||
scNavy : Result := rsNavy;
|
||||
scOceanBlue : Result := rsOceanBlue;
|
||||
scOlive : Result := rsOlive;
|
||||
scOliveGreen : Result := rsOliveGreen;
|
||||
scOrange : Result := rsOrange;
|
||||
scPaleBlue : Result := rsPaleBlue;
|
||||
scPeriwinkle : Result := rsPeriwinkle;
|
||||
scPink : Result := rsPink;
|
||||
scPlum : Result := rsPlum;
|
||||
scPurple : Result := rsPurple;
|
||||
scRed : Result := rsRed;
|
||||
scRose : Result := rsRose;
|
||||
scSeaGreen : Result := rsSeaGreen;
|
||||
scSilver : Result := rsSilver;
|
||||
scSkyBlue : Result := rsSkyBlue;
|
||||
scTan : Result := rsTan;
|
||||
scTeal : Result := rsTeal;
|
||||
scVeryDarkGreen: Result := rsVeryDarkGreen;
|
||||
// scViolet : Result := rsViolet;
|
||||
scWheat : Result := rsWheat;
|
||||
scWhite : Result := rsWhite;
|
||||
scYellow : Result := rsYellow;
|
||||
scTransparent: Result := rsTransparent;
|
||||
scNotDefined : Result := rsNotDefined;
|
||||
else
|
||||
case rgba.a of
|
||||
$00:
|
||||
Result := Format('R%d G%d B%d', [rgba.r, rgba.g, rgba.b]);
|
||||
scPaletteIndexMask shr 24:
|
||||
Result := Format(rsPaletteIndex, [AColor and $00FFFFFF]);
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Returns a string describing the cell format with the specified index.
|
||||
-------------------------------------------------------------------------------}
|
||||
function GetCellFormatAsString(AWorkbook: TsWorkbook; AIndex: Integer): String;
|
||||
var
|
||||
fmt: PsCellFormat;
|
||||
cb: TsCellBorder;
|
||||
s: String;
|
||||
numFmt: TsNumFormatParams;
|
||||
begin
|
||||
Result := '';
|
||||
fmt := GetPointerToCellFormat(AIndex);
|
||||
if fmt = nil then
|
||||
exit;
|
||||
|
||||
if (uffFont in fmt^.UsedFormattingFields) then
|
||||
Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
|
||||
if (uffBackground in fmt^.UsedFormattingFields) then begin
|
||||
Result := Format('%s; Bg %s', [Result, GetColorName(fmt^.Background.BgColor)]);
|
||||
Result := Format('%s; Fg %s', [Result, GetColorName(fmt^.Background.FgColor)]);
|
||||
Result := Format('%s; Pattern %s', [Result, GetEnumName(TypeInfo(TsFillStyle), ord(fmt^.Background.Style))]);
|
||||
end;
|
||||
if (uffHorAlign in fmt^.UsedFormattingfields) then
|
||||
Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsHorAlignment), ord(fmt^.HorAlignment))]);
|
||||
if (uffVertAlign in fmt^.UsedFormattingFields) then
|
||||
Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsVertAlignment), ord(fmt^.VertAlignment))]);
|
||||
if (uffWordwrap in fmt^.UsedFormattingFields) then
|
||||
Result := Format('%s; Word-wrap', [Result]);
|
||||
if (uffNumberFormat in fmt^.UsedFormattingFields) then
|
||||
begin
|
||||
numFmt := GetNumberFormat(fmt^.NumberFormatIndex);
|
||||
if numFmt <> nil then
|
||||
Result := Format('%s; %s (%s)', [Result,
|
||||
GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)),
|
||||
numFmt.NumFormatStr
|
||||
])
|
||||
else
|
||||
Result := Format('%s; %s', [Result, 'nfGeneral']);
|
||||
end else
|
||||
Result := Format('%s; %s', [Result, 'nfGeneral']);
|
||||
if (uffBorder in fmt^.UsedFormattingFields) then
|
||||
begin
|
||||
s := '';
|
||||
for cb in fmt^.Border do
|
||||
if s = '' then s := GetEnumName(TypeInfo(TsCellBorder), ord(cb))
|
||||
else s := s + '+' + GetEnumName(TypeInfo(TsCellBorder), ord(cb));
|
||||
Result := Format('%s; %s', [Result, s]);
|
||||
end;
|
||||
if (uffBiDi in fmt^.UsedFormattingFields) then
|
||||
Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsBiDiMode), ord(fmt^.BiDiMode))]);
|
||||
if Result <> '' then Delete(Result, 1, 2);
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
Returns a string which identifies the font.
|
||||
|
||||
@param AIndex Index of the font
|
||||
@return String with font name, font size etc.
|
||||
-------------------------------------------------------------------------------}
|
||||
function GetFontAsString(AFont: TsFont): String;
|
||||
begin
|
||||
if AFont <> nil then begin
|
||||
Result := Format('%s; size %.1g; %s', [
|
||||
AFont.FontName, AFont.Size, GetColorName(AFont.Color)]);
|
||||
if (fssBold in AFont.Style) then Result := Result + '; bold';
|
||||
if (fssItalic in AFont.Style) then Result := Result + '; italic';
|
||||
if (fssUnderline in AFont.Style) then Result := Result + '; underline';
|
||||
if (fssStrikeout in AFont.Style) then result := Result + '; strikeout';
|
||||
if AFont.Position = fpSubscript then Result := Result + '; subscript';
|
||||
if AFont.Position = fpSuperscript then Result := Result + '; superscript';
|
||||
end else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user