pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Less hints. Adapt spready code to differences between trunk and Laz 1.2.6, remove duplicate colorbox unit in spready.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3667 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-20 09:22:06 +00:00
parent ea812a803e
commit 7b3795dc03
17 changed files with 252 additions and 1252 deletions
Download Patch File Download Diff File Expand all files Collapse all files

986
components/fpspreadsheet/examples/spready/colorbox.pas
View File

@ -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.

67
components/fpspreadsheet/examples/spready/mainform.lfm
View File

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

1
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -171,7 +171,6 @@ type
MenuItem74: TMenuItem;
MenuItem75: TMenuItem;
MenuItem76: TMenuItem;
MenuItem77: TMenuItem;
MnuCSVParams: TMenuItem;
MnuSettings: TMenuItem;
mnuInspector: TMenuItem;

140
components/fpspreadsheet/examples/spready/scsvparamsform.lfm
View File

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

50
components/fpspreadsheet/examples/spready/scsvparamsform.pas
View File

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

8
components/fpspreadsheet/examples/spready/sctrls.pas
View File

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

181
components/fpspreadsheet/examples/spready/sformatsettingsform.lfm
View File

@ -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'

27
components/fpspreadsheet/examples/spready/sformatsettingsform.pas
View File

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

9
components/fpspreadsheet/examples/spready/spready.lpi
View File

@ -35,6 +35,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
@ -70,6 +73,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item3>
</BuildModes>
@ -146,6 +152,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">

9
components/fpspreadsheet/fpscsv.pas
View File

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

1
components/fpspreadsheet/fpsexprparser.pas
View File

@ -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';

4
components/fpspreadsheet/fpsopendocument.pas
View File

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

8
components/fpspreadsheet/fpspreadsheet.pas
View File

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

2
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -3039,8 +3039,6 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
R: TRect;
tmp: Integer;
prevMouseCell: TPoint;
begin
prevMouseCell := GCache.MouseCell;

4
components/fpspreadsheet/fpsutils.pas
View File

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

2
components/fpspreadsheet/xlsbiff2.pas
View File

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

5
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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. }