diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index 7e6d8e979..ec2cad9ca 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -596,6 +596,9 @@ object MainFrm: TMainFrm 0036000000360000002000000002FFFFFF00FFFFFF00FFFFFF00 } end + object MenuItem76: TMenuItem + Caption = '-' + end object mnuOpen: TMenuItem Action = AcOpen Bitmap.Data = { @@ -927,6 +930,12 @@ object MainFrm: TMainFrm end object mnuFormat: TMenuItem Caption = 'Format' + object MenuItem75: TMenuItem + Action = AcFormatSettings + end + object MenuItem77: TMenuItem + Caption = '-' + end object MnuFOnt: TMenuItem Action = AcFont Bitmap.Data = { @@ -1399,6 +1408,12 @@ object MainFrm: TMainFrm AutoCheck = True end end + object MnuSettings: TMenuItem + Caption = 'Settings' + object MnuCSVParams: TMenuItem + Action = AcCSVParams + end + end end object ImageList: TImageList left = 272 @@ -3174,6 +3189,20 @@ object MainFrm: TMainFrm ImageIndex = 37 OnExecute = AcDeleteRowExecute end + object AcCSVParams: TAction + Category = 'Settings' + Caption = 'CSV parameters...' + OnExecute = AcCSVParamsExecute + end + object AcFormatSettings: TAction + Category = 'File' + Caption = 'Number format settings...' + Hint = 'Modify the global settings for number and date/time formatting' + OnExecute = AcFormatSettingsExecute + end + object Action1: TAction + Caption = 'Action1' + end end object FontDialog: TFontDialog MinFontSize = 0 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 8bf78a752..186414928 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -77,6 +77,9 @@ type AcShowGridlines: TAction; AcDeleteColumn: TAction; AcDeleteRow: TAction; + AcCSVParams: TAction; + AcFormatSettings: TAction; + Action1: TAction; AcViewInspector: TAction; AcWordwrap: TAction; AcVAlignDefault: TAction; @@ -166,6 +169,11 @@ type MenuItem72: TMenuItem; MenuItem73: TMenuItem; MenuItem74: TMenuItem; + MenuItem75: TMenuItem; + MenuItem76: TMenuItem; + MenuItem77: TMenuItem; + MnuCSVParams: TMenuItem; + MnuSettings: TMenuItem; mnuInspector: TMenuItem; mnuView: TMenuItem; MnuFmtDateTimeMSZ: TMenuItem; @@ -267,11 +275,13 @@ type procedure AcAddRowExecute(Sender: TObject); procedure AcBorderExecute(Sender: TObject); procedure AcCopyFormatExecute(Sender: TObject); + procedure AcCSVParamsExecute(Sender: TObject); procedure AcDeleteColumnExecute(Sender: TObject); procedure AcDeleteRowExecute(Sender: TObject); procedure AcEditExecute(Sender: TObject); procedure AcFontExecute(Sender: TObject); procedure AcFontStyleExecute(Sender: TObject); + procedure AcFormatSettingsExecute(Sender: TObject); procedure AcHorAlignmentExecute(Sender: TObject); procedure AcIncDecDecimalsExecute(Sender: TObject); procedure AcMergeCellsExecute(Sender: TObject); @@ -334,7 +344,8 @@ implementation uses TypInfo, LCLIntf, LCLType, - fpcanvas, fpsutils; + fpcanvas, fpsutils, fpscsv, + sFormatSettingsForm, sCSVParamsForm; const DROPDOWN_COUNT = 24; @@ -489,6 +500,20 @@ begin end; end; +procedure TMainFrm.AcCSVParamsExecute(Sender: TObject); +var + F: TCSVParamsForm; +begin + F := TCSVParamsForm.Create(nil); + try + F.SetParams(fpscsv.CSVParams); + if F.ShowModal = mrOK then + F.GetParams(fpscsv.CSVParams); + finally + F.Free; + end; +end; + procedure TMainFrm.AcDeleteColumnExecute(Sender: TObject); var c: Integer; @@ -535,6 +560,26 @@ begin end; end; +procedure TMainFrm.AcFormatSettingsExecute(Sender: TObject); +var + F: TFormatSettingsForm; +begin + if WorksheetGrid.Workbook = nil then + exit; + + F := TFormatSettingsForm.Create(nil); + try + F.FormatSettings := WorksheetGrid.Workbook.FormatSettings; + if F.ShowModal = mrOK then + begin + WorksheetGrid.Workbook.FormatSettings := F.FormatSettings; + WorksheetGrid.Invalidate; + end; + finally + F.Free; + end; +end; + procedure TMainFrm.AcHorAlignmentExecute(Sender: TObject); var hor_align: TsHorAlignment; @@ -848,6 +893,8 @@ begin CbBackgroundColor.ItemHeight := FontCombobox.ItemHeight; CbBackgroundColor.ColorRectWidth := CbBackgroundColor.ItemHeight - 6; // to get a square box... + InspectorPageControl.ActivePageIndex := 0; + // Populate font combobox FontCombobox.Items.Assign(Screen.Fonts); diff --git a/components/fpspreadsheet/examples/spready/scsvparamsform.lfm b/components/fpspreadsheet/examples/spready/scsvparamsform.lfm new file mode 100644 index 000000000..a1285661f --- /dev/null +++ b/components/fpspreadsheet/examples/spready/scsvparamsform.lfm @@ -0,0 +1,533 @@ +object CSVParamsForm: TCSVParamsForm + Left = 638 + Height = 528 + Top = 250 + Width = 470 + BorderStyle = bsDialog + Caption = 'Parameters for comma-delimited files' + ClientHeight = 528 + ClientWidth = 470 + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '1.3' + object ButtonPanel: TButtonPanel + Left = 6 + Height = 34 + Top = 488 + 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 = 472 + Top = 8 + Width = 454 + ActivePage = PgNumberParams + Align = alClient + BorderSpacing.Around = 8 + TabIndex = 1 + TabOrder = 1 + object PgGeneralParams: TTabSheet + Caption = 'General' + ClientHeight = 454 + 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 = 155 + 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 = 155 + 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 = 155 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'System' + 'CR+LF (Windows)' + 'CR (Unix/Linux)' + 'LF (Mac)' + ) + Style = csDropDownList + TabOrder = 1 + Text = 'System' + end + object RgDetectContentType: TRadioGroup + Left = 19 + Height = 80 + Top = 128 + Width = 292 + 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 = 288 + ItemIndex = 1 + Items.Strings = ( + 'Do not convert, strings are sufficient' + 'Try to convert strings to content types' + ) + TabOrder = 3 + end + end + object PgNumberParams: TTabSheet + Caption = 'Number cells' + ClientHeight = 444 + 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' + 'Dot ( . )' + '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' + 'Dot ( . )' + 'Comma ( , )' + 'Space ( )' + ) + TabOrder = 2 + Text = 'like spreadsheet' + end + end + object PgCurrency: TTabSheet + Caption = 'Currency cells' + ClientHeight = 444 + 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 = 444 + 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 = 454 + ClientWidth = 446 + object EdTRUE: TEdit + Left = 16 + Height = 23 + Top = 45 + Width = 131 + TabOrder = 0 + end + object EdFALSE: TEdit + Left = 176 + Height = 23 + Top = 45 + 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/spready/scsvparamsform.pas b/components/fpspreadsheet/examples/spready/scsvparamsform.pas new file mode 100644 index 000000000..d867015cf --- /dev/null +++ b/components/fpspreadsheet/examples/spready/scsvparamsform.pas @@ -0,0 +1,593 @@ +unit sCSVParamsForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ButtonPanel, ExtCtrls, ComCtrls, StdCtrls, + fpsCSV, + sCtrls, sFormatsettingsForm; + +type + + { TCSVParamsForm } + + TCSVParamsForm = class(TForm) + ButtonPanel: TButtonPanel; + CbAutoDetectNumberFormat: TCheckBox; + CbLongDateFormat: TComboBox; + CbLongTimeFormat: 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; + 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 + +uses + fpsUtils; + +resourcestring + rsLikeSpreadsheet = 'like spreadsheet'; + + { +const + CURR_VALUE = 100.0; + } + +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 := DefaultFormatSettings; + 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.EdCurrencySymbolChange(Sender: TObject); +var + sel: Integer; +begin + sel := CbPosCurrencyFormat.ItemIndex; + CbPosCurrencyFormat.Items.BeginUpdate; + try + CbPosCurrencyFormat.Items.Clear; + BuildCurrencyFormatList(CbPosCurrencyFormat.Items, true, CURR_VALUE, GetCurrencySymbol); + CbPosCurrencyFormat.Items.Insert(0, rsLikeSpreadsheet); + CbPosCurrencyFormat.ItemIndex := sel; + finally + CbPosCurrencyFormat.Items.EndUpdate; + end; + + sel := CbNegCurrencyFormat.ItemIndex; + CbNegCurrencyFormat.Items.BeginUpdate; + try + CbNegCurrencyFormat.Items.Clear; + BuildCurrencyFormatList(CbNegCurrencyFormat.Items, false, CURR_VALUE, GetCurrencySymbol); + CbNegCurrencyFormat.Items.Insert(0, rsLikeSpreadsheet); + CbNegCurrencyFormat.ItemIndex := sel; + finally + CbNegCurrencyFormat.Items.EndUpdate; + end; +end; +*) + +procedure TCSVParamsForm.FormCreate(Sender: TObject); +begin + PageControl.ActivePageIndex := CSVParamsPageIndex; + +// CbNegCurrencyFormat.DropdownCount := 32; + + FEdLongMonthNames := TMonthDayNamesEdit.Create(self); + with FEdLongMonthNames do + begin + Parent := PgDateTimeParams; + Left := CbDateSeparator.Left; + Top := CbDateSeparator.Top + 32; + Width := CbDateSeparator.Width; + 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 := CbDateSeparator.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 := CbDateSeparator.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 := CbDateSeparator.Width; + TabOrder := CbDateSeparator.TabOrder + 4; + OnChange := @DateTimeFormatChange; + OnEnter := @DateTimeFormatChange; + end; + LblShortDayNames.FocusControl := FEdShortDayNames; + + FDateFormatSample := DefaultFormatSettings.LongDateFormat; + FTimeFormatSample := DefaultFormatSettings.LongTimeFormat; + FSampleDateTime := now(); +end; + { +function TCSVParamsForm.GetCurrencySymbol: String; +begin + if EdCurrencySymbol.Text = rsLikeSpreadsheet then + Result := AnsiToUTF8(DefaultFormatSettings.CurrencyString) + else + Result := EdCurrencySymbol.Text; +end; + } +procedure TCSVParamsForm.GetParams(var AParams: TsCSVParams); +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; + + // 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 := UTF8ToAnsi(EdCurrencySymbol.Text); + + { + // Pos currency format + if CbPosCurrencyFormat.ItemIndex = 0 then + AParams.FormatSettings.CurrencyFormat := byte(-1) + else + AParams.FormatSettings.CurrencyFormat := CbPosCurrencyFormat.ItemIndex-1; + + // Neg currency format + if CbNegCurrencyFormat.ItemIndex = 0 then + AParams.FormatSettings.NegCurrFormat := byte(-1) + else + AParams.FormatSettings.NegCurrFormat := CbNegCurrencyFormat.ItemIndex-1; + } + + // 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); +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; + + // 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 := AnsiToUTF8(AParams.FormatSettings.CurrencyString); +(* + // Positive currency format + BuildCurrencyFormatList(CbPosCurrencyFormat.Items, true, CURR_VALUE, GetCurrencySymbol); + CbPosCurrencyFormat.Items.Insert(0, rsLikeSpreadsheet); + if AParams.FormatSettings.CurrencyFormat = byte(-1) then + CbPosCurrencyformat.ItemIndex := 0 + else + CbPoscurrencyFormat.ItemIndex := AParams.FormatSettings.CurrencyFormat+1; + + // Negative currency format + BuildCurrencyFormatList(CbNegCurrencyFormat.Items, false, CURR_VALUE, GetCurrencySymbol); + CbNegCurrencyFormat.Items.Insert(0, rsLikeSpreadsheet); + if AParams.FormatSettings.NegCurrFormat = byte(-1) then + CbNegCurrencyformat.ItemIndex := 0 + else + CbNegcurrencyFormat.ItemIndex := AParams.FormatSettings.NegCurrFormat+1; +*) + // 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/spready/sctrls.pas b/components/fpspreadsheet/examples/spready/sctrls.pas new file mode 100644 index 000000000..768c86cf0 --- /dev/null +++ b/components/fpspreadsheet/examples/spready/sctrls.pas @@ -0,0 +1,264 @@ +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 ButtonClick(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; + + +{ TMonthDayNamesEdit } + +constructor TMonthDayNamesEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Button.Caption := '...'; + //ButtonCaption := '...'; + OnButtonClick := @ButtonClick; +end; + +procedure TMonthDayNamesEdit.ButtonClick(Sender: TObject); +var + List: TStringList; + F: TForm; + i, j: Integer; + s: String; + isEmpty: Boolean; + grid: TStringGrid; + 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; + 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] := UTF8ToAnsi(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 := AnsiToUTF8(DayNamesToString(TWeekNameArray(ANamesArray), AEmptyString)); + 12: Text := AnsiToUTF8(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/spready/sformatsettingsform.lfm b/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm new file mode 100644 index 000000000..99dfbf1b3 --- /dev/null +++ b/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm @@ -0,0 +1,378 @@ +object FormatSettingsForm: TFormatSettingsForm + Left = 417 + Height = 476 + Top = 229 + Width = 417 + BorderStyle = bsDialog + Caption = 'Workbook format settings' + ClientHeight = 476 + ClientWidth = 417 + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '1.3' + object PageControl: TPageControl + Left = 8 + Height = 420 + Top = 8 + Width = 401 + ActivePage = PgDateTime + Align = alClient + BorderSpacing.Around = 8 + TabIndex = 2 + TabOrder = 0 + OnChange = PageControlChange + object PgNumber: TTabSheet + Caption = 'Number' + ClientHeight = 392 + ClientWidth = 393 + 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 = 373 + Width = 385 + 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 = 366 + Width = 393 + Align = alBottom + Shape = bsBottomLine + end + end + object PgCurrency: TTabSheet + Caption = 'Currency' + ClientHeight = 392 + ClientWidth = 393 + 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 = 178 + 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 + Alignment = taRightJustify + 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 = 178 + 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 = 178 + ItemHeight = 15 + Style = csDropDownList + TabOrder = 3 + end + object Label2: TLabel + Left = 4 + Height = 15 + Top = 373 + Width = 385 + 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 = 366 + Width = 393 + Align = alBottom + Shape = bsBottomLine + end + end + object PgDateTime: TTabSheet + Caption = 'Date/time' + ClientHeight = 392 + ClientWidth = 393 + object LblNumFormat1: TLabel + Left = 16 + Height = 15 + Top = 20 + Width = 128 + Caption = 'Long date format string:' + ParentColor = False + end + object CbLongDateFormat: TComboBox + Left = 200 + Height = 23 + Top = 16 + Width = 178 + 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 = 15 + Top = 52 + Width = 129 + Caption = 'Short date format string:' + ParentColor = False + end + object CbShortDateFormat: TComboBox + Left = 200 + Height = 23 + Top = 48 + Width = 178 + 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 = 15 + Top = 83 + Width = 79 + Caption = 'Date separator:' + ParentColor = False + 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 LblNumFormat3: TLabel + Left = 16 + Height = 15 + Top = 252 + Width = 129 + Caption = 'Long time format string:' + ParentColor = False + end + object LblNumFormat4: TLabel + Left = 16 + Height = 15 + Top = 284 + Width = 130 + Caption = 'Short time format string:' + ParentColor = False + end + object LblTimeSeparator: TLabel + Left = 16 + Height = 15 + Top = 315 + Width = 82 + Caption = 'Time separator:' + ParentColor = False + end + object CbLongTimeFormat: TComboBox + Left = 200 + Height = 23 + Top = 248 + Width = 178 + 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 = 178 + 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 = 30 + Top = 358 + Width = 385 + 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 = 351 + Width = 393 + Align = alBottom + Shape = bsBottomLine + end + end + end + object ButtonPanel: TButtonPanel + Left = 6 + Height = 34 + Top = 436 + Width = 405 + 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 = 234 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Caption = 'sample' + Layout = tlCenter + ParentColor = False + WordWrap = True + end + end +end diff --git a/components/fpspreadsheet/examples/spready/sformatsettingsform.pas b/components/fpspreadsheet/examples/spready/sformatsettingsform.pas new file mode 100644 index 000000000..b8265289c --- /dev/null +++ b/components/fpspreadsheet/examples/spready/sformatsettingsform.pas @@ -0,0 +1,443 @@ +unit sFormatsettingsForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Grids, ButtonPanel, ComCtrls, StdCtrls, Spin, ExtCtrls, sCtrls; + +type + { TFormatSettingsForm } + + TFormatSettingsForm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + Bevel3: TBevel; + 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 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 + +uses + fpsUtils; + +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; + arr: Array[1..12] of String; + i: Integer; + s: String; +begin + fs := GetFormatSettings; + dt := FSampleDateTime; + ctrl := ActiveControl; + + if (ctrl = CbLongDateFormat) then + begin + FDateFormatSample := fs.LongDateFormat; + s := AnsiToUTF8(FormatDateTime(FDateFormatSample, dt, fs)); + LblDateTimeSample.Caption := 'Sample date:'#13 + s; + end + else + if (ctrl = CbShortDateFormat) then + begin + FDateFormatSample := fs.ShortDateFormat; + s := AnsiToUTF8(FormatDateTime(FDateFormatSample, dt, fs)); + LblDateTimeSample.Caption := 'Sample date:'#13 + s; + end + else + if (ctrl = FCbDateSeparator) then begin + s := AnsiToUTF8(FormatDateTime(FDateFormatSample, dt, fs)); + LblDateTimeSample.Caption := 'Sample date:'#13 + s; + end + else + if (ctrl = CbLongTimeFormat) then + begin + FTimeFormatSample := fs.LongTimeFormat; + s := AnsiToUTF8(FormatDateTime(FTimeFormatSample, dt, fs)); + LblDateTimeSample.Caption := 'Sample time:'#13 + s; + end + else + if (ctrl = CbShortTimeFormat) then + begin + FTimeFormatSample := fs.ShortTimeFormat; + s := AnsiToUTF8(FormatDateTime(FTimeFormatSample, dt, fs)); + LblDateTimeSample.Caption := 'Sample time:'#13 + s; + end + else + if (ctrl = FCbTimeSeparator) then + begin + s := AnsiToUTF8(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.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; +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; + + FCbDecimalSeparator := TFormatSeparatorCombo.Create(self); + with FCbDecimalSeparator do + begin + Parent := PgNumber; + Left := CbLongDateFormat.Left; + Width := CbLongDateFormat.Width; + 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 := FCbDecimalSeparator.Width; + 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 := CbShortDateFormat.Width; + 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; + Width := CbShortDateFormat.Width; + 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 := CbShortdateFormat.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 := CbShortDateFormat.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 := CbShortDateFormat.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 := CbShortTimeFormat.Width; + 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; +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 := UTF8ToAnsi(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 := AnsiToUTF8(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/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi index 8e8e4e982..e16146a05 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpi +++ b/components/fpspreadsheet/examples/spready/spready.lpi @@ -28,11 +28,6 @@ - - - - - @@ -97,7 +92,7 @@ - + @@ -110,6 +105,27 @@ + + + + + + + + + + + + + + + + + + + + + @@ -123,11 +139,6 @@ - - - - - diff --git a/components/fpspreadsheet/examples/spready/spready.lpr b/components/fpspreadsheet/examples/spready/spready.lpr index 47f53bac9..dc9365b38 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpr +++ b/components/fpspreadsheet/examples/spready/spready.lpr @@ -4,7 +4,8 @@ program spready; uses Interfaces, // this includes the LCL widgetset - Forms, mainform, laz_fpspreadsheet_visual; + Forms, mainform, laz_fpspreadsheet_visual, +sCSVParamsForm, sCtrls, sFormatSettingsForm; {$R *.res} @@ -12,6 +13,7 @@ begin Application.Initialize; Application.CreateForm(TMainFrm, MainFrm); MainFrm.BeforeRun; + Application.CreateForm(TFormatSettingsForm, FormatSettingsForm); Application.Run; end. diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index cc2fc6d0f..4a1f57bac 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -14,7 +14,8 @@ type FWorksheetName: String; function IsBool(AText: String; out AValue: Boolean): Boolean; function IsDateTime(AText: String; out ADateTime: TDateTime): Boolean; - function IsNumber(AText: String; out ANumber: Double): Boolean; + function IsNumber(AText: String; out ANumber: Double; + out ACurrencySymbol, AWarning: String): Boolean; function IsQuotedText(var AText: String): Boolean; procedure ReadCellValue(ARow, ACol: Cardinal; AText: String); protected @@ -60,9 +61,9 @@ type LineEnding: TsCSVLineEnding; // W: Specification for line ending to be written Delimiter: Char; // RW: Column delimiter QuoteChar: Char; // RW: Character for quoting texts + DetectContentType: Boolean; // R: try to convert strings to content types NumberFormat: String; // W: if empty write numbers like in sheet, otherwise use this format - DateTimeAsText: Boolean; // R: if false tries to convert text to date/time values - BoolAsText: Boolean; // R: if false tries to convert text to boolean values + AutoDetectNumberFormat: Boolean; // R: automatically detects decimal/thousand separator used in numbers TrueText: String; // RW: String for boolean TRUE FalseText: String; // RW: String for boolean FALSE FormatSettings: TFormatSettings; // RW: add'l parameters for conversion @@ -74,9 +75,9 @@ var LineEnding: leSystem; Delimiter: ';'; QuoteChar: '"'; + DetectContentType: true; NumberFormat: ''; - DateTimeAsText: false; - BoolAsText: false; + AutoDetectNumberFormat: true; TrueText: 'TRUE'; FalseText: 'FALSE'; ); @@ -205,9 +206,40 @@ begin Result := TryStrToDateTime(AText, ADateTime, CSVParams.FormatSettings); end; -function TsCSVReader.IsNumber(AText: String; out ANumber: Double): Boolean; +function TsCSVReader.IsNumber(AText: String; out ANumber: Double; + out ACurrencySymbol, AWarning: String): Boolean; +var + p: Integer; begin - Result := TryStrToFloat(AText, ANumber, CSVParams.FormatSettings); + AWarning := ''; + + // To detect whether the text is a currency value we look for the currency + // string. If we find it, we delete it and convert the remaining string to + // a number. + ACurrencySymbol := IfThen(CSVParams.FormatSettings.CurrencyString = '', + FWorkbook.FormatSettings.CurrencyString, + CSVParams.FormatSettings.CurrencyString); + p := pos(ACurrencySymbol, AText); + if p > 0 then begin + Delete(AText, p, Length(ACurrencySymbol)); + AText := Trim(AText); + if AText = '' then begin + Result := false; + ACurrencySymbol := ''; + exit; + end; + // Negative financial values are often enclosed by parenthesis + if ((AText[1] = '(') and (AText[Length(AText)] = ')')) then + AText := '-' + Trim(Copy(AText, 2, Length(AText)-2)); + end else + ACurrencySymbol := ''; + + if CSVParams.AutoDetectNumberFormat then + Result := TryStrToFloatAuto(AText, ANumber, AWarning) + else + Result := TryStrToFloat(AText, ANumber, CSVParams.FormatSettings); + + if not Result then ACurrencySymbol := ''; end; function TsCSVReader.IsQuotedText(var AText: String): Boolean; @@ -233,34 +265,54 @@ var dblValue: Double; dtValue: TDateTime; boolValue: Boolean; + currSym: string; + warning: String; begin // Empty strings are blank cells -- nothing to do if AText = '' then exit; + // Do not try to interpret the strings. --> everything is a LABEL cell. + if not CSVParams.DetectContentType then + begin + FWorksheet.WriteUTF8Text(ARow, aCol, AText); + exit; + end; + + // Remove quotes + if (AText[1] = CSVParams.QuoteChar) and (AText[Length(AText)] = CSVParams.QuoteChar) then + Delete(AText, 2, Length(AText)-2); + + { // Quoted text is a TEXT cell if IsQuotedText(AText) then begin FWorksheet.WriteUTF8Text(ARow, ACol, AText); exit; end; + } - // Check for a NUMBER cell - if IsNumber(AText, dblValue) then + // Check for a NUMBER or CURRENCY cell + if IsNumber(AText, dblValue, currSym, warning) then begin - FWorksheet.WriteNumber(ARow, ACol, dblValue); + if currSym <> '' then + FWorksheet.WriteCurrency(ARow, ACol, dblValue, nfCurrency, 2, currSym) + else + FWorksheet.WriteNumber(ARow, ACol, dblValue); + if warning <> '' then + FWorkbook.AddErrorMsg('Cell %s: %s', [GetCellString(ARow, ACol), warning]); exit; end; // Check for a DATE/TIME cell - if not CSVParams.DateTimeAsText and IsDateTime(AText, dtValue) then + if IsDateTime(AText, dtValue) then begin FWorksheet.WriteDateTime(ARow, ACol, dtValue); exit; end; // Check for a BOOLEAN cell - if not CSVParams.BoolAsText and IsBool(AText, boolValue) then + if IsBool(AText, boolValue) then begin FWorksheet.WriteBoolValue(ARow, aCol, boolValue); exit; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 9c1d95dd0..92be0beda 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -315,7 +315,7 @@ type TsWorksheetGrid is a grid which displays spreadsheet data along with formatting. As it is linked to an instance of TsWorkbook, it provides methods for reading data from or writing to spreadsheet files. It has the - same funtionality as TsCustomWorksheetGrid, but publishes has all properties. + same funtionality as TsCustomWorksheetGrid, but has published all properties. } TsWorksheetGrid = class(TsCustomWorksheetGrid) published @@ -2242,6 +2242,25 @@ var fnt: TsFont; begin Result := nil; + if (FWorkbook <> nil) then + begin + fnt := FWorkbook.GetDefaultFont; + if FWorksheet <> nil then + begin + cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); + if (cell <> nil) then + begin + if (uffBold in cell^.UsedFormattingFields) then + fnt := FWorkbook.GetFont(1) + else + if (uffFont in cell^.UsedFormattingFields) then + fnt := FWorkbook.GetFont(cell^.FontIndex); + end; + end; + Convert_sFont_to_Font(fnt, FCellFont); + Result := FCellFont; + end; + { if (FWorkbook <> nil) and (FWorksheet <> nil) then begin cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); @@ -2254,11 +2273,17 @@ begin fnt := FWorkbook.GetFont(cell^.FontIndex) else fnt := FWorkbook.GetDefaultFont; -// fnt := FWorkbook.GetFont(cell^.FontIndex); Convert_sFont_to_Font(fnt, FCellFont); Result := FCellFont; end; end; + if Result = nil then + begin + fnt := FWorkbook.GetDefaultFont; + Convert_sFont_to_Font(fnt, FCellFont); + Result := FCellFont; + end; + } end; {@@ ---------------------------------------------------------------------------- @@ -2276,7 +2301,7 @@ var cell: PCell; begin Result := GetCellFont(ARect.Left, ARect.Top); - sDefFont := FWorkbook.GetFont(0); // Default font + sDefFont := FWorkbook.GetDefaultFont; // Default font for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 37c124481..75cf9c818 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -48,7 +48,7 @@ resourcestring rsUTF8TextExpectedButANSIFoundInCell = 'Expected UTF8 text but probably ANSI '+ 'text found in cell %s.'; rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).'; - + rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".'; rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings? diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 32e9a3d93..a18469786 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -93,6 +93,8 @@ function IsDateTimeFormat(AFormatStr: String): Boolean; overload; function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsTimeFormat(AFormatStr: String): Boolean; overload; +procedure BuildCurrencyFormatList(AList: TStrings; + APositive: Boolean; AValue: Double; const ACurrencySymbol: String); function BuildCurrencyFormatString(ADialect: TsNumFormatDialect; ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String; @@ -106,13 +108,19 @@ function AddAMPM(const ATimeFormatString: String; function StripAMPM(const ATimeFormatString: String): String; function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte; function AddIntervalBrackets(AFormatString: String): String; +function DayNamesToString(const ADayNames: TWeekNameArray; + const AEmptyStr: String): String; function MakeLongDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String; +function MonthNamesToString(const AMonthNames: TMonthNameArray; + const AEmptyStr: String): String; function SpecialDateTimeFormat(ACode: String; const AFormatSettings: TFormatSettings; ForWriting: Boolean): String; procedure SplitFormatString(const AFormatString: String; out APositivePart, ANegativePart, AZeroPart: String); + + procedure MakeTimeIntervalMask(Src: String; var Dest: String); // These two functions are copies of fpc trunk until they are available in stable fpc. @@ -121,6 +129,9 @@ function FormatDateTime(const FormatStr: string; DateTime: TDateTime; function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string; +function TryStrToFloatAuto(AText: String; out ANumber: Double; + out AWarning: String): Boolean; + function TwipsToPts(AValue: Integer): Single; function PtsToTwips(AValue: Single): Integer; function cmToPts(AValue: Double): Double; @@ -162,11 +173,38 @@ var implementation uses - Math, lazutf8; + Math, lazutf8, fpsStrings; type TRGBA = record r, g, b, a: byte end; +const + POS_CURR_FMT: array[0..3] of string = ( + // Format parameter 0 is "value", parameter 1 is "currency symbol" + ('%1:s%0:s'), // 0: $1 + ('%0:s%1:s'), // 1: 1$ + ('%1:s %0:s'), // 2: $ 1 + ('%0:s %1:s') // 3: 1 $ + ); + NEG_CURR_FMT: array[0..15] of string = ( + ('(%1:s%0:s)'), // 0: ($1) + ('-%1:s%0:s'), // 1: -$1 + ('%1:s-%0:s'), // 2: $-1 + ('%1:s%0:s-'), // 3: $1- + ('(%0:s%1:s)'), // 4: (1$) + ('-%0:s%1:s'), // 5: -1$ + ('%0:s-%1:s'), // 6: 1-$ + ('%0:s%1:s-'), // 7: 1$- + ('-%0:s %1:s'), // 8: -1 $ + ('-%1:s %0:s'), // 9: -$ 1 + ('%0:s %1:s-'), // 10: 1 $- + ('%1:s %0:s-'), // 11: $ 1- + ('%1:s -%0:s'), // 12: $ -1 + ('%0:s- %1:s'), // 13: 1- $ + ('(%1:s %0:s)'), // 14: ($ 1) + ('(%0:s %1:s)') // 15: (1 $) + ); + {******************************************************************************} { Endianess helper functions } {******************************************************************************} @@ -864,6 +902,49 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Builds a string list with samples of the predefined currency formats + + @param AList String list in which the format samples are stored + @param APositive If true, samples are built for positive currency + values, otherwise for negative values + @param AValue Currency value to be used when calculating the sample + strings + @param ACurrencySymbol Currency symbol string to be used in the samples +-------------------------------------------------------------------------------} +procedure BuildCurrencyFormatList(AList: TStrings; + APositive: Boolean; AValue: Double; const ACurrencySymbol: String); +var + valueStr: String; + i: Integer; + sel: Integer; +begin + valueStr := Format('%.0n', [AValue]); + AList.BeginUpdate; + try + if AList.Count = 0 then + begin + if APositive then + for i:=0 to High(POS_CURR_FMT) do + AList.Add(Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol])) + else + for i:=0 to High(NEG_CURR_FMT) do + AList.Add(Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol])); + end else + begin + if APositive then + for i:=0 to High(POS_CURR_FMT) do + AList[i] := Format(POS_CURR_FMT[i], [valueStr, ACurrencySymbol]) + else + for i:=0 to High(NEG_CURR_FMT) do + AList[i] := Format(NEG_CURR_FMT[i], [valueStr, ACurrencySymbol]); + end; + finally + AList.EndUpdate; + end; +end; + + {@@ ---------------------------------------------------------------------------- Builds a currency format string. The presentation of negative values (brackets, or minus signs) is taken from the provided format settings. The format string @@ -893,6 +974,7 @@ end; function BuildCurrencyFormatString(ADialect: TsNumFormatDialect; ANumberFormat: TsNumberFormat; const AFormatSettings: TFormatSettings; ADecimals, APosCurrFormat, ANegCurrFormat: Integer; ACurrencySymbol: String): String; +{ const POS_FMT: array[0..3] of string = ( // Format parameter 0 is "value", parameter 1 is "currency symbol" @@ -919,6 +1001,7 @@ const ('("%1:s" %0:s)'), // 14: ($ 1) ('(%0:s "%1:s")') // 15: (1 $) ); + } var decs: String; pcf, ncf: Byte; @@ -930,13 +1013,15 @@ begin if (ADecimals < 0) then ADecimals := AFormatSettings.CurrencyDecimals; if ACurrencySymbol = '?' then - ACurrencySymbol := AnsiToUTF8(AFormatSettings.CurrencyString); + ACurrencySymbol := AnsiToUTF8(AFormatSettings.CurrencyString); // is this correct? fpspreadsheet should be kept clean of string conversions! + if ACurrencySymbol <> '' then + ACurrencySymbol := '"' + ACurrencySymbol + '"'; decs := DupeString('0', ADecimals); if ADecimals > 0 then decs := '.' + decs; negRed := (ANumberFormat = nfCurrencyRed); - p := POS_FMT[pcf]; // Format mask for positive values - n := NEG_FMT[ncf]; // Format mask for negative values + p := POS_CURR_FMT[pcf]; // Format mask for positive values + n := NEG_CURR_FMT[ncf]; // Format mask for negative values // add extra space for the sign of the number for perfect alignment in Excel if ADialect = nfdExcel then case ncf of @@ -1110,6 +1195,39 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + 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; + {@@ ---------------------------------------------------------------------------- Creates a long date format string out of a short date format string. Retains the order of year-month-day and the separators, but uses 4 digits @@ -1181,6 +1299,39 @@ begin 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; + {@@ ---------------------------------------------------------------------------- Creates the formatstrings for the date/time codes "dm", "my", "ms" and "msz" out of the formatsettings. @@ -1325,6 +1476,115 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Converts a string to a floating point number. No assumption on decimal and + thousand separator are made. + Is needed for reading CSV files. +-------------------------------------------------------------------------------} +function TryStrToFloatAuto(AText: String; out ANumber: Double; + out AWarning: String): Boolean; +var + i, j: Integer; + testSep: Char; + testSepPos: Integer; + decsep: Char; + isPercent: Boolean; + fs: TFormatSettings; + done: Boolean; +begin + Result := false; + AWarning := ''; + if AText = '' then + exit; + + fs := DefaultFormatSettings; + + // We scan the string starting from its end. If we find a point or a comma, + // we have a candidate for the decimal or thousand separator. If we find + // the same character again it was a thousand separator, if not it was + // a decimal separator. + + // There is one amgiguity: Using a thousand separator for number < 1.000.000, + // but no decimal separator misinterprets the thousand separator as a + // decimal separator. + + done := false; // Indicates that both decimal and thousand separators are found + testSep := #0; // Separator candidate to be tested + testSepPos := 0; // Position of this separator chandidate in the string + i := Length(AText); // Start at end... + while i >= 1 do // ...and search towards start + begin + if AText[i] in ['.', ','] then + begin + if testSep = #0 then begin + testSep := AText[i]; + testSepPos := i; + end; + // This is the right-most separator candidate in the text + // It can be a decimal or a thousand separator. + dec(i); + while i >= 1 do + begin + // If we find the testSep character again it must be a thousand separator. + if AText[i] = testSep then + begin + fs.ThousandSeparator := testSep; + // The decimal separator is the "other" character. + if testSep = '.' then + fs.DecimalSeparator := ',' + else + fs.DecimalSeparator := '.'; + done := true; + i := 0; + end + else + // If we find the "other" separator character, then testSep was a + // decimal separator and the current character is a thousand separator. + if AText[i] in ['.',','] then + begin + fs.DecimalSeparator := testSep; + fs.ThousandSeparator := AText[i]; + done := true; + i := 0; + end; + dec(i); + end; + end; + dec(i); + end; + + // Only one separator candicate found, we assume it is a decimal separator + if (testSep <> #0) and not done then + begin + // Warning in case of ambiguous detection of separator. If only one separator + // type is found and it is at the third position from the string's end it + // might by a thousand separator or a decimal separator. We assume the + // latter case, but create a warning. + if Length(AText) - testSepPos = 3 then + AWarning := Format(rsAmbiguousDecThouSeparator, [AText]); + fs.DecimalSeparator := testSep; + // Make sure that the thousand separator is different from the decimal sep. + if testSep = '.' then fs.ThousandSeparator := ',' else fs.ThousandSeparator := '.'; + end; + + // Delete all thousand separators from the string - StrToFloat does not like them... + AText := StringReplace(AText, fs.ThousandSeparator, '', [rfReplaceAll]); + + // Is the last character a percent sign? + isPercent := AText[Length(AText)] = '%'; + if isPercent then + while (Length(AText) > 0) and (AText[Length(AText)] in ['%', ' ']) do + Delete(AText, Length(AText), 1); + + // Try string-to-number conversion + Result := TryStrToFloat(AText, ANumber, fs); + + // If successful take care of the percentage sign + if Result and isPercent then + ANumber := ANumber * 0.01; +end; + + {@@ ---------------------------------------------------------------------------- Excel's unit of row heights is "twips", i.e. 1/20 point. Converts Twips to points.