diff --git a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi index 3f9299395..0943006f2 100644 --- a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi +++ b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi @@ -27,7 +27,6 @@ - diff --git a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpr b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpr index 6d41aef9a..43f1dc6e9 100644 --- a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpr +++ b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpr @@ -1,4 +1,4 @@ -program fpsvisual; +program fpsgrid; {$mode objfpc}{$H+} diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index d90891caa..b71a5fe36 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -4,16 +4,17 @@ object MainFrm: TMainFrm Top = 258 Width = 884 Caption = 'spready' - ClientHeight = 614 + ClientHeight = 619 ClientWidth = 884 Menu = MainMenu + OnActivate = FormActivate OnCreate = FormCreate ShowHint = True LCLVersion = '1.3' object Panel1: TPanel Left = 0 Height = 78 - Top = 536 + Top = 541 Width = 884 Align = alBottom BevelOuter = bvNone @@ -22,9 +23,9 @@ object MainFrm: TMainFrm TabOrder = 6 object CbShowHeaders: TCheckBox Left = 8 - Height = 24 + Height = 19 Top = 8 - Width = 116 + Width = 93 Caption = 'Show headers' Checked = True OnClick = CbShowHeadersClick @@ -33,9 +34,9 @@ object MainFrm: TMainFrm end object CbShowGridLines: TCheckBox Left = 8 - Height = 24 + Height = 19 Top = 39 - Width = 125 + Width = 100 Caption = 'Show grid lines' Checked = True OnClick = CbShowGridLinesClick @@ -44,7 +45,7 @@ object MainFrm: TMainFrm end object EdFrozenCols: TSpinEdit Left = 645 - Height = 28 + Height = 23 Top = 8 Width = 52 OnChange = EdFrozenColsChange @@ -52,7 +53,7 @@ object MainFrm: TMainFrm end object EdFrozenRows: TSpinEdit Left = 645 - Height = 28 + Height = 23 Top = 39 Width = 52 OnChange = EdFrozenRowsChange @@ -60,37 +61,37 @@ object MainFrm: TMainFrm end object Label1: TLabel Left = 560 - Height = 20 + Height = 15 Top = 13 - Width = 77 + Width = 62 Caption = 'Frozen cols:' FocusControl = EdFrozenCols ParentColor = False end object Label2: TLabel Left = 560 - Height = 20 + Height = 15 Top = 40 - Width = 82 + Width = 66 Caption = 'Frozen rows:' FocusControl = EdFrozenRows ParentColor = False end object CbReadFormulas: TCheckBox Left = 160 - Height = 24 + Height = 19 Top = 8 - Width = 120 + Width = 96 Caption = 'Read formulas' OnChange = CbReadFormulasChange TabOrder = 2 end object CbHeaderStyle: TComboBox Left = 408 - Height = 28 + Height = 23 Top = 8 Width = 116 - ItemHeight = 20 + ItemHeight = 15 ItemIndex = 2 Items.Strings = ( 'Lazarus' @@ -104,9 +105,9 @@ object MainFrm: TMainFrm end object CbAutoCalcFormulas: TCheckBox Left = 160 - Height = 24 + Height = 19 Top = 39 - Width = 158 + Width = 128 Caption = 'Calculate on change' OnChange = CbAutoCalcFormulasChange TabOrder = 3 @@ -199,19 +200,19 @@ object MainFrm: TMainFrm end object FontComboBox: TComboBox Left = 52 - Height = 28 + Height = 23 Top = 2 Width = 127 - ItemHeight = 20 + ItemHeight = 15 OnSelect = FontComboBoxSelect TabOrder = 0 end object FontSizeComboBox: TComboBox Left = 179 - Height = 28 + Height = 23 Top = 2 Width = 48 - ItemHeight = 20 + ItemHeight = 15 Items.Strings = ( '8' '9' @@ -300,6 +301,7 @@ object MainFrm: TMainFrm Height = 26 Top = 2 Width = 149 + ColorRectWidth = 8 NoneColorColor = clDefault Style = [cbPrettyNames, cbCustomColors] OnGetColors = CbBackgroundColorGetColors @@ -380,7 +382,7 @@ object MainFrm: TMainFrm end object InspectorSplitter: TSplitter Left = 648 - Height = 457 + Height = 462 Top = 79 Width = 5 Align = alRight @@ -388,7 +390,7 @@ object MainFrm: TMainFrm end object InspectorPageControl: TPageControl Left = 653 - Height = 457 + Height = 462 Top = 79 Width = 231 ActivePage = PgCellValue @@ -398,11 +400,11 @@ object MainFrm: TMainFrm OnChange = InspectorPageControlChange object PgCellValue: TTabSheet Caption = 'Cell value' - ClientHeight = 424 + ClientHeight = 434 ClientWidth = 223 object CellInspector: TValueListEditor Left = 0 - Height = 424 + Height = 434 Top = 0 Width = 223 Align = alClient @@ -443,7 +445,7 @@ object MainFrm: TMainFrm end object TabControl: TTabControl Left = 0 - Height = 457 + Height = 462 Top = 79 Width = 648 OnChange = TabControlChange @@ -451,7 +453,7 @@ object MainFrm: TMainFrm TabOrder = 3 object WorksheetGrid: TsWorksheetGrid Left = 2 - Height = 452 + Height = 457 Top = 3 Width = 644 FrozenCols = 0 @@ -468,7 +470,7 @@ object MainFrm: TMainFrm TitleStyle = tsNative OnSelection = WorksheetGridSelection ColWidths = ( - 56 + 42 64 64 64 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index de577d5ab..bae837297 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -7,7 +7,8 @@ interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Spin, Grids, - ColorBox, ValEdit, fpspreadsheetgrid, fpspreadsheet, fpsallformats; + ColorBox, ValEdit, + fpspreadsheetgrid, fpspreadsheet, fpsallformats; type @@ -281,6 +282,7 @@ type procedure EdFrozenRowsChange(Sender: TObject); procedure FontComboBoxSelect(Sender: TObject); procedure FontSizeComboBoxSelect(Sender: TObject); + procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure InspectorPageControlChange(Sender: TObject); procedure PageControl1Change(Sender: TObject); @@ -314,7 +316,7 @@ var implementation uses - StrUtils, TypInfo, + StrUtils, TypInfo, LCLIntf, LCLType, fpcanvas, fpsutils, fpsnumformatparser; const @@ -345,6 +347,19 @@ const // Use a combination of these bits for the "Tag" of the Border actions - see FormCreate. +{ Utilities } + +{ Determines the "real" size of font. Default font usually reports font size 0... + http://comments.gmane.org/gmane.comp.ide.lazarus.general/70758 } +function RealFontSize(AFont: TFont): Integer; +var + logFont: TLogFont; +begin + LCLIntf.GetObject(AFont.Reference.Handle, SizeOf(TLogFont), @logFont); + Result := abs(logFont.lfHeight); +end; + + { TMainFrm } procedure TMainFrm.AcEditExecute(Sender: TObject); @@ -549,6 +564,8 @@ begin try WorksheetGrid.Col := WorksheetGrid.FixedCols; WorksheetGrid.Row := WorksheetGrid.FixedRows; + SetupBackgroundColorBox; + WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row); finally WorksheetGrid.EndUpdate; end; @@ -724,11 +741,9 @@ begin end; procedure TMainFrm.CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings); -type - TRGB = packed record R,G,B: byte end; var clr: TColor; - rgb: TRGB absolute clr; + clrName: String; i: Integer; begin if WorksheetGrid.Workbook <> nil then begin @@ -736,8 +751,8 @@ begin Items.AddObject('no fill', TObject(PtrInt(clNone))); for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin clr := WorksheetGrid.Workbook.GetPaletteColor(i); - Items.AddObject(Format('Color %d: %.2x%.2x%.2x', [i, rgb.R, rgb.G, rgb.B]), - TObject(PtrInt(clr))); + clrName := WorksheetGrid.Workbook.GetColorName(i); + Items.AddObject(Format('%d: %s', [i, clrName]), TObject(PtrInt(clr))); end; end; end; @@ -794,6 +809,11 @@ begin with WorksheetGrid do CellFontSizes[Selection] := sz; end; +procedure TMainFrm.FormActivate(Sender: TObject); +begin + WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row); +end; + procedure TMainFrm.FormCreate(Sender: TObject); begin // Adjust format toolbar height, looks strange at 120 dpi @@ -801,6 +821,7 @@ begin FormatToolbar.ButtonHeight := FormatToolbar.Height - 4; CbBackgroundColor.ItemHeight := FontCombobox.ItemHeight; + //CbBackgroundColor.ColorRectWidth := RealFontSize(CbBackgroundColor.Font); // Populate font combobox FontCombobox.Items.Assign(Screen.Fonts); @@ -826,8 +847,11 @@ begin FontSizeCombobox.DropDownCount := DROPDOWN_COUNT; CbBackgroundColor.DropDownCount := DROPDOWN_COUNT; + // Initialize a new empty workbook + AcNewExecute(nil); + // Initialize Inspector - UpdateCellInfo(nil); + //UpdateCellInfo(nil); ActiveControl := WorksheetGrid; end; @@ -916,6 +940,7 @@ begin // event of the ColorBox. CbBackgroundColor.Style := CbBackgroundColor.Style - [cbCustomColors]; CbBackgroundColor.Style := CbBackgroundColor.Style + [cbCustomColors]; + Application.ProcessMessages; end; procedure TMainFrm.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer); @@ -982,7 +1007,7 @@ var begin with WorksheetGrid do sClr := BackgroundColors[Selection]; if sClr = scNotDefined then - CbBackgroundColor.ItemIndex := 0 //-1 + CbBackgroundColor.ItemIndex := 0 // no fill else CbBackgroundColor.ItemIndex := sClr + 1; end; diff --git a/components/fpspreadsheet/examples/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi index 9436ce717..e4ffbe312 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpi +++ b/components/fpspreadsheet/examples/spready/spready.lpi @@ -25,7 +25,6 @@ - @@ -87,7 +86,6 @@ - diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index c76ca1f71..4e35e7352 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -833,9 +833,6 @@ const AllBuiltIns = [bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime, bcLookup, bcInfo, bcUser]; -var - ExprFormatSettings: TFormatSettings; // MUST BE REMOVED - implementation @@ -1227,6 +1224,7 @@ end; decimal and list separator from the formatsettings provided. } function TsExpressionParser.BuildStringFormula(AFormatSettings: TFormatSettings): String; begin + ExprFormatSettings := AFormatSettings; if FExprNode = nil then Result := '' else @@ -1773,6 +1771,7 @@ end; function TsExpressionParser.GetLocalizedExpression(const AFormatSettings: TFormatSettings): String; begin + ExprFormatSettings := AFormatSettings; Result := BuildStringFormula(AFormatSettings); end; @@ -1792,6 +1791,7 @@ begin if FExpression = AValue then exit; FFormatSettings := AFormatSettings; + ExprFormatSettings := AFormatSettings; FExpression := AValue; if (AValue <> '') and (AValue[1] = '=') then FScanner.Source := Copy(AValue, 2, Length(AValue)) diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index e477bd590..8e85a1ee6 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -11,8 +11,12 @@ interface uses Classes, SysUtils, fpspreadsheet, fpsExprParser; +var + ExprFormatSettings: TFormatSettings; + procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager); + implementation uses diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 41c8ae5f2..775502547 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -930,7 +930,8 @@ type function FindClosestColor(AColorValue: TsColorValue; AMaxPaletteCount: Integer): TsColor; function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String; - function GetColorName(AColorIndex: TsColor): string; + function GetColorName(AColorIndex: TsColor): string; overload; + procedure GetColorName(AColorValue: TsColorValue; out AName: String); overload; function GetPaletteColor(AColorIndex: TsColor): TsColorValue; function GetPaletteColorAsHTMLStr(AColorIndex: TsColor): String; procedure SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue); @@ -5355,6 +5356,7 @@ begin FormatSettings := DefaultFormatSettings; FormatSettings.ShortDateFormat := MakeShortDateFormat(FormatSettings.ShortDateFormat); FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat); + UseDefaultPalette; FFontList := TFPList.Create; SetDefaultFont('Arial', 10.0); InitFonts; @@ -6220,23 +6222,37 @@ end; @return String identifying the color (a color name or, if unknown, a string showing the rgb components } function TsWorkbook.GetColorName(AColorIndex: TsColor): string; +begin + GetColorName(GetPaletteColor(AColorIndex), Result); +end; + +{@@ + Returns the name of an rgb color value. + If the name is not known the hex string is returned as RRGGBB. + + @param AColorValue rgb value of the color considered + @param AName String identifying the color (a color name or, if + unknown, a string showing the rgb components +} +procedure TsWorkbook.GetColorName(AColorValue: TsColorValue; out AName: String); +type + TRgba = packed record R,G,B,A: Byte; end; var i: Integer; - c: TsColorValue; + c: TsColorvalue; begin - // Get color rgb value - c := GetPaletteColor(AColorIndex); - // Find color value in default palette for i:=0 to High(DEFAULT_PALETTE) do - if DEFAULT_PALETTE[i] = c then begin - // if found: get the color name from the default color names array - Result := DEFAULT_COLORNAMES[i]; + // if found: get the color name from the default color names array + if DEFAULT_PALETTE[i] = AColorValue then + begin + AName := DEFAULT_COLORNAMES[i]; exit; end; // if not found: construct a string from rgb byte values. - Result := FPSColorToHexString(AColorIndex, colBlack); + with TRgba(AColorValue) do + AName := Format('%.2x%.2x%.2x', [R, G, B]); end; {@@ diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 11ef687a5..4e3251ee2 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -3152,9 +3152,9 @@ begin ColWidths[0] := Canvas.TextWidth(' 999999 '); RowHeights[0] := DefaultRowHeight; end; - UpdateColWidths; - UpdateRowHeights; end; + UpdateColWidths; + UpdateRowHeights; Invalidate; end; @@ -3206,14 +3206,18 @@ procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0); var i: Integer; lCol: PCol; + w: Integer; begin if AStartIndex = 0 then AStartIndex := FHeaderCount; for i := AStartIndex to ColCount-1 do begin - lCol := FWorksheet.FindCol(i - FHeaderCount); - if lCol <> nil then - ColWidths[i] := CalcColWidth(lCol^.Width) - else - ColWidths[i] := DefaultColWidth; + w := DefaultColWidth; + if FWorksheet <> nil then + begin + lCol := FWorksheet.FindCol(i - FHeaderCount); + if lCol <> nil then + w := CalcColWidth(lCol^.Width) + end; + ColWidths[i] := w; end; end; @@ -3221,14 +3225,18 @@ procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0); var i: Integer; lRow: PRow; + h: Integer; begin if AStartIndex <= 0 then AStartIndex := FHeaderCount; for i := AStartIndex to RowCount-1 do begin - lRow := FWorksheet.FindRow(i - FHeaderCount); - if (lRow = nil) then - RowHeights[i] := CalcAutoRowHeight(i) - else - RowHeights[i] := CalcRowHeight(lRow^.Height); + h := CalcAutoRowHeight(i); + if FWorksheet <> nil then + begin + lRow := FWorksheet.FindRow(i - FHeaderCount); + if (lRow <> nil) then + RowHeights[i] := CalcRowHeight(lRow^.Height); + end; + RowHeights[i] := h; end; end; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 397658b14..7d7b8722a 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -2167,6 +2167,7 @@ begin TRGBA(Result).a := 0; end; + {$PUSH}{$HINTS OFF} {@@ Silence warnings due to an unused parameter } procedure Unused(const A1);