From 7b3795dc03d24c7f957110705b2f526630f19c59 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 20 Oct 2014 09:22:06 +0000 Subject: [PATCH] fpspreadsheet: Less hints. Adapt spready code to differences between trunk and Laz 1.2.6, remove duplicate colorbox unit in spready. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3667 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/spready/colorbox.pas | 986 ------------------ .../examples/spready/mainform.lfm | 67 +- .../examples/spready/mainform.pas | 1 - .../examples/spready/scsvparamsform.lfm | 140 +-- .../examples/spready/scsvparamsform.pas | 50 +- .../fpspreadsheet/examples/spready/sctrls.pas | 8 +- .../examples/spready/sformatsettingsform.lfm | 181 ++-- .../examples/spready/sformatsettingsform.pas | 27 +- .../examples/spready/spready.lpi | 9 + components/fpspreadsheet/fpscsv.pas | 9 +- components/fpspreadsheet/fpsexprparser.pas | 1 - components/fpspreadsheet/fpsopendocument.pas | 4 + components/fpspreadsheet/fpspreadsheet.pas | 8 +- .../fpspreadsheet/fpspreadsheetgrid.pas | 2 - components/fpspreadsheet/fpsutils.pas | 4 +- components/fpspreadsheet/xlsbiff2.pas | 2 +- components/fpspreadsheet/xlsxooxml.pas | 5 +- 17 files changed, 252 insertions(+), 1252 deletions(-) delete mode 100644 components/fpspreadsheet/examples/spready/colorbox.pas diff --git a/components/fpspreadsheet/examples/spready/colorbox.pas b/components/fpspreadsheet/examples/spready/colorbox.pas deleted file mode 100644 index 6c587b012..000000000 --- a/components/fpspreadsheet/examples/spready/colorbox.pas +++ /dev/null @@ -1,986 +0,0 @@ -{ - TColorBox is component that displays colors in a combobox - TColorListBox is component that displays colors in a listbox - - Copyright (C) 2005 Darius Blaszijk - - ***************************************************************************** - This file is part of the Lazarus Component Library (LCL) - - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** -} - -unit ColorBox; - -{$mode objfpc} -{$H+} - -interface - -uses - LResources, SysUtils, LCLProc, LCLType, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, LCLStrConsts; - -type - { TCustomColorBox } - - TCustomColorBox = class; - TColorBoxStyles = (cbStandardColors, // 16 standard colors (look at graphics.pp) - cbExtendedColors, // 4 extended colors (look at graphics.pp) - cbSystemColors, // system colors (look at graphics.pp) - cbIncludeNone, // include clNone - cbIncludeDefault, // include clDefault - cbCustomColor, // first color is customizable - cbPrettyNames, // use good looking color names - like Red for clRed - cbCustomColors); // call OnGetColors after all other colors processing - TColorBoxStyle = set of TColorBoxStyles; - TGetColorsEvent = procedure(Sender: TCustomColorBox; Items: TStrings) of object; - - TCustomColorBox = class(TCustomComboBox) - private - FColorRectWidth: Integer; - FDefaultColorColor: TColor; - FNoneColorColor: TColor; - FOnGetColors: TGetColorsEvent; - FStyle: TColorBoxStyle; - FSelected: TColor; - function GetColor(Index : Integer): TColor; - function GetColorName(Index: Integer): string; - function GetSelected: TColor; - procedure SetColorRectWidth(AValue: Integer); - procedure SetDefaultColorColor(const AValue: TColor); - procedure SetNoneColorColor(const AValue: TColor); - procedure SetSelected(Value: TColor); - procedure SetStyle(const AValue: TColorBoxStyle); reintroduce; - procedure ColorProc(const s: AnsiString); - procedure UpdateCombo; - protected - procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; - procedure SetColorList; - procedure Loaded; override; - procedure InitializeWnd; override; - procedure DoGetColors; virtual; - procedure CloseUp; override; - function PickCustomColor: Boolean; virtual; - public - constructor Create(AOwner: TComponent); override; - property ColorRectWidth: Integer read FColorRectWidth write SetColorRectWidth default 14; - property Style: TColorBoxStyle read FStyle write SetStyle - default [cbStandardColors, cbExtendedColors, cbSystemColors]; - property Colors[Index: Integer]: TColor read GetColor; - property ColorNames[Index: Integer]: string read GetColorName; - property Selected: TColor read GetSelected write SetSelected default clBlack; - property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack; - property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack; - property OnGetColors: TGetColorsEvent read FOnGetColors write FOnGetColors; - end; - - { TColorBox } - - TColorBox = class(TCustomColorBox) - published - property ColorRectWidth; - property DefaultColorColor; - property NoneColorColor; - property Selected; - property Style; - property OnGetColors; - - property Align; - property Anchors; - property ArrowKeysTraverseList; - property AutoComplete; - property AutoCompleteText; - property AutoDropDown; - property AutoSelect; - property AutoSize; - property BidiMode; - property BorderSpacing; - property Color; - property Constraints; - property DragCursor; - property DragMode; - property DropDownCount; - property Enabled; - property Font; - property ItemHeight; - property ItemWidth; - property OnChange; - property OnChangeBounds; - property OnClick; - property OnCloseUp; - property OnContextPopup; - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnEndDrag; - property OnDropDown; - property OnEditingDone; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseEnter; - property OnMouseLeave; - property OnMouseMove; - property OnMouseUp; - property OnStartDrag; - property OnSelect; - property OnUTF8KeyPress; - property ParentBidiMode; - property ParentColor; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; - property Visible; - end; - - { TCustomColorListBox } - - TCustomColorListBox = class; - TLBGetColorsEvent = procedure(Sender: TCustomColorListBox; Items: TStrings) of object; - - TCustomColorListBox = class(TCustomListBox) - private - FColorRectWidth: Integer; - FDefaultColorColor: TColor; - FNoneColorColor: TColor; - FOnGetColors: TLBGetColorsEvent; - FSelected: TColor; - FStyle: TColorBoxStyle; - function GetColors(Index : Integer): TColor; - function GetColorName(Index: Integer): string; - function GetSelected: TColor; - procedure SetColorRectWidth(AValue: Integer); - procedure SetColors(Index: Integer; AValue: TColor); - procedure SetDefaultColorColor(const AValue: TColor); - procedure SetNoneColorColor(const AValue: TColor); - procedure SetSelected(Value: TColor); - procedure SetStyle(const AValue: TColorBoxStyle); reintroduce; - procedure ColorProc(const s: AnsiString); - protected - procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; - procedure SetColorList; - procedure Loaded; override; - procedure InitializeWnd; override; - procedure DoGetColors; virtual; - procedure DoSelectionChange(User: Boolean); override; - function PickCustomColor: Boolean; virtual; - public - constructor Create(AOwner: TComponent); override; - property ColorRectWidth: Integer read FColorRectWidth write SetColorRectWidth default 14; - property Style: TColorBoxStyle read FStyle write SetStyle - default [cbStandardColors, cbExtendedColors, cbSystemColors]; - property Colors[Index: Integer]: TColor read GetColors write SetColors; - property ColorNames[Index: Integer]: string read GetColorName; - property Selected: TColor read GetSelected write SetSelected default clBlack; - property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack; - property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack; - property OnGetColors: TLBGetColorsEvent read FOnGetColors write FOnGetColors; - end; - - { TColorListBox } - - TColorListBox = class(TCustomColorListBox) - published - property ColorRectWidth; - property DefaultColorColor; - property NoneColorColor; - property Selected; - property Style; - property OnGetColors; - - property Align; - property Anchors; - property BidiMode; - property BorderSpacing; - property BorderStyle; - property ClickOnSelChange; - property Color; - property Constraints; - property DragCursor; - property DragKind; - property DragMode; - property ExtendedSelect; - property Enabled; - property Font; - property IntegralHeight; - property ItemHeight; - property OnChangeBounds; - property OnClick; - property OnContextPopup; - property OnDblClick; - property OnDragDrop; - property OnDragOver; - property OnEnter; - property OnEndDrag; - property OnExit; - property OnKeyPress; - property OnKeyDown; - property OnKeyUp; - property OnMouseMove; - property OnMouseDown; - property OnMouseUp; - property OnMouseEnter; - property OnMouseLeave; - property OnMouseWheel; - property OnMouseWheelDown; - property OnMouseWheelUp; - property OnResize; - property OnSelectionChange; - property OnShowHint; - property OnStartDrag; - property OnUTF8KeyPress; - property ParentBidiMode; - property ParentColor; - property ParentShowHint; - property ParentFont; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; - property TopIndex; - property Visible; - end; - -procedure Register; - -implementation - -{------------------------------------------------------------------------------} -procedure Register; -begin - RegisterComponents('Additional', [TColorBox, TColorListBox]); -end; - -function GetPrettyColorName(ColorName: String): String; - - function FindInMap(ColorName: String; out NewColorName: String): Boolean; - var - Color: TColor; - begin - Result := IdentToColor(ColorName, Color); - if Result then - begin - { workaround for a bug in fpc 2.2.2 } - if Color=clScrollBar then - NewColorName := rsScrollBarColorCaption - else - case Color of - clBlack : NewColorName := rsBlackColorCaption; - clMaroon : NewColorName := rsMaroonColorCaption; - clGreen : NewColorName := rsGreenColorCaption; - clOlive : NewColorName := rsOliveColorCaption; - clNavy : NewColorName := rsNavyColorCaption; - clPurple : NewColorName := rsPurpleColorCaption; - clTeal : NewColorName := rsTealColorCaption; - clGray : NewColorName := rsGrayColorCaption; - clSilver : NewColorName := rsSilverColorCaption; - clRed : NewColorName := rsRedColorCaption; - clLime : NewColorName := rsLimeColorCaption; - clYellow : NewColorName := rsYellowColorCaption; - clBlue : NewColorName := rsBlueColorCaption; - clFuchsia : NewColorName := rsFuchsiaColorCaption; - clAqua : NewColorName := rsAquaColorCaption; - clWhite : NewColorName := rsWhiteColorCaption; - clMoneyGreen : NewColorName := rsMoneyGreenColorCaption; - clSkyBlue : NewColorName := rsSkyBlueColorCaption; - clCream : NewColorName := rsCreamColorCaption; - clMedGray : NewColorName := rsMedGrayColorCaption; - clNone : NewColorName := rsNoneColorCaption; - clDefault : NewColorName := rsDefaultColorCaption; - clBackground : NewColorName := rsBackgroundColorCaption; - clActiveCaption : NewColorName := rsActiveCaptionColorCaption; - clInactiveCaption : NewColorName := rsInactiveCaptionColorCaption; - clMenu : NewColorName := rsMenuColorCaption; - clWindow : NewColorName := rsWindowColorCaption; - clWindowFrame : NewColorName := rsWindowFrameColorCaption; - clMenuText : NewColorName := rsMenuTextColorCaption; - clWindowText : NewColorName := rsWindowTextColorCaption; - clCaptionText : NewColorName := rsCaptionTextColorCaption; - clActiveBorder : NewColorName := rsActiveBorderColorCaption; - clInactiveBorder : NewColorName := rsInactiveBorderColorCaption; - clAppWorkspace : NewColorName := rsAppWorkspaceColorCaption; - clHighlight : NewColorName := rsHighlightColorCaption; - clHighlightText : NewColorName := rsHighlightTextColorCaption; - clBtnFace : NewColorName := rsBtnFaceColorCaption; - clBtnShadow : NewColorName := rsBtnShadowColorCaption; - clGrayText : NewColorName := rsGrayTextColorCaption; - clBtnText : NewColorName := rsBtnTextColorCaption; - clInactiveCaptionText : NewColorName := rsInactiveCaptionText; - clBtnHighlight : NewColorName := rsBtnHighlightColorCaption; - cl3DDkShadow : NewColorName := rs3DDkShadowColorCaption; - cl3DLight : NewColorName := rs3DLightColorCaption; - clInfoText : NewColorName := rsInfoTextColorCaption; - clInfoBk : NewColorName := rsInfoBkColorCaption; - clHotLight : NewColorName := rsHotLightColorCaption; - clGradientActiveCaption : NewColorName := rsGradientActiveCaptionColorCaption; - clGradientInactiveCaption : NewColorName := rsGradientInactiveCaptionColorCaption; - clMenuHighlight : NewColorName := rsMenuHighlightColorCaption; - clMenuBar : NewColorName := rsMenuBarColorCaption; - clForm : NewColorName := rsFormColorCaption; - else - Result := False; - end; - end; - end; - -begin - // check in color map - if not FindInMap(ColorName, Result) then - begin - Result := ColorName; - if Copy(Result, 1, 2) = 'cl' then - Delete(Result, 1, 2); - end; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorBox.Create - Params: AOwner - Returns: Nothing - - Use Create to create an instance of TCustomColorBox and initialize all properties - and variables. - - ------------------------------------------------------------------------------} -constructor TCustomColorBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - inherited Style := csOwnerDrawFixed; - inherited ReadOnly := True; - - FColorRectWidth := 14; - FStyle := [cbStandardColors, cbExtendedColors, cbSystemColors]; - FNoneColorColor := clBlack; - FDefaultColorColor := clBlack; - FSelected := clBlack; - - SetColorList; -end; -{------------------------------------------------------------------------------ - Method: TCustomColorBox.GetSelected - Params: None - Returns: TColor - - Use GetSelected to convert the item selected into a system color. - - ------------------------------------------------------------------------------} -function TCustomColorBox.GetSelected: TColor; -begin - if HandleAllocated then - begin - if ItemIndex <> -1 then - begin - Result := Colors[ItemIndex]; - // keep FSelected in sync - if FSelected <> Result then - begin - // DebugLn('WARNING TCustomColorBox: FSelected out of sync with Colors[0]'); - FSelected := Result; - end; - end else - Result := FSelected; - end - else - Result := FSelected; -end; - -procedure TCustomColorBox.SetColorRectWidth(AValue: Integer); -begin - if FColorRectWidth = AValue then Exit; - FColorRectWidth := AValue; - Invalidate; -end; - -procedure TCustomColorBox.SetDefaultColorColor(const AValue: TColor); -begin - if FDefaultColorColor <> AValue then - begin - FDefaultColorColor := AValue; - invalidate; - end; -end; - -procedure TCustomColorBox.SetNoneColorColor(const AValue: TColor); -begin - if FNoneColorColor <> AValue then - begin - FNoneColorColor := AValue; - invalidate; - end; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorBox.GetColor - Params: Index - Returns: Color at position Index - - Used as read procedure from Colors property. - - ------------------------------------------------------------------------------} - -function TCustomColorBox.GetColor(Index : Integer): TColor; -begin - Result := PtrInt(Items.Objects[Index]) -end; - -function TCustomColorBox.GetColorName(Index: Integer): string; -begin - Result := Items[Index]; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorBox.SetSelected - Params: Value - Returns: Nothing - - Use SetSelected to set the item in the ColorBox when appointed a color - from code. - - ------------------------------------------------------------------------------} -procedure TCustomColorBox.SetSelected(Value: TColor); -begin - if FSelected = Value then - Exit; - - FSelected := Value; - UpdateCombo; - inherited Change; -end; - -procedure TCustomColorBox.SetStyle(const AValue: TColorBoxStyle); -begin - if FStyle <> AValue then - begin - FStyle := AValue; - SetColorList; - end; -end; - -procedure TCustomColorBox.ColorProc(const s: AnsiString); -var - AColor: TColor; - Index: Integer; - ColorCaption: String; -begin - if IdentToColor(s, AColor) then - begin - if AColor = clWhite then - AColor := AColor; - // check clDefault - if not (cbIncludeDefault in Style) and (AColor = clDefault) then - Exit; - // check clNone - if not (cbIncludeNone in Style) and (AColor = clNone) then - Exit; - // check System colors - if not (cbSystemColors in Style) and ((AColor and SYS_COLOR_BASE) <> 0) then - Exit; - // check Standard, Extended colors - if ([cbStandardColors, cbExtendedColors] * Style <> [cbStandardColors, cbExtendedColors]) and - ColorIndex(AColor, Index) then - begin - if not (cbStandardColors in Style) and (Index < StandardColorsCount) then - Exit; - if not (cbExtendedColors in Style) and - (Index < StandardColorsCount + ExtendedColorCount) and - (Index >= StandardColorsCount) then - Exit; - end; - - if cbPrettyNames in Style then - ColorCaption := GetPrettyColorName(s) - else - ColorCaption := s; - - Items.AddObject(ColorCaption, TObject(PtrInt(AColor))); - end; -end; - -procedure TCustomColorBox.UpdateCombo; -var - c: integer; -begin - if HandleAllocated then - begin - for c := Ord(cbCustomColor in Style) to Items.Count - 1 do - begin - if Colors[c] = FSelected then - begin - ItemIndex := c; - Exit; - end; - end; - if cbCustomColor in Style then - begin - Items.Objects[0] := TObject(PtrInt(FSelected)); - ItemIndex := 0; - Invalidate; - end - else - ItemIndex := -1; - end; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorBox.DrawItem - Params: Index, Rect, State - Returns: Nothing - - Use DrawItem to customdraw an item in the ColorBox. A color preview is drawn - and the item rectangle is made smaller and given to the inherited method to - draw the corresponding text. The Brush color and Pen color where changed and - reset to their original values. - - ------------------------------------------------------------------------------} -procedure TCustomColorBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); -var - r: TRect; - BrushColor, PenColor, NewColor: TColor; - noFill: Boolean; -begin - if Index = -1 then - Exit; - - r.top := Rect.top + 3; - r.bottom := Rect.bottom - 3; - r.left := Rect.left + 3; - r.right := r.left + FColorRectWidth; - Exclude(State, odPainted); - - noFill := false; - - with Canvas do - begin - FillRect(Rect); - - BrushColor := Brush.Color; - PenColor := Pen.Color; - - NewColor := Self.Colors[Index]; - - if NewColor = clNone then - begin - NewColor := NoneColorColor; - noFill := true; - end - else - if NewColor = clDefault then - NewColor := DefaultColorColor; - - Brush.Color := NewColor; - Pen.Color := clBlack; - - r := BiDiFlipRect(r, Rect, 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.Color := BrushColor; - Pen.Color := PenColor; - end; - r := Rect; - r.left := r.left + FColorRectWidth + 4; - - inherited DrawItem(Index, BidiFlipRect(r, Rect, UseRightToLeftAlignment), State); -end; -{------------------------------------------------------------------------------ - Method: TCustomColorBox.SetColorList - Params: None - Returns: Nothing - - Use SetColorList to fill the itemlist in the ColorBox with the right color - entries. Based on the value of the Palette property. - - ------------------------------------------------------------------------------} -procedure TCustomColorBox.SetColorList; -var - OldSelected: Integer; -begin - // we need to wait while we finish loading since we depend on style and OnGetColors event - if (csLoading in ComponentState) then - Exit; - - OldSelected := FSelected; - with Items do - begin - Clear; - if cbCustomColor in Style then - Items.AddObject(rsCustomColorCaption, TObject(PtrInt(clBlack))); - GetColorValues(@ColorProc); - if (cbCustomColors in Style) then - DoGetColors; - end; - Selected := OldSelected; -end; - -procedure TCustomColorBox.Loaded; -begin - inherited Loaded; - SetColorList; -end; - -procedure TCustomColorBox.InitializeWnd; -begin - inherited InitializeWnd; - UpdateCombo; -end; - -procedure TCustomColorBox.DoGetColors; -begin - if Assigned(OnGetColors) then - OnGetColors(Self, Items) -end; - -procedure TCustomColorBox.CloseUp; -begin - if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected - PickCustomColor; - if ItemIndex <> -1 then - Selected := Colors[ItemIndex]; - inherited CloseUp; -end; - -function TCustomColorBox.PickCustomColor: Boolean; -begin - if csDesigning in ComponentState then - begin - Result := False; - Exit; - end; - - with TColorDialog.Create(Self) do - begin - Color := Colors[0]; - Result := Execute; - if Result then - begin - Items.Objects[0] := TObject(PtrInt(Color)); - invalidate; - end; - Free; - end; -end; - -{------------------------------------------------------------------------------} -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.Create - Params: AOwner - Returns: Nothing - - Use Create to create an instance of TCustomColorListBox and initialize all properties - and variables. - - ------------------------------------------------------------------------------} -constructor TCustomColorListBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - inherited Style := lbOwnerDrawFixed; - FColorRectWidth := 14; - FStyle := [cbStandardColors, cbExtendedColors, cbSystemColors]; - FNoneColorColor := clBlack; - FDefaultColorColor := clBlack; - FSelected := clBlack; - - SetColorList; -end; -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.GetSelected - Params: None - Returns: TColor - - Use GetSelected to convert the item selected into a system color. - - ------------------------------------------------------------------------------} -function TCustomColorListBox.GetSelected: TColor; -begin - if HandleAllocated then - begin - if ItemIndex <> -1 then - Result := Colors[ItemIndex] - else - Result := FSelected - end - else - Result := FSelected; -end; - -procedure TCustomColorListBox.SetColorRectWidth(AValue: Integer); -begin - if FColorRectWidth = AValue then Exit; - FColorRectWidth := AValue; - Invalidate; -end; - -procedure TCustomColorListBox.SetColors(Index: Integer; AValue: TColor); -begin - if Colors[Index]=AValue then exit; - Items.Objects[Index]:=TObject(PtrInt(AValue)); - Invalidate; -end; - -procedure TCustomColorListBox.SetDefaultColorColor(const AValue: TColor); -begin - if FDefaultColorColor <> AValue then - begin - FDefaultColorColor := AValue; - invalidate; - end; -end; - -procedure TCustomColorListBox.SetNoneColorColor(const AValue: TColor); -begin - if FNoneColorColor <> AValue then - begin - FNoneColorColor := AValue; - invalidate; - end; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.GetColors - Params: Index - Returns: Color at position Index - - Used as read procedure from Colors property. - - ------------------------------------------------------------------------------} -function TCustomColorListBox.GetColors(Index : Integer): TColor; -begin - Result := PtrInt(Items.Objects[Index]); -end; - -function TCustomColorListBox.GetColorName(Index: Integer): string; -begin - Result := Items[Index]; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.SetSelected - Params: Value - Returns: Nothing - - Use SetSelected to set the item in the ColorListBox when appointed a color - from code. - - ------------------------------------------------------------------------------} -procedure TCustomColorListBox.SetSelected(Value: TColor); -var - c: integer; -begin - if HandleAllocated then - begin - FSelected := Value; - for c := Ord(cbCustomColor in Style) to Items.Count - 1 do - begin - if Colors[c] = Value then - begin - ItemIndex := c; - Exit; - end; - end; - if cbCustomColor in Style then - begin - Items.Objects[0] := TObject(PtrInt(Value)); - ItemIndex := 0; - invalidate; - end - else - ItemIndex := -1; - end - else - FSelected := Value; -end; - -procedure TCustomColorListBox.SetStyle(const AValue: TColorBoxStyle); -begin - if FStyle <> AValue then - begin - FStyle := AValue; - SetColorList; - end; -end; - -procedure TCustomColorListBox.ColorProc(const s: AnsiString); -var - AColor: TColor; - Index: Integer; - ColorCaption: String; -begin - if IdentToColor(s, AColor) then - begin - // check clDefault - if not (cbIncludeDefault in Style) and (AColor = clDefault) then - Exit; - // check clNone - if not (cbIncludeNone in Style) and (AColor = clNone) then - Exit; - // check System colors - if not (cbSystemColors in Style) and ((AColor and SYS_COLOR_BASE) <> 0) then - Exit; - // check Standard, Extended colors - if ([cbStandardColors, cbExtendedColors] * Style <> [cbStandardColors, cbExtendedColors]) and - ColorIndex(AColor, Index) then - begin - if not (cbStandardColors in Style) and (Index < StandardColorsCount) then - Exit; - if not (cbExtendedColors in Style) and (Index < StandardColorsCount + ExtendedColorCount) then - Exit; - end; - - if cbPrettyNames in Style then - ColorCaption := GetPrettyColorName(s) - else - ColorCaption := s; - - Items.AddObject(ColorCaption, TObject(PtrInt(AColor))); - end; -end; - -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.DrawItem - Params: Index, Rect, State - Returns: Nothing - - Use DrawItem to customdraw an item in the ColorListBox. A color preview is drawn - and the item rectangle is made smaller and given to the inherited method to - draw the corresponding text. The Brush color and Pen color where changed and - reset to their original values. - - ------------------------------------------------------------------------------} -procedure TCustomColorListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); -var - r: TRect; - BrushColor, PenColor, NewColor: TColor; -begin - if Index < 0 then - Exit; - - r.top := Rect.top + 3; - r.bottom := Rect.bottom - 3; - r.left := Rect.left + 3; - r.right := r.left + FColorRectWidth; - Exclude(State,odPainted); - with Canvas do - begin - FillRect(Rect); - - BrushColor := Brush.Color; - PenColor := Pen.Color; - - NewColor := Self.Colors[Index]; - - if NewColor = clNone then - NewColor := NoneColorColor - else - if NewColor = clDefault then - NewColor := DefaultColorColor; - - Brush.Color := NewColor; - Pen.Color := clBlack; - - Rectangle(BidiFlipRect(r, Rect, UseRightToLeftAlignment)); - - Brush.Color := BrushColor; - Pen.Color := PenColor; - end; - r := Rect; - r.left := r.left + FColorRectWidth + 4; - - inherited DrawItem(Index, BidiFlipRect(r, Rect, UseRightToLeftAlignment), State); -end; -{------------------------------------------------------------------------------ - Method: TCustomColorListBox.SetColorList - Params: None - Returns: Nothing - - Use SetColorList to fill the itemlist in the ColorListBox with the right color - entries. Based on the value of the Palette property. - - ------------------------------------------------------------------------------} -procedure TCustomColorListBox.SetColorList; -var - OldSelected: Integer; -begin - // we need to wait while we finish loading since we depend on style and OnGetColors event - if (csLoading in ComponentState) then - Exit; - - OldSelected := FSelected; - with Items do - begin - Clear; - if cbCustomColor in Style then - Items.AddObject(rsCustomColorCaption, TObject(PtrInt(clBlack))); - GetColorValues(@ColorProc); - if (cbCustomColors in Style) then - DoGetColors; - end; - Selected := OldSelected; -end; - -procedure TCustomColorListBox.Loaded; -begin - inherited Loaded; - SetColorList; -end; - -procedure TCustomColorListBox.InitializeWnd; -begin - inherited InitializeWnd; - Selected := FSelected; -end; - -procedure TCustomColorListBox.DoGetColors; -begin - if Assigned(OnGetColors) then - OnGetColors(Self, Items) -end; - -procedure TCustomColorListBox.DoSelectionChange(User: Boolean); -begin - if User then - begin - if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected - PickCustomColor; - if ItemIndex <> -1 then - FSelected := Colors[ItemIndex]; - end; - inherited DoSelectionChange(User); -end; - -function TCustomColorListBox.PickCustomColor: Boolean; -begin - if csDesigning in ComponentState then - begin - Result := False; - Exit; - end; - - with TColorDialog.Create(Self) do - begin - Color := Colors[0]; - Result := Execute; - if Result then - begin - Items.Objects[0] := TObject(PtrInt(Color)); - invalidate; - end; - Free; - end; -end; - -{------------------------------------------------------------------------------} -end. diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index ec2cad9ca..491ef265c 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -4,17 +4,17 @@ object MainFrm: TMainFrm Top = 258 Width = 884 Caption = 'spready' - ClientHeight = 619 + ClientHeight = 614 ClientWidth = 884 Menu = MainMenu OnActivate = FormActivate OnCreate = FormCreate ShowHint = True - LCLVersion = '1.3' + LCLVersion = '1.2.6.0' object Panel1: TPanel Left = 0 Height = 82 - Top = 537 + Top = 532 Width = 884 Align = alBottom BevelOuter = bvNone @@ -23,7 +23,7 @@ object MainFrm: TMainFrm TabOrder = 6 object EdFrozenCols: TSpinEdit Left = 429 - Height = 23 + Height = 28 Top = 8 Width = 52 OnChange = EdFrozenColsChange @@ -31,7 +31,7 @@ object MainFrm: TMainFrm end object EdFrozenRows: TSpinEdit Left = 429 - Height = 23 + Height = 28 Top = 39 Width = 52 OnChange = EdFrozenRowsChange @@ -39,37 +39,37 @@ object MainFrm: TMainFrm end object Label1: TLabel Left = 344 - Height = 15 + Height = 20 Top = 13 - Width = 62 + Width = 77 Caption = 'Frozen cols:' FocusControl = EdFrozenCols ParentColor = False end object Label2: TLabel Left = 344 - Height = 15 + Height = 20 Top = 40 - Width = 66 + Width = 82 Caption = 'Frozen rows:' FocusControl = EdFrozenRows ParentColor = False end object CbReadFormulas: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 8 - Width = 96 + Width = 120 Caption = 'Read formulas' OnChange = CbReadFormulasChange TabOrder = 0 end object CbHeaderStyle: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 8 Width = 116 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 2 Items.Strings = ( 'Lazarus' @@ -83,18 +83,18 @@ object MainFrm: TMainFrm end object CbAutoCalcFormulas: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 32 - Width = 128 + Width = 158 Caption = 'Calculate on change' OnChange = CbAutoCalcFormulasChange TabOrder = 1 end object CbTextOverflow: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 56 - Width = 91 + Width = 114 Caption = 'Text overflow' Checked = True OnChange = CbTextOverflowChange @@ -206,19 +206,19 @@ object MainFrm: TMainFrm end object FontComboBox: TComboBox Left = 52 - Height = 23 + Height = 28 Top = 2 Width = 127 - ItemHeight = 15 + ItemHeight = 20 OnSelect = FontComboBoxSelect TabOrder = 0 end object FontSizeComboBox: TComboBox Left = 179 - Height = 23 + Height = 28 Top = 2 Width = 48 - ItemHeight = 15 + ItemHeight = 20 Items.Strings = ( '8' '9' @@ -394,7 +394,7 @@ object MainFrm: TMainFrm TabOrder = 2 object EdCellAddress: TEdit Left = 0 - Height = 23 + Height = 28 Top = 0 Width = 170 Align = alTop @@ -406,7 +406,7 @@ object MainFrm: TMainFrm end object InspectorSplitter: TSplitter Left = 648 - Height = 451 + Height = 446 Top = 86 Width = 5 Align = alRight @@ -414,7 +414,7 @@ object MainFrm: TMainFrm end object InspectorPageControl: TPageControl Left = 653 - Height = 451 + Height = 446 Top = 86 Width = 231 ActivePage = PgCellValue @@ -424,11 +424,11 @@ object MainFrm: TMainFrm OnChange = InspectorPageControlChange object PgCellValue: TTabSheet Caption = 'Cell value' - ClientHeight = 423 + ClientHeight = 413 ClientWidth = 223 object CellInspector: TValueListEditor Left = 0 - Height = 423 + Height = 413 Top = 0 Width = 223 Align = alClient @@ -472,7 +472,7 @@ object MainFrm: TMainFrm end object TabControl: TTabControl Left = 0 - Height = 451 + Height = 446 Top = 86 Width = 648 OnChange = TabControlChange @@ -480,7 +480,7 @@ object MainFrm: TMainFrm TabOrder = 3 object WorksheetGrid: TsWorksheetGrid Left = 2 - Height = 446 + Height = 441 Top = 3 Width = 644 FrozenCols = 0 @@ -498,7 +498,7 @@ object MainFrm: TMainFrm OnHeaderClick = WorksheetGridHeaderClick OnSelection = WorksheetGridSelection ColWidths = ( - 42 + 56 64 64 64 @@ -930,12 +930,6 @@ 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 = { @@ -1410,6 +1404,9 @@ object MainFrm: TMainFrm end object MnuSettings: TMenuItem Caption = 'Settings' + object MenuItem75: TMenuItem + Action = AcFormatSettings + end object MnuCSVParams: TMenuItem Action = AcCSVParams end diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 186414928..83502c37d 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -171,7 +171,6 @@ type MenuItem74: TMenuItem; MenuItem75: TMenuItem; MenuItem76: TMenuItem; - MenuItem77: TMenuItem; MnuCSVParams: TMenuItem; MnuSettings: TMenuItem; mnuInspector: TMenuItem; diff --git a/components/fpspreadsheet/examples/spready/scsvparamsform.lfm b/components/fpspreadsheet/examples/spready/scsvparamsform.lfm index a1285661f..8f3c84e13 100644 --- a/components/fpspreadsheet/examples/spready/scsvparamsform.lfm +++ b/components/fpspreadsheet/examples/spready/scsvparamsform.lfm @@ -1,20 +1,20 @@ object CSVParamsForm: TCSVParamsForm Left = 638 - Height = 528 + Height = 555 Top = 250 Width = 470 BorderStyle = bsDialog Caption = 'Parameters for comma-delimited files' - ClientHeight = 528 + ClientHeight = 555 ClientWidth = 470 OnCloseQuery = FormCloseQuery OnCreate = FormCreate Position = poMainFormCenter - LCLVersion = '1.3' + LCLVersion = '1.2.6.0' object ButtonPanel: TButtonPanel Left = 6 - Height = 34 - Top = 488 + Height = 38 + Top = 511 Width = 458 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True @@ -29,17 +29,19 @@ object CSVParamsForm: TCSVParamsForm end object PageControl: TPageControl Left = 8 - Height = 472 + Height = 495 Top = 8 Width = 454 - ActivePage = PgNumberParams + ActivePage = PgDateTimeParams Align = alClient BorderSpacing.Around = 8 - TabIndex = 1 + MultiLine = True + TabIndex = 3 TabOrder = 1 + Options = [nboMultiLine] object PgGeneralParams: TTabSheet Caption = 'General' - ClientHeight = 454 + ClientHeight = 410 ClientWidth = 446 object LblQuoteChar: TLabel Left = 16 @@ -52,10 +54,10 @@ object CSVParamsForm: TCSVParamsForm end object CbQuoteChar: TComboBox Left = 156 - Height = 23 + Height = 28 Top = 80 Width = 155 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'none' @@ -68,10 +70,10 @@ object CSVParamsForm: TCSVParamsForm end object CbDelimiter: TComboBox Left = 156 - Height = 23 + Height = 28 Top = 16 Width = 155 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 4 Items.Strings = ( 'Comma ( , )' @@ -104,10 +106,10 @@ object CSVParamsForm: TCSVParamsForm end object CbLineEnding: TComboBox Left = 156 - Height = 23 + Height = 28 Top = 48 Width = 155 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'System' @@ -133,7 +135,7 @@ object CSVParamsForm: TCSVParamsForm ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 60 + ClientHeight = 58 ClientWidth = 288 ItemIndex = 1 Items.Strings = ( @@ -145,13 +147,13 @@ object CSVParamsForm: TCSVParamsForm end object PgNumberParams: TTabSheet Caption = 'Number cells' - ClientHeight = 444 + ClientHeight = 410 ClientWidth = 446 object CbAutoDetectNumberFormat: TCheckBox Left = 16 - Height = 19 + Height = 24 Top = 16 - Width = 200 + Width = 248 Caption = 'Try to auto-detect number format' Checked = True State = cbChecked @@ -159,16 +161,16 @@ object CSVParamsForm: TCSVParamsForm end object EdNumFormat: TEdit Left = 232 - Height = 23 + Height = 28 Top = 140 Width = 194 TabOrder = 3 end object LblNumFormat: TLabel Left = 17 - Height = 15 + Height = 20 Top = 144 - Width = 182 + Width = 225 Caption = 'Format string for writing numbers:' FocusControl = EdNumFormat ParentColor = False @@ -189,19 +191,19 @@ object CSVParamsForm: TCSVParamsForm end object LblDecimalSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 59 - Width = 98 + Width = 125 Caption = 'Decimal separator:' FocusControl = CbDecimalSeparator ParentColor = False end object CbDecimalSeparator: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 56 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -213,19 +215,19 @@ object CSVParamsForm: TCSVParamsForm end object LblThousandSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 91 - Width = 108 + Width = 134 Caption = 'Thousand separator:' FocusControl = CbThousandSeparator ParentColor = False end object CbThousandSeparator: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 88 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -239,20 +241,20 @@ object CSVParamsForm: TCSVParamsForm end object PgCurrency: TTabSheet Caption = 'Currency cells' - ClientHeight = 444 + ClientHeight = 410 ClientWidth = 446 object LblCurrencySymbol: TLabel Left = 16 - Height = 15 + Height = 20 Top = 20 - Width = 93 + Width = 112 Caption = 'Currency symbol:' FocusControl = EdCurrencySymbol ParentColor = False end object EdCurrencySymbol: TEdit Left = 232 - Height = 23 + Height = 28 Top = 16 Width = 194 OnEnter = DateTimeFormatChange @@ -262,39 +264,39 @@ object CSVParamsForm: TCSVParamsForm end object PgDateTimeParams: TTabSheet Caption = 'Date/time cells' - ClientHeight = 444 + ClientHeight = 437 ClientWidth = 446 object LblNumFormat1: TLabel Left = 16 - Height = 15 + Height = 20 Top = 20 - Width = 128 + Width = 160 Caption = 'Long date format string:' ParentColor = False end object LblNumFormat2: TLabel Left = 16 - Height = 15 + Height = 20 Top = 52 - Width = 129 + Width = 162 Caption = 'Short date format string:' ParentColor = False end object LblDecimalSeparator1: TLabel Left = 16 - Height = 15 + Height = 20 Top = 83 - Width = 79 + Width = 102 Caption = 'Date separator:' FocusControl = CbDateSeparator ParentColor = False end object CbDateSeparator: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 80 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -309,35 +311,35 @@ object CSVParamsForm: TCSVParamsForm end object LblNumFormat3: TLabel Left = 16 - Height = 15 + Height = 20 Top = 268 - Width = 129 + Width = 160 Caption = 'Long time format string:' ParentColor = False end object LblNumFormat4: TLabel Left = 16 - Height = 15 + Height = 20 Top = 300 - Width = 130 + Width = 162 Caption = 'Short time format string:' ParentColor = False end object LblDecimalSeparator2: TLabel Left = 16 - Height = 15 + Height = 20 Top = 331 - Width = 82 + Width = 103 Caption = 'Time separator:' FocusControl = CbTimeSeparator ParentColor = False end object CbTimeSeparator: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 328 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -353,42 +355,42 @@ object CSVParamsForm: TCSVParamsForm end object LblLongMonthNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 116 - Width = 107 + Width = 130 Caption = 'Long month names:' ParentColor = False end object LblShortMonthNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 148 - Width = 108 + Width = 132 Caption = 'Short month names:' ParentColor = False end object LblLongDayNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 180 - Width = 90 + Width = 111 Caption = 'Long day names:' ParentColor = False end object LblShortDayNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 212 - Width = 91 + Width = 113 Caption = 'Short day names:' ParentColor = False end object CbLongDateFormat: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 16 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -414,10 +416,10 @@ object CSVParamsForm: TCSVParamsForm end object CbShortDateFormat: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 48 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -438,10 +440,10 @@ object CSVParamsForm: TCSVParamsForm end object CbLongTimeFormat: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 264 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -456,10 +458,10 @@ object CSVParamsForm: TCSVParamsForm end object CbShortTimeFormat: TComboBox Left = 232 - Height = 23 + Height = 28 Top = 296 Width = 194 - ItemHeight = 15 + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'like spreadsheet' @@ -478,7 +480,7 @@ object CSVParamsForm: TCSVParamsForm Top = 366 Width = 409 Caption = 'Sample' - ClientHeight = 38 + ClientHeight = 36 ClientWidth = 405 TabOrder = 6 object LblDateTimeSample: TLabel @@ -496,7 +498,7 @@ object CSVParamsForm: TCSVParamsForm end object PgBoolParams: TTabSheet Caption = 'Boolean cells' - ClientHeight = 454 + ClientHeight = 410 ClientWidth = 446 object EdTRUE: TEdit Left = 16 diff --git a/components/fpspreadsheet/examples/spready/scsvparamsform.pas b/components/fpspreadsheet/examples/spready/scsvparamsform.pas index d867015cf..17b411063 100644 --- a/components/fpspreadsheet/examples/spready/scsvparamsform.pas +++ b/components/fpspreadsheet/examples/spready/scsvparamsform.pas @@ -255,7 +255,11 @@ begin Parent := PgDateTimeParams; Left := CbDateSeparator.Left; Top := CbDateSeparator.Top + 32; + {$IFDEF LCL_FULLVERSION AND LCL_FULLVERSION > 1020600} Width := CbDateSeparator.Width; + {$ELSE} + Width := CbDateSeparator.Width - Button.Width; + {$ENDIF} OnChange := @DateTimeFormatChange; OnEnter := @DateTimeFormatChange; TabOrder := CbDateSeparator.TabOrder + 1; @@ -268,7 +272,7 @@ begin Parent := PgDateTimeParams; Left := CbDateSeparator.Left; Top := CbDateSeparator.Top + 32*2; - Width := CbDateSeparator.Width; + Width := FEdLongMonthNames.Width; TabOrder := CbDateSeparator.TabOrder + 2; OnChange := @DateTimeFormatChange; OnEnter := @DateTimeFormatChange; @@ -281,7 +285,7 @@ begin Parent := PgDateTimeParams; Left := CbDateSeparator.Left; Top := CbDateSeparator.Top + 32*3; - Width := CbDateSeparator.Width; + Width := FEdLongMonthNames.Width; TabOrder := CbDateSeparator.TabOrder + 3; OnChange := @DateTimeFormatChange; OnEnter := @DateTimeFormatChange; @@ -294,7 +298,7 @@ begin Parent := PgDateTimeParams; Left := CbDateSeparator.Left; Top := CbDateSeparator.Top + 32*4; - Width := CbDateSeparator.Width; + Width := FEdLongMonthNames.Width; TabOrder := CbDateSeparator.TabOrder + 4; OnChange := @DateTimeFormatChange; OnEnter := @DateTimeFormatChange; @@ -305,15 +309,7 @@ begin 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 @@ -361,20 +357,6 @@ begin 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 := '' @@ -481,23 +463,7 @@ begin 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 diff --git a/components/fpspreadsheet/examples/spready/sctrls.pas b/components/fpspreadsheet/examples/spready/sctrls.pas index 768c86cf0..7a46d5331 100644 --- a/components/fpspreadsheet/examples/spready/sctrls.pas +++ b/components/fpspreadsheet/examples/spready/sctrls.pas @@ -57,12 +57,9 @@ end; procedure TMonthDayNamesEdit.ButtonClick(Sender: TObject); var - List: TStringList; F: TForm; - i, j: Integer; - s: String; - isEmpty: Boolean; - grid: TStringGrid; + i: Integer; + grid: TStringGrid = nil; names: TMonthNameArray; // can hold day and month names as well begin F := CreateMonthDayNamesEditor(grid); @@ -138,6 +135,7 @@ begin else Cells[1, 0] := 'Long day names'; end; + names[1] := ''; // to silence the compiler... GetNames(names); w := 0; for i:=1 to FCount do diff --git a/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm b/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm index 99dfbf1b3..b24d34692 100644 --- a/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm +++ b/components/fpspreadsheet/examples/spready/sformatsettingsform.lfm @@ -1,52 +1,52 @@ object FormatSettingsForm: TFormatSettingsForm Left = 417 - Height = 476 + Height = 494 Top = 229 - Width = 417 + Width = 470 BorderStyle = bsDialog Caption = 'Workbook format settings' - ClientHeight = 476 - ClientWidth = 417 + ClientHeight = 494 + ClientWidth = 470 OnCloseQuery = FormCloseQuery OnCreate = FormCreate Position = poMainFormCenter - LCLVersion = '1.3' + LCLVersion = '1.2.6.0' object PageControl: TPageControl Left = 8 - Height = 420 + Height = 434 Top = 8 - Width = 401 - ActivePage = PgDateTime + Width = 454 + ActivePage = PgCurrency Align = alClient BorderSpacing.Around = 8 - TabIndex = 2 + TabIndex = 1 TabOrder = 0 OnChange = PageControlChange object PgNumber: TTabSheet Caption = 'Number' - ClientHeight = 392 - ClientWidth = 393 + ClientHeight = 401 + ClientWidth = 446 object LblDecimalSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 19 - Width = 98 + Width = 125 Caption = 'Decimal separator:' ParentColor = False end object LblThousandSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 51 - Width = 108 + Width = 134 Caption = 'Thousand separator:' ParentColor = False end object Label1: TLabel Left = 4 - Height = 15 - Top = 373 - Width = 385 + Height = 20 + Top = 377 + Width = 438 Align = alBottom BorderSpacing.Around = 4 Caption = 'The current workbook is automatically updated to these settings.' @@ -56,45 +56,46 @@ object FormatSettingsForm: TFormatSettingsForm object Bevel3: TBevel Left = 0 Height = 3 - Top = 366 - Width = 393 + Top = 370 + Width = 446 Align = alBottom Shape = bsBottomLine end end object PgCurrency: TTabSheet Caption = 'Currency' - ClientHeight = 392 - ClientWidth = 393 + ClientHeight = 401 + ClientWidth = 446 object LblCurrencySymbol: TLabel Left = 16 - Height = 15 + Height = 20 Top = 20 - Width = 93 + Width = 112 Caption = 'Currency symbol:' FocusControl = EdCurrencySymbol ParentColor = False end object EdCurrencySymbol: TEdit Left = 200 - Height = 23 + Height = 28 Top = 16 - Width = 178 + Width = 231 + Anchors = [akTop, akLeft, akRight] OnChange = EdCurrencySymbolChange TabOrder = 0 end object LblCurrencySymbol1: TLabel Left = 16 - Height = 15 + Height = 20 Top = 52 - Width = 132 + Width = 163 Caption = 'Currency decimal places:' FocusControl = EdCurrencyDecimals ParentColor = False end object EdCurrencyDecimals: TSpinEdit Left = 200 - Height = 23 + Height = 28 Top = 48 Width = 66 Alignment = taRightJustify @@ -102,45 +103,47 @@ object FormatSettingsForm: TFormatSettingsForm end object LblPosCurrencyFormat: TLabel Left = 16 - Height = 15 + Height = 20 Top = 84 - Width = 135 + Width = 169 Caption = 'Format of positive values:' FocusControl = CbPosCurrencyFormat ParentColor = False end object CbPosCurrencyFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 80 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 Style = csDropDownList TabOrder = 2 end object LblNegCurrencyFormat: TLabel Left = 16 - Height = 15 + Height = 20 Top = 116 - Width = 139 + Width = 174 Caption = 'Format of negative values:' FocusControl = CbNegCurrencyFormat ParentColor = False end object CbNegCurrencyFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 112 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 Style = csDropDownList TabOrder = 3 end object Label2: TLabel Left = 4 - Height = 15 - Top = 373 - Width = 385 + Height = 20 + Top = 377 + Width = 438 Align = alBottom BorderSpacing.Around = 4 Caption = 'These settings are only respected in new cells.' @@ -150,30 +153,31 @@ object FormatSettingsForm: TFormatSettingsForm object Bevel2: TBevel Left = 0 Height = 3 - Top = 366 - Width = 393 + Top = 370 + Width = 446 Align = alBottom Shape = bsBottomLine end end object PgDateTime: TTabSheet Caption = 'Date/time' - ClientHeight = 392 - ClientWidth = 393 + ClientHeight = 401 + ClientWidth = 446 object LblNumFormat1: TLabel Left = 16 - Height = 15 + Height = 20 Top = 20 - Width = 128 + Width = 160 Caption = 'Long date format string:' ParentColor = False end object CbLongDateFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 16 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'ddd, d/mm/yyyy' @@ -198,18 +202,19 @@ object FormatSettingsForm: TFormatSettingsForm end object LblNumFormat2: TLabel Left = 16 - Height = 15 + Height = 20 Top = 52 - Width = 129 + Width = 162 Caption = 'Short date format string:' ParentColor = False end object CbShortDateFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 48 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 ItemIndex = 0 Items.Strings = ( 'd/m/yy' @@ -229,74 +234,75 @@ object FormatSettingsForm: TFormatSettingsForm end object LblDateSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 83 - Width = 79 + Width = 102 Caption = 'Date separator:' ParentColor = False end object LblLongMonthNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 116 - Width = 107 + Width = 130 Caption = 'Long month names:' ParentColor = False end object LblShortMonthNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 148 - Width = 108 + Width = 132 Caption = 'Short month names:' ParentColor = False end object LblLongDayNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 180 - Width = 90 + Width = 111 Caption = 'Long day names:' ParentColor = False end object LblShortDayNames: TLabel Left = 16 - Height = 15 + Height = 20 Top = 212 - Width = 91 + Width = 113 Caption = 'Short day names:' ParentColor = False end object LblNumFormat3: TLabel Left = 16 - Height = 15 + Height = 20 Top = 252 - Width = 129 + Width = 160 Caption = 'Long time format string:' ParentColor = False end object LblNumFormat4: TLabel Left = 16 - Height = 15 + Height = 20 Top = 284 - Width = 130 + Width = 162 Caption = 'Short time format string:' ParentColor = False end object LblTimeSeparator: TLabel Left = 16 - Height = 15 + Height = 20 Top = 315 - Width = 82 + Width = 103 Caption = 'Time separator:' ParentColor = False end object CbLongTimeFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 248 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 ItemIndex = 1 Items.Strings = ( 'h:n:s' @@ -310,10 +316,11 @@ object FormatSettingsForm: TFormatSettingsForm end object CbShortTimeFormat: TComboBox Left = 200 - Height = 23 + Height = 28 Top = 280 - Width = 178 - ItemHeight = 15 + Width = 231 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 20 ItemIndex = 1 Items.Strings = ( 'h:n' @@ -327,9 +334,9 @@ object FormatSettingsForm: TFormatSettingsForm end object Label3: TLabel Left = 4 - Height = 30 - Top = 358 - Width = 385 + Height = 40 + Top = 357 + Width = 438 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.' @@ -339,8 +346,8 @@ object FormatSettingsForm: TFormatSettingsForm object Bevel1: TBevel Left = 0 Height = 3 - Top = 351 - Width = 393 + Top = 350 + Width = 446 Align = alBottom Shape = bsBottomLine end @@ -348,9 +355,9 @@ object FormatSettingsForm: TFormatSettingsForm end object ButtonPanel: TButtonPanel Left = 6 - Height = 34 - Top = 436 - Width = 405 + Height = 38 + Top = 450 + Width = 458 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True OKButton.OnClick = OKButtonClick @@ -366,7 +373,7 @@ object FormatSettingsForm: TFormatSettingsForm Left = 6 Height = 36 Top = 2 - Width = 234 + Width = 287 Anchors = [akTop, akLeft, akRight] AutoSize = False Caption = 'sample' diff --git a/components/fpspreadsheet/examples/spready/sformatsettingsform.pas b/components/fpspreadsheet/examples/spready/sformatsettingsform.pas index b8265289c..fb158f025 100644 --- a/components/fpspreadsheet/examples/spready/sformatsettingsform.pas +++ b/components/fpspreadsheet/examples/spready/sformatsettingsform.pas @@ -97,8 +97,6 @@ var fs: TFormatSettings; ctrl: TWinControl; dt: TDateTime; - arr: Array[1..12] of String; - i: Integer; s: String; begin fs := GetFormatSettings; @@ -175,6 +173,8 @@ end; procedure TFormatSettingsForm.FormCreate(Sender: TObject); const DROPDOWN_COUNT = 32; +var + w: Integer; begin PageControl.ActivePageIndex := PageIndex; @@ -185,13 +185,15 @@ begin CbPosCurrencyFormat.DropdownCount := DROPDOWN_COUNT; CbNegCurrencyFormat.DropdownCount := DROPDOWN_COUNT; + w := CbLongDateFormat.Width; FCbDecimalSeparator := TFormatSeparatorCombo.Create(self); with FCbDecimalSeparator do begin Parent := PgNumber; Left := CbLongDateFormat.Left; - Width := CbLongDateFormat.Width; + Width := w; Top := CbLongDateFormat.Top; + Anchors := Anchors + [akRight]; TabOrder := 0; SeparatorKind := skDecimal; end; @@ -202,8 +204,9 @@ begin begin Parent := PgNumber; Left := FCbDecimalSeparator.Left; - Width := FCbDecimalSeparator.Width; + Width := w; Top := FCBDecimalSeparator.Top + 32; + Anchors := Anchors + [akRight]; TabOrder := FCbDecimalSeparator.TabOrder + 1; SeparatorKind := skThousand; end; @@ -214,7 +217,7 @@ begin begin Parent := PgDateTime; Left := CbShortDateFormat.Left; - Width := CbShortDateFormat.Width; + Width := w; Top := CbShortDateFormat.Top + 32; TabOrder := CbShortDateFormat.TabOrder + 1; SeparatorKind := skDate; @@ -228,7 +231,11 @@ begin begin Parent := PgDateTime; Left := CbShortDateFormat.Left; - Width := CbShortDateFormat.Width; + {$IFDEF LCL_FULLVERSION AND LCL_FULLVERSION > 1020600} + Width := w; + {$ELSE} + Width := w - Button.Width; + {$ENDIF} Top := CbShortDateFormat.Top + 32*2; OnChange := @DateTimeFormatChange; OnEnter := @DateTimeFormatChange; @@ -241,7 +248,7 @@ begin begin Parent := PgDateTime; Left := CbShortDateFormat.Left; - Width := CbShortdateFormat.Width; + Width := FEdLongMonthNames.Width; Top := CbShortDateFormat.Top + 32*3; TabOrder := CbShortDateFormat.TabOrder + 3; OnChange := @DateTimeFormatChange; @@ -254,7 +261,7 @@ begin begin Parent := PgDateTime; Left := CbShortDateformat.Left; - Width := CbShortDateFormat.Width; + Width := FEdLongMonthNames.Width; Top := CbShortDateFormat.Top + 32*4; TabOrder := CbShortDateFormat.TabOrder + 4; OnChange := @DateTimeFormatChange; @@ -267,7 +274,7 @@ begin begin Parent := PgDateTime; Left := CbShortDateFormat.Left; - Width := CbShortDateFormat.Width; + Width := FEdLongMonthNames.Width; Top := CbShortDateFormat.Top + 32*5; TabOrder := CbShortDateFormat.TabOrder + 5; OnChange := @DateTimeFormatChange; @@ -280,7 +287,7 @@ begin begin Parent := PgDateTime; Left := CbShortTimeFormat.Left; - Width := CbShortTimeFormat.Width; + Width := w; Top := CbShortTimeFormat.Top + 32; TabOrder := CbShortTimeFormat.TabOrder + 1; SeparatorKind := skTime; diff --git a/components/fpspreadsheet/examples/spready/spready.lpi b/components/fpspreadsheet/examples/spready/spready.lpi index e16146a05..dbb3b2a44 100644 --- a/components/fpspreadsheet/examples/spready/spready.lpi +++ b/components/fpspreadsheet/examples/spready/spready.lpi @@ -35,6 +35,9 @@ + + + @@ -70,6 +73,9 @@ + + + @@ -146,6 +152,9 @@ + + + diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 4a1f57bac..2ff01c728 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -80,7 +80,7 @@ var AutoDetectNumberFormat: true; TrueText: 'TRUE'; FalseText: 'FALSE'; - ); + {%H-}); implementation @@ -216,7 +216,7 @@ begin // 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 = '', + ACurrencySymbol := StrUtils.IfThen(CSVParams.FormatSettings.CurrencyString = '', FWorkbook.FormatSettings.CurrencyString, CSVParams.FormatSettings.CurrencyString); p := pos(ACurrencySymbol, AText); @@ -444,7 +444,7 @@ end; procedure TsCSVWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); begin - Unused(ARow, ACol); + Unused(ARow, ACol, AValue); AppendToStream(AStream, FWorksheet.ReadAsUTF8Text(ACell)); end; @@ -471,7 +471,7 @@ procedure TsCSVWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; var s: String; begin - Unused(ARow, ACol); + Unused(ARow, ACol, AValue); if ACell = nil then exit; s := ACell^.UTF8StringValue; @@ -484,7 +484,6 @@ procedure TsCSVWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); var s: String; - mask: String; begin Unused(ARow, ACol); if ACell = nil then diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 6a36ae134..5348c8bfa 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -876,7 +876,6 @@ resourcestring SErrDuplicateIdentifier = 'An identifier with name "%s" already exists.'; SErrInvalidResultCharacter = '"%s" is not a valid return type indicator'; ErrInvalidArgumentCount = 'Invalid argument count for function %s'; - SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s'; SErrInvalidResultType = 'Invalid result type: %s'; SErrNotVariable = 'Identifier %s is not a variable'; SErrCircularReference = 'Circular reference found when calculating worksheet formulas'; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index f86f32762..e592dc0b9 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -1423,6 +1423,7 @@ end; procedure TsSpreadOpenDocReader.ReadFromStream(AStream: TStream; AData: TsWorkbook); begin + Unused(AStream, AData); raise Exception.Create('[TsSpreadOpenDocReader.ReadFromStream] '+ 'Method not implemented. Use "ReadFromFile" instead.'); end; @@ -3411,6 +3412,9 @@ end; procedure TsSpreadOpenDocWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); begin + Unused(AStream); + Unused(ARow, ACol); + Unused(AValue, ACell); // ?? end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 58237ca0d..f901b5a3b 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -875,9 +875,9 @@ type { Worksheet list handling methods } function AddWorksheet(AName: string; AcceptEmptyName: boolean = false): TsWorksheet; function GetFirstWorksheet: TsWorksheet; - function GetWorksheetByIndex(AIndex: Cardinal): TsWorksheet; + function GetWorksheetByIndex(AIndex: Integer): TsWorksheet; function GetWorksheetByName(AName: String): TsWorksheet; - function GetWorksheetCount: Cardinal; + function GetWorksheetCount: Integer; procedure RemoveAllWorksheets; function ValidWorksheetName(AName: String; AcceptEmptyName: Boolean = false): Boolean; @@ -6039,7 +6039,7 @@ end; @see TsWorkbook.GetWorksheetByName @see TsWorksheet -------------------------------------------------------------------------------} -function TsWorkbook.GetWorksheetByIndex(AIndex: Cardinal): TsWorksheet; +function TsWorkbook.GetWorksheetByIndex(AIndex: Integer): TsWorksheet; begin if (integer(AIndex) < FWorksheets.Count) and (integer(AIndex)>=0) then Result := TsWorksheet(FWorksheets.Items[AIndex]) @@ -6079,7 +6079,7 @@ end; @see TsWorksheet -------------------------------------------------------------------------------} -function TsWorkbook.GetWorksheetCount: Cardinal; +function TsWorkbook.GetWorksheetCount: Integer; begin Result := FWorksheets.Count; end; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 92be0beda..ad204421b 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -3039,8 +3039,6 @@ end; -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var - R: TRect; - tmp: Integer; prevMouseCell: TPoint; begin prevMouseCell := GCache.MouseCell; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index a18469786..daed6f791 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -917,7 +917,6 @@ procedure BuildCurrencyFormatList(AList: TStrings; var valueStr: String; i: Integer; - sel: Integer; begin valueStr := Format('%.0n', [AValue]); AList.BeginUpdate; @@ -1484,10 +1483,9 @@ end; function TryStrToFloatAuto(AText: String; out ANumber: Double; out AWarning: String): Boolean; var - i, j: Integer; + i: Integer; testSep: Char; testSepPos: Integer; - decsep: Char; isPercent: Boolean; fs: TFormatSettings; done: Boolean; diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index ea1b655ac..ee17b31c3 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -120,7 +120,7 @@ type procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); override; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; - const AValue: TsErrorValue; ACell: PCell); + const AValue: TsErrorValue; ACell: PCell); override; procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData; AListIndex: Integer); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 3df5283fd..ec32b3dca 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -1508,6 +1508,7 @@ end; procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream; AData: TsWorkbook); begin + Unused(AStream, AData); raise Exception.Create('[TsSpreadOOXMLReader.ReadFromStream] '+ 'Method not implemented. Use "ReadFromFile" instead.'); end; @@ -2569,7 +2570,9 @@ end; procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); begin - // ??? + Unused(AStream); + Unused(ARow, ACol); + Unused(AValue, ACell); end; { Writes a string formula to the given cell. }