fpspreadsheet: Some improvements of TsCellCombobox.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3798 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2014-11-27 15:20:29 +00:00
parent 154442eeab
commit c75c611846
3 changed files with 143 additions and 129 deletions
--- a/components/fpspreadsheet/examples/fpsctrls/main.lfm
+++ b/components/fpspreadsheet/examples/fpsctrls/main.lfm
@@ -4,15 +4,15 @@ object Form1: TForm1
  Top = 214
  Width = 876
  Caption = 'Form1'
-  ClientHeight = 580
+  ClientHeight = 575
  ClientWidth = 876
  Menu = MainMenu
  ShowHint = True
  LCLVersion = '1.3'
  object WorkbookTabControl: TsWorkbookTabControl
    Left = 0
-    Height = 497
-    Top = 83
+    Height = 486
+    Top = 89
    Width = 623
    TabIndex = 0
    Tabs.Strings = (
@@ -23,8 +23,8 @@ object Form1: TForm1
    WorkbookSource = WorkbookSource
    object WorksheetGrid: TsWorksheetGrid
      Left = 2
-      Height = 472
-      Top = 23
+      Height = 456
+      Top = 28
      Width = 619
      FrozenCols = 0
      FrozenRows = 0
@@ -78,8 +78,8 @@ object Form1: TForm1
  end
  object InspectorTabControl: TTabControl
    Left = 628
-    Height = 497
-    Top = 83
+    Height = 486
+    Top = 89
    Width = 248
    OnChange = InspectorTabControlChange
    TabIndex = 0
@@ -94,8 +94,8 @@ object Form1: TForm1
    Visible = False
    object Inspector: TsSpreadsheetInspector
      Left = 2
-      Height = 472
-      Top = 23
+      Height = 456
+      Top = 28
      Width = 244
      Align = alClient
      RowCount = 25
@@ -108,7 +108,7 @@ object Form1: TForm1
        'Options=boAutoCalc, boCalcBeforeSaving, boReadFormulas'
        'FormatSettings='
        '  ThousandSeparator=.'
-        '  DecimalSeparator=.'
+        '  DecimalSeparator=,'
        '  ListSeparator=;'
        '  DateSeparator=.'
        '  TimeSeparator=:'
@@ -134,23 +134,23 @@ object Form1: TForm1
      WorkbookSource = WorkbookSource
      Mode = imWorkbook
      ColWidths = (
-        111
-        112
+        109
+        110
      )
    end
  end
  object Splitter1: TSplitter
    Left = 623
-    Height = 497
-    Top = 83
+    Height = 486
+    Top = 89
    Width = 5
    Align = alRight
    ResizeAnchor = akRight
  end
  object ToolBar1: TToolBar
    Left = 0
-    Height = 26
-    Top = 24
+    Height = 28
+    Top = 28
    Width = 876
    AutoSize = True
    ButtonHeight = 26
@@ -329,24 +329,24 @@ object Form1: TForm1
    end
    object FontnameCombo: TsFontNameCombobox
      Left = 54
-      Height = 23
+      Height = 28
      Top = 0
      Width = 151
      CellFormatItem = cfiFontName
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
-      ItemIndex = 62
+      ItemHeight = 20
+      ItemIndex = 41
      TabOrder = 0
      Text = 'Arial'
    end
    object sFontSizeCombobox1: TsFontSizeCombobox
      Left = 205
-      Height = 23
+      Height = 28
      Top = 0
      Width = 60
      CellFormatItem = cfiFontName
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
+      ItemHeight = 20
      ItemIndex = 2
      TabOrder = 1
      Text = '10'
@@ -385,7 +385,7 @@ object Form1: TForm1
  end
  object ToolBar2: TToolBar
    Left = 0
-    Height = 24
+    Height = 28
    Top = 0
    Width = 876
    AutoSize = True
@@ -479,49 +479,51 @@ object Form1: TForm1
    end
    object FontColorCombobox: TsCellCombobox
      Left = 261
-      Height = 21
+      Height = 28
      Top = 0
-      Width = 82
+      Width = 48
      CellFormatItem = cfiFontColor
+      ColorRectWidth = -1
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
+      ItemHeight = 20
      TabOrder = 0
    end
    object BackgroundColorCombobox: TsCellCombobox
-      Left = 343
-      Height = 21
+      Left = 309
+      Height = 28
      Top = 0
-      Width = 92
+      Width = 48
      CellFormatItem = cfiBackgroundColor
+      ColorRectWidth = -1
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
+      ItemHeight = 20
      TabOrder = 1
    end
    object sCellCombobox3: TsCellCombobox
-      Left = 435
-      Height = 23
+      Left = 357
+      Height = 28
      Top = 0
      Width = 124
      CellFormatItem = cfiFontName
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
+      ItemHeight = 20
      TabOrder = 2
    end
    object sCellCombobox4: TsCellCombobox
-      Left = 559
-      Height = 23
+      Left = 481
+      Height = 28
      Top = 0
      Width = 50
      CellFormatItem = cfiFontSize
      WorkbookSource = WorkbookSource
-      ItemHeight = 15
+      ItemHeight = 20
      TabOrder = 3
    end
  end
  object ToolBar3: TToolBar
    Left = 0
    Height = 28
-    Top = 50
+    Top = 56
    Width = 876
    AutoSize = True
    Caption = 'ToolBar3'
@@ -540,7 +542,7 @@ object Form1: TForm1
      TabOrder = 0
      object CellIndicator: TsCellIndicator
        Left = 0
-        Height = 23
+        Height = 28
        Top = 0
        Width = 138
        Align = alTop
@@ -571,7 +573,7 @@ object Form1: TForm1
    Cursor = crVSplit
    Left = 0
    Height = 5
-    Top = 78
+    Top = 84
    Width = 876
    Align = alTop
    ResizeAnchor = akTop
@@ -580,14 +582,14 @@ object Form1: TForm1
    AutoDetectFormat = False
    Options = [boAutoCalc, boCalcBeforeSaving, boReadFormulas]
    left = 176
-    top = 128
+    top = 160
  end
  object OpenDialog: TOpenDialog
    DefaultExt = '.xls'
    Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv'
    Options = [ofExtensionDifferent, ofEnableSizing, ofViewDetail]
    left = 312
-    top = 128
+    top = 160
  end
  object ActionList: TActionList
    Images = ImageList
@@ -4359,7 +4361,7 @@ object Form1: TForm1
  end
  object PuNumFormat: TPopupMenu
    left = 504
-    top = 184
+    top = 216
    object MenuItem19: TMenuItem
      Action = AcNumFormatGeneral
      AutoCheck = True
@@ -4385,7 +4387,7 @@ object Form1: TForm1
  end
  object PuCurrencyFormat: TPopupMenu
    left = 504
-    top = 248
+    top = 280
    object MenuItem7: TMenuItem
      Action = AcNumFormatCurrency
      AutoCheck = True
@@ -4397,7 +4399,7 @@ object Form1: TForm1
  end
  object PuDateFormat: TPopupMenu
    left = 504
-    top = 312
+    top = 344
    object MenuItem22: TMenuItem
      Action = AcNumFormatDateTime
      AutoCheck = True
@@ -4416,7 +4418,7 @@ object Form1: TForm1
  end
  object PuTimeFormat: TPopupMenu
    left = 504
-    top = 376
+    top = 408
    object MenuItem26: TMenuItem
      Action = AcNumFormatLongTime
      AutoCheck = True
@@ -4440,7 +4442,7 @@ object Form1: TForm1
  object PuBorders: TPopupMenu
    Images = ImageList
    left = 504
-    top = 128
+    top = 160
    object MenuItem41: TMenuItem
      Action = AcCellBorderNone
      Bitmap.Data = {
--- a/components/fpspreadsheet/fpspreadsheetctrls.pas
+++ b/components/fpspreadsheet/fpspreadsheetctrls.pas
@@ -38,9 +38,9 @@ type

  {@@ Describes during communication between WorkbookSource and visual controls
    which kind of item has changed: the workbook, the worksheet, a cell value,
-    or a cell formatting }
+    or a cell formatting, etc. }
  TsNotificationItem = (lniWorkbook, lniWorksheet, lniCell, lniSelection,
-    lniAbortSelection);
+    lniAbortSelection, lniRow);
  {@@ This set accompanies the notification between WorkbookSource and visual
    controls and describes which items have changed in the spreadsheet. }
  TsNotificationItems = set of TsNotificationItem;
