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