fpspreadsheet: Misc improvements of TsWorksheetGrid, fpsgrid and spready

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3551 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi

@@ -27,7 +27,6 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\opendocumentdemo\test.ods"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">

components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpr

@@ -1,4 +1,4 @@
-program fpsvisual;
+program fpsgrid;
 
 {$mode objfpc}{$H+}
 

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

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]),
+      clrName := WorksheetGrid.Workbook.GetColorName(i);
-        TObject(PtrInt(clr)));
+      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;

components/fpspreadsheet/examples/spready/spready.lpi

@@ -25,7 +25,6 @@
           </Target>
           <SearchPaths>
             <IncludeFiles Value="$(ProjOutDir)"/>
-            <OtherUnitFiles Value="../.."/>
             <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
           </SearchPaths>
           <Parsing>
@@ -87,7 +86,6 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="&quot;C:\Users\Pamler\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\examples\opendocdemo\test.ods&quot;"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">

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))

components/fpspreadsheet/fpsfunc.pas

@@ -11,8 +11,12 @@ interface
 uses
   Classes, SysUtils, fpspreadsheet, fpsExprParser;
 
+var
+  ExprFormatSettings: TFormatSettings;
+
 procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager);
 
+
 implementation
 
 uses

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
-      // if found: get the color name from the default color names array
+    if DEFAULT_PALETTE[i] = AColorValue then
-      Result := DEFAULT_COLORNAMES[i];
+    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;
 
 {@@

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);
+    w := DefaultColWidth;
-    if lCol <> nil then
+    if FWorksheet <> nil then
-      ColWidths[i] := CalcColWidth(lCol^.Width)
+    begin
-    else
+      lCol := FWorksheet.FindCol(i - FHeaderCount);
-      ColWidths[i] := DefaultColWidth;
+      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);
+    h := CalcAutoRowHeight(i);
-    if (lRow = nil) then
+    if FWorksheet <> nil then
-      RowHeights[i] := CalcAutoRowHeight(i)
+    begin
-    else
+      lRow := FWorksheet.FindRow(i - FHeaderCount);
-      RowHeights[i] := CalcRowHeight(lRow^.Height);
+      if (lRow <> nil) then
+        RowHeights[i] := CalcRowHeight(lRow^.Height);
+    end;
+    RowHeights[i] := h;
   end;
 end;
 

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);