paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 16:58:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Many improvements for TCoolBar. Issue #25026, patch from Vojtech Cihak

Browse Source 
git-svn-id: trunk@44812 -
This commit is contained in:
juha 2014-04-26 14:36:29 +00:00
parent c45bd45cd7
commit 36d8715662
2 changed files with 858 additions and 555 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
lcl/comctrls.pp
View File

@ -2215,81 +2215,89 @@ type
property OnStartDrag; property OnStartDrag;
end; end;
{ TCoolBar } { TCoolBar }
TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton);
TDragBand = (dbNone, dbMove, dbResize);
TCustomCoolBar = class; TCustomCoolBar = class;
{ TCoolBand }
TCoolBand = class(TCollectionItem) TCoolBand = class(TCollectionItem)
private private
FCoolBar: TCustomCoolBar; FCoolBar: TCustomCoolBar;
FControl: TControl; // Associated control FControl: TControl; // Associated control
FTextLabel: TLabel; // Possible text is shown in a Label FBitmap: TBitmap;
FBorderStyle: TBorderStyle; FBorderStyle: TBorderStyle;
FBreak: Boolean; FBreak: Boolean;
FColor: TColor;
FFixedBackground: Boolean;
FFixedSize: Boolean; FFixedSize: Boolean;
FVisible: Boolean; FHeight: Integer;
FHorizontalOnly: Boolean; FHorizontalOnly: Boolean;
FImageIndex: TImageIndex; FImageIndex: TImageIndex;
FFixedBackground: Boolean;
FMinHeight: Integer; FMinHeight: Integer;
FMinWidth: Integer; FMinWidth: Integer;
FColor: TColor;
FParentColor: Boolean;
FParentBitmap: Boolean; FParentBitmap: Boolean;
FBitmap: TBitmap; FParentColor: Boolean;
FText: TTranslateString;
FVisible: Boolean;
FWidth: Integer;
FLeft: Integer;
FTop: Integer; FTop: Integer;
fCreatingTextLabel: Boolean; FRealWidth: Integer;
function GetText: string;
function GetWidth: Integer;
function IsBitmapStored: Boolean; function IsBitmapStored: Boolean;
function IsColorStored: Boolean; function IsColorStored: Boolean;
function GetHeight: Integer;
function GetVisible: Boolean; function GetVisible: Boolean;
procedure SetBorderStyle(aValue: TBorderStyle); procedure SetBitmap(AValue: TBitmap);
procedure SetBreak(aValue: Boolean); procedure SetBorderStyle(AValue: TBorderStyle);
procedure SetFixedSize(aValue: Boolean); procedure SetBreak(AValue: Boolean);
procedure SetMinHeight(aValue: Integer); procedure SetColor(AValue: TColor);
procedure SetMinWidth(aValue: Integer); procedure SetControl(AValue: TControl);
procedure SetVisible(aValue: Boolean); procedure SetFixedBackground(AValue: Boolean);
procedure SetHorizontalOnly(aValue: Boolean); procedure SetHorizontalOnly(AValue: Boolean);
procedure SetImageIndex(aValue: TImageIndex); procedure SetImageIndex(AValue: TImageIndex);
procedure SetFixedBackground(aValue: Boolean); procedure SetMinHeight(AValue: Integer);
procedure SetColor(aValue: TColor); procedure SetMinWidth(AValue: Integer);
procedure SetControlWidth; procedure SetParentBitmap(AValue: Boolean);
procedure ResetControlProps; procedure SetParentColor(AValue: Boolean);
procedure UpdControl(aLabelWidth: integer); procedure SetText(const AValue: TTranslateString);
procedure SetControl(aValue: TControl); procedure SetVisible(AValue: Boolean);
procedure SetParentColor(aValue: Boolean); procedure SetWidth(AValue: Integer);
procedure SetParentBitmap(aValue: Boolean); protected const
procedure SetBitmap(aValue: TBitmap); cDefMinHeight = 25;
procedure SetText(const aValue: string); cDefMinWidth = 100;
procedure SetWidth(aValue: Integer); cDefWidth = 180;
cHorSpacing = 7;
cVertSpacing = 3;
protected protected
function CalcPreferredHeight: Integer;
function CalcPrefferedWidth: Integer;
function GetDisplayName: string; override; function GetDisplayName: string; override;
procedure SetIndex(aValue: Integer); override;
public public
constructor Create(aCollection: TCollection); override; constructor Create(aCollection: TCollection); override;
destructor Destroy; override; destructor Destroy; override;
procedure InvalidateCoolBar(Sender: TObject);
procedure Assign(aSource: TPersistent); override; procedure Assign(aSource: TPersistent); override;
property Height: Integer read GetHeight; property Height: Integer read FHeight;
published published
property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored; property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
property Break: Boolean read FBreak write SetBreak default True; property Break: Boolean read FBreak write SetBreak default True;
property Color: TColor read FColor write SetColor stored IsColorStored default clBtnFace; property Color: TColor read FColor write SetColor stored IsColorStored default clDefault;
property Control: TControl read FControl write SetControl; property Control: TControl read FControl write SetControl;
property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True; property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True;
property FixedSize: Boolean read FFixedSize write SetFixedSize default False; property FixedSize: Boolean read FFixedSize write FFixedSize default False;
property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False; property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
property MinHeight: Integer read FMinHeight write SetMinHeight default 25; property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight;
property MinWidth: Integer read FMinWidth write SetMinWidth default 0; property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth;
property ParentColor: Boolean read FParentColor write SetParentColor default True; property ParentColor: Boolean read FParentColor write SetParentColor default True;
property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True; property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True;
property Text: string read GetText write SetText; property Text: TTranslateString read FText write SetText;
property Visible: Boolean read GetVisible write SetVisible default True; property Visible: Boolean read GetVisible write SetVisible default True;
property Width: Integer read GetWidth write SetWidth; property Width: Integer read FWidth write SetWidth default cDefWidth;
end; end;
{ TCoolBands } { TCoolBands }
@ -2297,22 +2305,19 @@ type
TCoolBands = class(TCollection) TCoolBands = class(TCollection)
private private
FCoolBar: TCustomCoolBar; FCoolBar: TCustomCoolBar;
FVisibleCount: Longword;
function GetItem(Index: Integer): TCoolBand; function GetItem(Index: Integer): TCoolBand;
procedure SetItem(Index: Integer; aValue: TCoolBand); procedure SetItem(Index: Integer; aValue: TCoolBand);
procedure CalcPreferredSize(aAlsoUpdate: Boolean; var aPrefWidth, aPrefHeight: integer);
protected protected
function GetOwner: TPersistent; override; function GetOwner: TPersistent; override;
procedure Update(aItem: TCollectionItem); override; procedure Update(aItem: TCollectionItem); override;
procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override; procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override;
public public
constructor Create(aCoolBar: TCustomCoolBar); constructor Create(ACoolBar: TCustomCoolBar);
function Add: TCoolBand; function Add: TCoolBand;
function FindBand(aControl: TControl): TCoolBand; function FindBand(AControl: TControl): TCoolBand;
property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default; property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default;
end; end;
// BandMaximize is not used now but is needed for Delphi compatibility. // BandMaximize is not used now but is needed for Delphi compatibility.
// It is not used in Delphi's TCoolBar either. // It is not used in Delphi's TCoolBar either.
TCoolBandMaximize = (bmNone, bmClick, bmDblClick); TCoolBandMaximize = (bmNone, bmClick, bmDblClick);
@ -2327,44 +2332,73 @@ type
FBitmap: TBitmap; FBitmap: TBitmap;
FFixedSize: Boolean; FFixedSize: Boolean;
FFixedOrder: Boolean; FFixedOrder: Boolean;
FGrabStyle: TGrabStyle;
FGrabWidth: Integer;
FImages: TCustomImageList; FImages: TCustomImageList;
FImageChangeLink: TChangeLink; FImageChangeLink: TChangeLink;
FShowText: Boolean; FShowText: Boolean;
FVertical: Boolean; FVertical: Boolean;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
function GrabLeft: integer;
function GetAlign: TAlign; function GetAlign: TAlign;
procedure SetAlign(aValue: TAlign); reintroduce; procedure SetBandBorderStyle(AValue: TBorderStyle);
procedure SetBands(aValue: TCoolBands); procedure SetBands(AValue: TCoolBands);
procedure SetBitmap(aValue: TBitmap); procedure SetBitmap(aValue: TBitmap);
procedure SetImages(aValue: TCustomImageList); procedure SetGrabStyle(AValue: TGrabStyle);
procedure SetShowText(aValue: Boolean); procedure SetGrabWidth(AValue: Integer);
procedure SetImages(AValue: TCustomImageList);
procedure SetShowText(AValue: Boolean);
procedure SetVertical(aValue: Boolean); procedure SetVertical(aValue: Boolean);
procedure ImageListChange(Sender: TObject); protected const
cBorderWidth = 2;
cDefGrabStyle = gsDouble;
cDefGrabWidth = 10;
protected protected
procedure AlignControls(aControl: TControl; var aRect: TRect); override; FVisiBands: array of TCoolBand;
FDefCursor: TCursor;
FDragBand: TDragBand;
FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area
FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands)
FPrevHeight: Integer;
FPrevWidth: Integer;
FTextHeight: Integer;
procedure BitmapOrImageListChange(Sender: TObject);
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override; {%H-}WithThemeSpace: Boolean); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure CalculateAndAlign;
function CalculateRealIndex(AVisibleIndex: Integer): Integer;
procedure DoFontChanged;
procedure CreateWnd; override;
procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap);
procedure FontChanged(Sender: TObject); override;
function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean;
procedure Loaded; override; procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override; procedure Paint; override;
procedure Resize; override; procedure Resize; override;
procedure SetAlign(aValue: TAlign); reintroduce;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure BeginUpdate; override;
procedure EndUpdate; override; procedure EndUpdate; override;
procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean);
procedure InsertControl(AControl: TControl; Index: integer); override; procedure InsertControl(AControl: TControl; Index: integer); override;
procedure RemoveControl(AControl: TControl); override; procedure RemoveControl(AControl: TControl); override;
public public
property Align read GetAlign write SetAlign default alTop; property Align read GetAlign write SetAlign default alTop;
property BandBorderStyle: TBorderStyle read FBandBorderStyle write FBandBorderStyle default bsSingle; property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle;
property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick; property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick;
property Bands: TCoolBands read FBands write SetBands; property Bands: TCoolBands read FBands write SetBands;
property Bitmap: TBitmap read FBitmap write SetBitmap;
property FixedSize: Boolean read FFixedSize write FFixedSize default False; property FixedSize: Boolean read FFixedSize write FFixedSize default False;
property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False; property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False;
property GrabStyle: TGrabStyle read FGrabStyle write SetGrabStyle default cDefGrabStyle;
property GrabWidth: Integer read FGrabWidth write SetGrabWidth default cDefGrabWidth;
property Images: TCustomImageList read FImages write SetImages; property Images: TCustomImageList read FImages write SetImages;
property Bitmap: TBitmap read FBitmap write SetBitmap;
property ShowText: Boolean read FShowText write SetShowText default True; property ShowText: Boolean read FShowText write SetShowText default True;
property Vertical: Boolean read FVertical write SetVertical default False; property Vertical: Boolean read FVertical write SetVertical default False;
property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChange: TNotifyEvent read FOnChange write FOnChange;
@ -2395,6 +2429,8 @@ type
property FixedSize; property FixedSize;
property FixedOrder; property FixedOrder;
property Font; property Font;
property GrabStyle;
property GrabWidth;
property Images; property Images;
property ParentColor; property ParentColor;
property ParentFont; property ParentFont;

1257
lcl/include/coolbar.inc
View File

File diff suppressed because it is too large Load Diff