From 7b9a56cd3ea26e2fcc0cc4da7d97027ad7f12371 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 6 Apr 2016 08:37:34 +0000 Subject: [PATCH] fpspreadsheet: Add method AddColors and event OnGetColorName to TsCellCombobox. Remove ComboColors. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4607 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/visual/fpsctrls/main.lfm | 17 ++++-- .../examples/visual/fpsctrls/main.pas | 59 +++++++++++++++++- components/fpspreadsheet/fpspalette.pas | 1 + .../fpspreadsheet/fpspreadsheetctrls.pas | 60 +++++++++++++------ 4 files changed, 112 insertions(+), 25 deletions(-) diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 41c453a66..7bae3251d 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm @@ -78,7 +78,7 @@ object MainForm: TMainForm Align = alClient DefaultColWidth = 125 MouseWheelOption = mwGrid - RowCount = 30 + RowCount = 33 TabOrder = 1 TitleStyle = tsNative DisplayOptions = [doColumnTitles] @@ -108,11 +108,14 @@ object MainForm: TMainForm ' PosCurrencyFormat=3' ' NegCurrencyFormat=8' ' TwoDigitYearCenturyWindow=50' - 'Font0=Arial; size 10; black' - 'Font1=Arial; size 10; blue; underline' - 'Font2=Arial; size 10; black; bold' - 'Font3=Arial; size 10; black; italic' - 'CellFormat0=nfGeneral' + '(-) Images=' + '(-) Fonts=' + ' Font0=Arial; size 10; black' + ' Font1=Arial; size 10; blue; underline' + ' Font2=Arial; size 10; black; bold' + ' Font3=Arial; size 10; black; italic' + '(-) Cell formats=' + ' CellFormat0=nfGeneral' ) TitleCaptions.Strings = ( 'Properties' @@ -374,6 +377,7 @@ object MainForm: TMainForm ColorRectOffset = 3 ColorRectWidth = -1 WorkbookSource = WorkbookSource + OnAddColors = ColorComboboxAddColors DropDownCount = 24 ItemIndex = 0 TabOrder = 2 @@ -388,6 +392,7 @@ object MainForm: TMainForm ColorRectOffset = 3 ColorRectWidth = -1 WorkbookSource = WorkbookSource + OnAddColors = ColorComboboxAddColors DropDownCount = 24 ItemIndex = 0 TabOrder = 3 diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index 1b246de35..11f364e66 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas @@ -376,6 +376,7 @@ type procedure AcShowHeadersUpdate(Sender: TObject); procedure AcViewInspectorExecute(Sender: TObject); procedure EditCut1Execute(Sender: TObject); + procedure ColorComboboxAddColors(Sender: TObject); procedure FormCreate(Sender: TObject); procedure HyperlinkHandler(Sender: TObject; ACaption: String; var AHyperlink: TsHyperlink); @@ -408,7 +409,6 @@ implementation uses LCLIntf, inifiles, uriparser, fpsUtils, fpsCSV, -// fpsCSV, fpsHTML, fpsOpenDocument, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml, wikitable, sCSVParamsForm, sCurrencyForm, sFormatSettingsForm, sSortParamsForm, sHyperlinkForm, sNumFormatForm, sSearchForm; @@ -651,6 +651,63 @@ begin InspectorSplitter.Left := 0; // Make sure that the splitter is always at the left of the inspector end; +procedure TMainForm.ColorComboboxAddColors(Sender: TObject); +begin + with TsCellCombobox(Sender) do begin + // These are the Excel-8 palette colors, a bit rearranged and without the + // duplicates. + AddColor($000000, 'black'); + AddColor($333333, 'gray 80%'); + AddColor($808080, 'gray 50%'); + AddColor($969696, 'gray 40%'); + AddColor($C0C0C0, 'silver'); + AddColor($FFFFFF, 'white'); + AddColor($FF0000, 'red'); + AddColor($00FF00, 'green'); + AddColor($0000FF, 'blue'); + AddColor($FFFF00, 'yellow'); + AddColor($FF00FF, 'magenta'); + AddColor($00FFFF, 'cyan'); + + AddColor($800000, 'dark red'); + AddColor($008000, 'dark green'); + AddColor($000080, 'dark blue'); + AddColor($808000, 'olive'); + AddColor($800080, 'purple'); + AddColor($008080, 'teal'); + AddColor($9999FF, 'periwinkle'); + AddColor($993366, 'plum'); + AddColor($FFFFCC, 'ivory'); + AddColor($CCFFFF, 'light turquoise'); + AddColor($660066, 'dark purple'); + AddColor($FF8080, 'coral'); + AddColor($0066CC, 'ocean blue'); + AddColor($CCCCFF, 'ice blue'); + + AddColor($00CCFF, 'sky blue'); + AddColor($CCFFCC, 'light green'); + AddColor($FFFF99, 'light yellow'); + AddColor($99CCFF, 'pale blue'); + AddColor($FF99CC, 'rose'); + AddColor($CC99FF, 'lavander'); + AddColor($FFCC99, 'tan'); + + AddColor($3366FF, 'light blue'); + AddColor($33CCCC, 'aqua'); + AddColor($99CC00, 'lime'); + AddColor($FFCC00, 'gold'); + AddColor($FF9900, 'light orange'); + AddColor($FF6600, 'orange'); + AddColor($666699, 'blue gray'); + AddColor($003366, 'dark teal'); + AddColor($339966, 'sea green'); + AddColor($003300, 'very dark green'); + AddColor($333300, 'olive green'); + AddColor($993300, 'brown'); + AddColor($333399, 'indigo'); + end; +end; + procedure TMainForm.EditCut1Execute(Sender: TObject); begin // diff --git a/components/fpspreadsheet/fpspalette.pas b/components/fpspreadsheet/fpspalette.pas index 33d0a0686..e3aa874db 100644 --- a/components/fpspreadsheet/fpspalette.pas +++ b/components/fpspreadsheet/fpspalette.pas @@ -21,6 +21,7 @@ uses type { TsPalette } + TsPalette = class private FColors: array of TsColor; diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index e6e41dd4b..b54fd74e4 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -301,6 +301,9 @@ type { TsCellCombobox } + TsColorNameEvent = procedure (Sender: TObject; AColor: TColor; + out AColorName: String) of object; + {@@ TsCellCombobox is a multi-purpose combobox for selection of formatting items of a cell } TsCellCombobox = class(TCustomCombobox, IsSpreadsheetControl) @@ -309,6 +312,8 @@ type FFormatItem: TsCellFormatItem; FColorRectOffset: Integer; FColorRectWidth: Integer; + FOnAddColors: TNotifyEvent; + FOnGetColorName: TsColorNameEvent; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; procedure SetColorRectOffset(AValue: Integer); @@ -331,6 +336,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure AddColor(AColor: TsColor; AColorName: String); procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; @@ -347,6 +353,10 @@ type property ColorRectWidth: Integer read FColorRectWidth write SetColorRectWidth default 10; {@@ Link to the WorkbookSource which provides the workbook and worksheet. } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; + {@@ Event which adds the colors to the combobox } + property OnAddColors: TNotifyEvent read FOnAddColors write FOnAddColors; + {@@ Event to get a decent name of the colors of the combo } + property OnGetColorName: TsColorNameEvent read FOnGetColorName write FOnGetColorName; { inherited properties } property Align; @@ -483,9 +493,6 @@ type function SpreadsheetFormatInClipboard: Boolean; -var - ComboColors: TsPalette = nil; - procedure Register; @@ -2116,6 +2123,20 @@ begin inherited Destroy; end; +{@@ ---------------------------------------------------------------------------- + Adds a named color to the combobox items +-------------------------------------------------------------------------------} +procedure TsCellCombobox.AddColor(AColor: TsColor; AColorName: String); +var + noText: Boolean; +begin + if (FFormatItem in [cfiFontColor, cfiBackgroundColor, cfiBorderColor]) then + begin + noText := (FColorRectWidth = -1); + Items.AddObject(StrUtils.IfThen(noText, '', AColorName), TObject(PtrInt(AColor))); + end; +end; + {@@ ---------------------------------------------------------------------------- Applies the format to a cell. Override according to the format item for which the combobox is responsible. @@ -2389,6 +2410,7 @@ procedure TsCellCombobox.Populate; var i: Integer; clr: TsColor; + clrname: String; noText: Boolean; begin if Workbook = nil then @@ -2407,10 +2429,18 @@ begin Items.Clear; if FFormatItem = cfiBackgroundColor then Items.AddObject(StrUtils.IfThen(noText, '', '(none)'), TObject(scTransparent)); - for i:=0 to ComboColors.Count-1 do - begin - clr := ComboColors[i]; - Items.AddObject(StrUtils.IfThen(noText, '', GetColorName(clr)), TObject(PtrInt(clr))); + if Assigned(FOnAddColors) then + FOnAddColors(self) + else begin + // By default, add the Excel2 colors. + AddColor(scBlack, GetColorName(scBlack)); + AddColor(scWhite, GetColorName(scWhite)); + AddColor(scRed, GetColorName(scRed)); + AddColor(scGreen, GetColorName(scGreen)); + AddColor(scBlue, GetColorName(scBlue)); + AddColor(scYellow, GetColorName(scYellow)); + AddColor(scMagenta, GetColorName(scMagenta)); + AddColor(scCyan, GetColorName(scCyan)); end; end; else @@ -3397,13 +3427,11 @@ end; initialization {$I fpspreadsheetctrls.lrs} -// CellClipboard := TsCellList.Create; + RegisterPropertyToSkip(TsSpreadsheetInspector, 'RowHeights', + 'For compatibility with older Laz versions.', ''); - ComboColors := TsPalette.Create; - ComboColors.AddExcelColors; - - RegisterPropertyToSkip(TsSpreadsheetInspector, 'RowHeights', 'For compatibility with older Laz versions.', ''); - RegisterPropertyToSkip(TsSpreadsheetInspector, 'ColWidths', 'For compatibility with older Laz versions.', ''); + RegisterPropertyToSkip(TsSpreadsheetInspector, 'ColWidths', + 'For compatibility with older Laz versions.', ''); { Clipboard formats } cfBiff8Format := RegisterclipboardFormat('Biff8'); @@ -3411,14 +3439,10 @@ initialization cfHTMLFormat := RegisterClipboardFormat('HTML Format'); cfTextHTMLFormat := RegisterClipboardFormat('text/html'); cfCSVFormat := RegisterClipboardFormat('CSV'); + { not working... cfOpenDocumentFormat := RegisterClipboardFormat('application/x-openoffice-embed-source-xml;windows_formatname="Star Embed Source (XML)"'); cfStarObjectDescriptor := RegisterClipboardFormat('application/x-openoffice-objectdescriptor-xml;windows_formatname="Star Object Descriptor (XML)"'); } -finalization -// CellClipboard.Free; - if ComboColors <> nil then ComboColors.Free; - - end.