@@ -68,6 +68,7 @@ type

    procedure AbortSelection;
    procedure CellChangedHandler(Sender: TObject; ARow, ACol: Cardinal);
+    procedure CellFontChangedHandler(Sender: TObject; ARow, ACol: Cardinal);
    procedure CellSelectedHandler(Sender: TObject; ARow, ACol: Cardinal);
    procedure InternalCreateNewWorkbook;
    procedure InternalLoadFromFile(AFileName: string; AAutoDetect: Boolean;
@@ -518,7 +519,7 @@ procedure Register;
 implementation

 uses
-  Types, TypInfo, LCLType, Dialogs, Forms,
+  Types, Math, TypInfo, LCLType, Dialogs, Forms,
  fpsStrings, fpsUtils, fpSpreadsheetGrid;


@@ -612,6 +613,21 @@ begin
    NotifyListeners([lniCell], FWorksheet.FindCell(ARow, ACol));
 end;

+{@@ ----------------------------------------------------------------------------
+  Event handler for the OnChangeFont event of TsWorksheet which is fired
+  whenever a cell font changes. The listener, in particular the worksheetGrid,
+  must adapt the height of non-fixed rows
+-------------------------------------------------------------------------------}
+procedure TsWorkbookSource.CellFontChangedHandler(Sender: TObject;
+  ARow, ACol: Cardinal);
+begin
+  if FWorksheet <> nil then
+  begin
+    NotifyListeners([lniCell], Worksheet.FindCell(ARow, ACol));
+    NotifyListeners([lniRow], Pointer(PtrInt(ARow)));
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
  Event handler for the OnSelectCell event of TsWorksheet which is fired
  whenever another cell is selected in the worksheet. Notifies the listeners
@@ -1138,8 +1154,8 @@ begin
  if FWorksheet <> nil then
  begin
    FWorksheet.OnChangeCell := @CellChangedHandler;
+    FWorksheet.OnChangeFont := @CellFontChangedHandler;
    FWorksheet.OnSelectCell := @CellSelectedHandler;
-    FWorksheet.OnChangeFont := @CellChangedHandler;
    NotifyListeners([lniWorksheet]);
    SelectCell(FWorksheet.ActiveCellRow, FWorksheet.ActiveCellCol);
  end else
@@ -1564,7 +1580,6 @@ constructor TsCellCombobox.Create(AOwner: TComponent);
 begin
  inherited Create(AOwner);
  FColorRectWidth := 10;
-  Populate;
 end;

 {@@ ----------------------------------------------------------------------------
@@ -1604,18 +1619,16 @@ begin
    cfiFontColor:
      begin
        fnt := Worksheet.ReadCellFont(ACell);
-        clr := TsColor(PtrInt(Items.Objects[ItemIndex]));
-        sclr := Workbook.FindClosestColor(clr);
-        Worksheet.WriteFont(ACell, fnt.FontName, fnt.Size, fnt.Style, clr);
+        clr := PtrInt(Items.Objects[ItemIndex]);
+        Worksheet.WriteFont(ACell, fnt.FontName, fnt.Size, fnt.style, clr);
      end;
    cfiBackgroundColor:
-      if ItemIndex = 0 then
+      if ItemIndex <= 0 then
        Worksheet.WriteBackgroundColor(ACell, scTransparent)
      else
      begin
-        clr := TsColor(PtrInt(Items.Objects[ItemIndex]));
-        sclr := Workbook.FindClosestColor(clr);
-        Worksheet.WriteBackgroundColor(ACell, sclr);
+        clr := PtrInt(Items.Objects[ItemIndex]);
+        Worksheet.WriteBackgroundColor(ACell, clr);
      end;
    cfiBorderColor:
      ;
@@ -1633,51 +1646,72 @@ procedure TsCellCombobox.DrawItem(AIndex: Integer; ARect: TRect;
 { This code is adapted from colorbox.pas}
 var
  r: TRect;
-  brushColor, penColor, newColor: TColor;
+  clr: TsColor;
+  brushColor, penColor: TColor;
+  brushStyle: TBrushStyle;
  noFill: Boolean;
 begin
  if AIndex = -1 then
    Exit;

-  r.Top := ARect.Top + 2;
-  r.Bottom := ARect.Bottom - 2;
-  r.Left := ARect.Left + 2;
-  r.Right := r.Left + FColorRectWidth;
-  Exclude(AState, odPainted);
-
-  noFill := false;
-
-  with Canvas do
+  if FFormatItem in [cfiFontColor, cfiBackgroundColor, cfiBorderColor] then
  begin
-    FillRect(ARect);
+    r.Top := ARect.Top + 2;
+    r.Bottom := ARect.Bottom - 2;
+    r.Left := ARect.Left + 2;
+    if FColorRectWidth = -1 then
+      r.Right := ARect.Right - 2
+    else
+      r.Right := r.Left + FColorRectWidth;
+    Exclude(AState, odPainted);

-    brushColor := Brush.Color;
-    penColor := Pen.Color;
+    noFill := false;

-    newColor := TColor(Items.Objects[AIndex]);
-
-    if newColor = clNone then
-      noFill := true;
-
-    Brush.Color := newColor;
-    Pen.Color := clBlack;
-
-    r := BiDiFlipRect(r, ARect, UseRightToLeftAlignment);
-    Rectangle(r);
-
-    if noFill then
+    with Canvas do
    begin
-      Line(r.Left, r.Top, r.Right-1, r.Bottom-1);
-      Line(r.Left, r.Bottom-1, r.Right-1, r.Top);
+      FillRect(ARect);
+
+      brushStyle := Brush.Style;
+      brushColor := Brush.Color;
+      penColor := Pen.Color;
+
+      clr := TsColor(PtrInt(Items.Objects[AIndex]));
+      if (clr = scTransparent) or (clr = scNotDefined) then
+      begin
+        noFill := true;
+        Brush.Style := bsClear;
+      end else
+      begin
+        Brush.Color := Workbook.GetPaletteColor(clr);
+        Brush.Style := bsSolid;
+      end;
+      Pen.Color := clBlack;
+
+      r := BiDiFlipRect(r, ARect, UseRightToLeftAlignment);
+      Rectangle(r);
+
+      if noFill then
+      begin
+        Line(r.Left, r.Top, r.Right-1, r.Bottom-1);
+        Line(r.Left, r.Bottom-1, r.Right-1, r.Top);
+      end;
+
+      Brush.Style := brushStyle;
+      Brush.Color := brushColor;
+      Pen.Color := penColor;
    end;

-    Brush.Color := brushColor;
-    Pen.Color := penColor;
+    if FColorRectWidth > -1 then
+    begin
+      r := ARect;
+      inc(r.Left, FColorRectWidth + 4);
+      inherited DrawItem(AIndex, BidiFlipRect(r, ARect, UseRightToLeftAlignment), AState);
+    end;
+  end else
+  begin
+    r := ARect;
+    inherited DrawItem(AIndex, BidiFlipRect(r, ARect, UseRightToLeftAlignment), AState);
  end;
-  r := ARect;
-  inc(r.Left, FColorRectWidth + 4);
-
-  inherited DrawItem(AIndex, BidiFlipRect(r, ARect, UseRightToLeftAlignment), AState);
 end;

 {@@ ----------------------------------------------------------------------------
@@ -1687,8 +1721,7 @@ end;
 procedure TsCellCombobox.ExtractFromCell(ACell: PCell);
 var
  fnt: TsFont;
-  sclr: TsColor;
-  clr: TColor;
+  clr: TsColor;
 begin
  case FFormatItem of
    cfiFontName:
@@ -1709,17 +1742,8 @@ begin
      end;
    cfiBackgroundColor:
      begin
-        if Worksheet = nil then
-          clr := clNone
-        else
-        begin
-          sclr := Worksheet.ReadBackgroundColor(ACell);
-          if (sclr = scNotDefined) or (sclr = scTransparent) then
-            clr := clNone
-          else
-          clr := Workbook.GetPaletteColor(sclr);
-        end;
-        ItemIndex := Items.IndexOfObject(TObject(PtrInt(clr)));
+        clr := Worksheet.ReadBackgroundColor(ACell);
+        ItemIndex := Max(0, Items.IndexOfObject(TObject(PtrInt(clr))));
      end;
    cfiBorderColor:
      ;
@@ -1738,27 +1762,7 @@ begin
  else
    Result := nil;
 end;
-                           (*
-function TsCellCombobox.GetItemHeight: Integer;
-begin
-  Result := TWSCustomComboboxClass(WidgetSetClass).GetItemHeight(Self);
-  if inherited ItemHeight = 0 then
-    inherited ItemHeight := Result;
-  {
-  // FItemHeight is not initialized at class creating. we can, but with what value?
-  // so, if it still uninitialized (=0), then we ask widgetset
-  if (FStyle in [csOwnerDrawFixed, csOwnerDrawVariable]) and (FItemHeight > 0) or not HandleAllocated then
-  begin
-    Result := FItemHeight
-  end else
-  begin
-    Result := TWSCustomComboBoxClass(WidgetSetClass).GetItemHeight(Self);
-    if (FItemHeight = 0) then
-      FItemHeight := Result;
-  end;
-  }
-end;
-                             *)
+
 {@@ ----------------------------------------------------------------------------
  Getter method for the property Workbook which is currently loaded by the
  WorkbookSource
@@ -1802,7 +1806,7 @@ begin
    exit;

  activeCell := GetActiveCell;
-  if ((lniCell in AChangedItems) and (PCell(AData) = activeCell)) or
+  if (([lniCell]*AChangedItems <>[]) and (PCell(AData) = activeCell)) or
     (lniSelection in AChangedItems)
  then
    ExtractFromCell(activeCell);
@@ -1832,6 +1836,7 @@ end;

 {@@ ----------------------------------------------------------------------------
  Descendants override this method to populate the items of the combobox.
+  Color index into the workbook's palette is stored in the "Objects" property.
 -------------------------------------------------------------------------------}
 procedure TsCellCombobox.Populate;
 var
@@ -1847,16 +1852,16 @@ begin
      Items.CommaText := '8,9,10,11,12,13,14,16,18,20,22,24,26,28,32,36,48,72';
    cfiFontColor:
      for i:=0 to Workbook.GetPaletteSize-1 do
-        Items.AddObject(Workbook.GetColorName(i), TObject(Workbook.GetPaletteColor(i)));
+        Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
    cfiBackgroundColor:
      begin
-        Items.AddObject('(none)', TObject(clNone));
+        Items.AddObject('(none)', TObject(scTransparent));
        for i:=0 to Workbook.GetPaletteSize-1 do
-          Items.AddObject(Workbook.GetColorName(i), TObject(Workbook.GetPaletteColor(i)));
+          Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
      end;
    cfiBorderColor:
      for i:=0 to Workbook.GetPaletteSize-1 do
-        Items.AddObject(Workbook.GetColorName(i), TObject(Workbook.GetPaletteColor(i)));
+        Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
    else
      raise Exception.Create('[TsCellCombobox.Populate] Unknown cell format item.');
  end;
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -3053,6 +3053,13 @@ begin
    MouseUp(mbLeft, [], GCache.ClickMouse.X, GCache.ClickMouse.Y);
    // HOW TO DO THIS????    SelectActive not working...
  end;
+
+  // Row height (after font change).
+  if (lniRow in AChangedItems) and (Worksheet <> nil) then
+  begin
+    grow := GetGridRow(PtrInt(AData));
+    RowHeights[grow] := CalcAutoRowHeight(grow);
+  end;
 end;

 {@@ ----------------------------------------------------------------------------