mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-28 09:03:50 +02:00
b8b3de002a
This commit is also not completely Delphi compatible. In Delphi Items can be added or delted as a respons to LVN_xxx messages, which the Lazarus implementation does not support (it may very well be not protable?). This commit causes code duplication (fortunately mostly one-liners) The resons for this that the Lazarus methods DoDeletion, DoInsert and DoEndEdit are virtual and as such may have been overriden by users, so this code still needs to work. Users with code coming from Delphi expect that they can override Delete, InsertItem and Edit, so this must be possible as well, and in that case out event dispatchers simply call the overridden Delphi variant. The exception to this is Delete(). As far as we know, in Delphi Delete() is triggerd after an Items.Delete and acts as an event dispatcher, but if you call it by itself, then it will actually delete the item (this in contrast to InsertItem, which only calls the event handler and does nothing else). (No Delphi code was studied to obtain this information, it was all done using black box testing (by LacaK and BB), so this conclusion may be wrong.) I decided to implement Delete in such a way that it checks wether it was called after the fact (after Items.Delete), and if that is not the case, it will delete the item (triggering a re-entry of the method). Not very nice, but it is in any case better then an empy implementation like it was before r64309 #fbb46cb85d. It was discussed also to rename and deprecate our event dispatchers in favour of the Delpi ones, but I decided agains that for the following reasons: - naming conventions: DoXXX dispatches OnXXX - signatures differ between DoEndEdit and Edit git-svn-id: trunk@64318 -
4229 lines
166 KiB
ObjectPascal
4229 lines
166 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
ComCtrls.pp
|
|
-----------
|
|
Component Library Common Controls
|
|
Initial Revision : Sat Apr 10 22:49:32 CST 1999
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
*****************************************************************************
|
|
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.
|
|
*****************************************************************************
|
|
}
|
|
{
|
|
@abstract(Just a try to provide the same objects as the Delphi comctrls unit)
|
|
@author(TCustomProgressBar - Stefan Hille <stoppok@osibisa.ms.sub.org>)
|
|
@author(TTrackBar - Stefan Hille <stoppok@osibisa.ms.sub.org>)
|
|
@created(1999)
|
|
}
|
|
unit ComCtrls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$I lcl_defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Types, Classes, Math, Laz_AVL_Tree,
|
|
// LCL
|
|
LCLStrConsts, LResources, LCLIntf, LCLType, LCLProc, LMessages, WSLCLClasses,
|
|
WSReferences, Graphics, ImgList, ActnList, Themes, Menus,
|
|
Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons,
|
|
// LazUtils
|
|
GraphType, LazUTF8, LazUTF8Classes, LazLoggerBase, LazUtilities;
|
|
|
|
type
|
|
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
|
|
htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
|
|
THitTests = set of THitTest;
|
|
|
|
TStatusPanelStyle = (psText, psOwnerDraw);
|
|
TStatusPanelBevel = (pbNone, pbLowered, pbRaised);
|
|
|
|
TStatusBar = class; //forward declaration
|
|
|
|
TPanelPart = (
|
|
ppText, // for text and text alignment
|
|
ppBorder, // for bevel and style
|
|
ppWidth // for width
|
|
);
|
|
TPanelParts = set of TPanelPart;
|
|
|
|
{ TStatusPanel }
|
|
|
|
//added.
|
|
TStatusPanelClass = class of TStatusPanel;
|
|
|
|
TStatusPanel = class(TCollectionItem)
|
|
private
|
|
FBidiMode: TBiDiMode;
|
|
FText: TCaption;
|
|
FWidth: Integer;
|
|
FAlignment: TAlignment;
|
|
FBevel: TStatusPanelBevel;
|
|
FParentBiDiMode: Boolean;
|
|
FStyle: TStatusPanelStyle;
|
|
procedure SetAlignment(Value: TAlignment);
|
|
procedure SetBevel(Value: TStatusPanelBevel);
|
|
procedure SetStyle(Value: TStatusPanelStyle);
|
|
procedure SetText(const Value: TCaption);
|
|
procedure SetWidth(Value: Integer);
|
|
protected
|
|
// field to use by interface. do not use it in the LCL
|
|
FIntfFlag: Integer;
|
|
function GetDisplayName: string; override;
|
|
procedure PanelChanged(const Parts: TPanelParts);
|
|
procedure SetIndex(Value: Integer); override;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function StatusBar: TStatusBar;
|
|
published
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
|
|
property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered;
|
|
property BidiMode: TBiDiMode read FBidiMode write FBidiMode default bdLeftToRight;
|
|
property ParentBiDiMode: Boolean read FParentBiDiMode write FParentBiDiMode default True;
|
|
property Style: TStatusPanelStyle read FStyle write SetStyle default psText;
|
|
property Text: TCaption read FText write SetText;
|
|
property Width: Integer read FWidth write SetWidth;
|
|
end;
|
|
|
|
TStatusPanels = class(TCollection)
|
|
private
|
|
FStatusBar: TStatusBar;
|
|
function GetItem(Index: Integer): TStatusPanel;
|
|
procedure SetItem(Index: Integer; Value: TStatusPanel);
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(AStatusBar: TStatusBar);
|
|
function Add: TStatusPanel;
|
|
property Items[Index: Integer]: TStatusPanel read GetItem write SetItem; default;
|
|
property StatusBar: TStatusBar read FStatusBar;
|
|
end;
|
|
|
|
TSBCreatePanelClassEvent = procedure(Sender: TStatusBar;
|
|
var PanelClass: TStatusPanelClass) of object;
|
|
|
|
TDrawPanelEvent = procedure(StatusBar: TStatusBar; Panel: TStatusPanel;
|
|
const Rect: TRect) of object;
|
|
|
|
{ TStatusBar }
|
|
|
|
TStatusBar = class(TWinControl)
|
|
private
|
|
FAutoHint: Boolean;
|
|
FCanvas: TCanvas;
|
|
FHandlePanelCount: integer; // realized panels in the Handle object
|
|
FHandleObjectNeedsUpdate: boolean;
|
|
FHandleUpdatePanelIndex: integer; // which panel in the handle object needs update
|
|
FOnCreatePanelClass: TSBCreatePanelClassEvent;
|
|
FSizeGrip: Boolean;
|
|
FUpdateLock: integer; // set by BeginUpdate/EndUpdate
|
|
FPanels: TStatusPanels;
|
|
FSimpleText: TCaption;
|
|
FSimplePanel: Boolean;
|
|
FOnDrawPanel: TDrawPanelEvent;
|
|
FOnHint: TNotifyEvent;
|
|
FUseSystemFont: Boolean;
|
|
procedure SetPanels(Value: TStatusPanels);
|
|
procedure SetSimpleText(const Value : TCaption);
|
|
procedure SetSimplePanel(Value : Boolean);
|
|
procedure SetSizeGrip(const AValue: Boolean);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure BoundsChanged; override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
procedure Loaded; override;
|
|
procedure UpdateHandleObject(PanelIndex: integer; PanelParts: TPanelParts); virtual;
|
|
procedure CalculatePreferredSize(
|
|
var PreferredWidth, PreferredHeight: integer;
|
|
WithThemeSpace: Boolean); override;
|
|
procedure SetBiDiMode(AValue: TBiDiMode); override;
|
|
|
|
//added.
|
|
function CreatePanel: TStatusPanel; virtual;
|
|
function CreatePanels: TStatusPanels; virtual;
|
|
function GetPanelClass: TStatusPanelClass; virtual;
|
|
|
|
function DoSetApplicationHint(AHintStr: String): Boolean; virtual;
|
|
function DoHint: Boolean; virtual;
|
|
procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); virtual;
|
|
procedure LMDrawItem(var Message: TLMDrawItems); message LM_DRAWITEM;
|
|
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure InvalidatePanel(PanelIndex: integer; PanelParts: TPanelParts); virtual;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function ExecuteAction(ExeAction: TBasicAction): Boolean; override;
|
|
function GetPanelIndexAt(X, Y: Integer): Integer;
|
|
function SizeGripEnabled: Boolean;
|
|
function UpdatingStatusBar: boolean;
|
|
property Canvas: TCanvas read FCanvas;
|
|
published
|
|
property Action;
|
|
property Align default alBottom;
|
|
property Anchors;
|
|
property AutoHint: Boolean read FAutoHint write FAutoHint default false;
|
|
property AutoSize default true;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property BorderWidth;
|
|
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Panels: TStatusPanels read FPanels write SetPanels;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property SimpleText: TCaption read FSimpleText write SetSimpleText;
|
|
property SimplePanel: Boolean read FSimplePanel write SetSimplePanel default True;
|
|
property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
|
|
property ShowHint;
|
|
property UseSystemFont: Boolean read FUseSystemFont write FUseSystemFont default True;
|
|
property Visible default true;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnCreatePanelClass: TSBCreatePanelClassEvent read FOnCreatePanelClass write FOnCreatePanelClass;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawPanel: TDrawPanelEvent read FOnDrawPanel write FOnDrawPanel;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnHint: TNotifyEvent read FOnHint write FOnHint;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
{ TCustomPage }
|
|
|
|
TPageFlag = (
|
|
pfAdded, // handle of page added to notebook handle
|
|
pfAdding, // currently handle of page adding to notebook handle
|
|
pfRemoving, // currently removing page handle from notebook handle
|
|
pfInserting // currently inserting page into notebook
|
|
);
|
|
TPageFlags = set of TPageFlag;
|
|
|
|
TCustomPage = class(TWinControl)
|
|
private
|
|
FTabVisible: Boolean;
|
|
FFlags: TPageFlags;
|
|
FImageIndex: TImageIndex;
|
|
FOnHide: TNotifyEvent;
|
|
FOnShow: TNotifyEvent;
|
|
procedure SetImageIndex(const AValue: TImageIndex);
|
|
procedure SetTabVisible(const AValue: Boolean);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
|
|
procedure SetParent(AParent: TWinControl); override;
|
|
property Flags: TPageFlags read FFlags write FFlags;
|
|
procedure CMHitTest(var Message: TLMNCHITTEST); message CM_HITTEST;
|
|
procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
|
|
function GetPageIndex: integer; virtual;
|
|
procedure SetPageIndex(AValue: Integer); virtual;
|
|
function GetTabVisible: Boolean; virtual;
|
|
function DialogChar(var Message: TLMKey): boolean; override;
|
|
procedure DoHide; virtual;
|
|
procedure DoShow; virtual;
|
|
procedure DestroyHandle; override;
|
|
procedure RealSetText(const AValue: TCaption); override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
function CanTab: boolean; override;
|
|
function IsControlVisible: Boolean; override;
|
|
function HandleObjectShouldBeVisible: boolean; override;
|
|
function VisibleIndex: integer; virtual;
|
|
procedure CheckNewParent(AParent: TWinControl); override;
|
|
property PageIndex: Integer read GetPageIndex write SetPageIndex;
|
|
property TabVisible: Boolean read GetTabVisible write SetTabVisible default True;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property Left stored False;
|
|
property Top stored False;
|
|
property Width stored False;
|
|
property Height stored False;
|
|
property TabOrder stored False;
|
|
property Visible stored false;
|
|
property OnHide: TNotifyEvent read FOnHide write FOnHide;
|
|
property OnShow: TNotifyEvent read FOnShow write FOnShow;
|
|
end;
|
|
|
|
TCustomPageClass = class of TCustomPage;
|
|
|
|
{ TNBPages }
|
|
|
|
TCustomTabControl = class;
|
|
|
|
{ TNBBasePages }
|
|
|
|
TNBBasePages = class(TStrings)
|
|
protected
|
|
function IndexOfPage(const AnObject: TPersistent): Integer; virtual; abstract;
|
|
procedure InsertPage(Index: Integer; const APage: TCustomPage); virtual; abstract;
|
|
procedure DeletePage(Index: Integer); virtual; abstract;
|
|
function GetPage(Index: Integer): TCustomPage; virtual; abstract;
|
|
public
|
|
constructor Create(theNotebook: TCustomTabControl); virtual;
|
|
end;
|
|
|
|
TNBBasePagesClass = class of TNBBasePages;
|
|
|
|
TNBPages = class(TNBBasePages)
|
|
private
|
|
FPageList: TListWithEvent;
|
|
FNotebook: TCustomTabControl;
|
|
procedure PageListChange(Ptr: Pointer; AnAction: TListNotification);
|
|
protected
|
|
function Get(Index: Integer): String; override;
|
|
function GetCount: Integer; override;
|
|
function GetObject(Index: Integer): TObject; override;
|
|
procedure Put(Index: Integer; const S: String); override;
|
|
function IndexOfPage(const AnObject: TPersistent): Integer; override;
|
|
procedure InsertPage(Index: Integer; const APage: TCustomPage); override; // Internal Insert, no notification to TabControl
|
|
procedure DeletePage(Index: Integer); override; // Internal Delete, no notification to TabControl
|
|
function GetPage(Index: Integer): TCustomPage; override; // Wrapper to GetObj
|
|
property PageList: TListWithEvent read FPageList;
|
|
property Notebook: TCustomTabControl read FNotebook;
|
|
public
|
|
constructor Create(theNotebook: TCustomTabControl); override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: String); override;
|
|
procedure Move(CurIndex, NewIndex: Integer); override;
|
|
end;
|
|
|
|
{ TNBNoPages }
|
|
|
|
TNBNoPages = class(TNBBasePages)
|
|
private
|
|
//FNotebook: TCustomTabControl;
|
|
protected
|
|
function Get(Index: Integer): String; override;
|
|
function GetCount: Integer; override; // always 0
|
|
//function GetObject(Index: Integer): TObject; override;
|
|
//procedure Put(Index: Integer; const S: String); override;
|
|
function IndexOfPage(const AnObject: TPersistent): Integer; override;
|
|
//procedure InsertPage(Index: Integer; const APage: TCustomPage); override;
|
|
//procedure DeletePage(Index: Integer); override;
|
|
function GetPage(Index: Integer): TCustomPage; override;
|
|
public
|
|
//constructor Create(theNotebook: TCustomTabControl); override;
|
|
//destructor Destroy; override;
|
|
//procedure Clear; override;
|
|
//procedure Delete(Index: Integer); override;
|
|
//procedure Insert(Index: Integer; const S: String); override;
|
|
//procedure Move(CurIndex, NewIndex: Integer); override;
|
|
end;
|
|
|
|
{ TCustomTabControl }
|
|
|
|
TTabChangingEvent = procedure(Sender: TObject;
|
|
var AllowChange: Boolean) of object;
|
|
|
|
TTabPosition = (tpTop, tpBottom, tpLeft, tpRight);
|
|
|
|
TTabStyle = (tsTabs, tsButtons, tsFlatButtons);
|
|
|
|
TTabGetImageEvent = procedure(Sender: TObject; TabIndex: Integer;
|
|
var ImageIndex: Integer) of object;
|
|
|
|
// These are LCL additions
|
|
TCTabControlOption = (
|
|
nboShowCloseButtons, nboMultiLine, nboHidePageListPopup,
|
|
nboKeyboardTabSwitch, nboShowAddTabButton, nboDoChangeOnSetIndex);
|
|
TCTabControlOptions = set of TCTabControlOption;
|
|
TCTabControlCapability = (
|
|
nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton,
|
|
nbcTabsSizeable);
|
|
TCTabControlCapabilities = set of TCTabControlCapability;
|
|
|
|
TDrawTabEvent = procedure(Control: TCustomTabControl; TabIndex: Integer;
|
|
const Rect: TRect; AActive: Boolean) of object;
|
|
|
|
TCustomTabControl = class(TWinControl)
|
|
private
|
|
FAccess: TStrings; // TNBPages
|
|
FAddingPages: boolean;
|
|
FHotTrack: Boolean;
|
|
FImages: TCustomImageList;
|
|
FImagesWidth: Integer;
|
|
FImageListChangeLink: TChangeLink;
|
|
FMultiSelect: Boolean;
|
|
FOnChanging: TTabChangingEvent;
|
|
FOnCloseTabClicked: TNotifyEvent;
|
|
FOnGetImageIndex: TTabGetImageEvent;
|
|
FOnPageChanged: TNotifyEvent;
|
|
FOptions: TCTabControlOptions;
|
|
FOwnerDraw: Boolean;
|
|
FPageIndex: Integer;
|
|
FPageIndexOnLastChange: integer;// needed for unique OnChange events
|
|
FRaggedRight: Boolean;
|
|
FScrollOpposite: Boolean;
|
|
FShowTabs: Boolean;
|
|
FStyle: TTabStyle;
|
|
FTabHeight: Smallint;
|
|
FTabPosition: TTabPosition;
|
|
FTabWidth: Smallint;
|
|
procedure DoSendPageIndex;
|
|
procedure DoSendShowTabs;
|
|
procedure DoSendTabPosition;
|
|
procedure DoSendTabSize;
|
|
procedure DoImageListChange(Sender: TObject);
|
|
function GetActivePage: String;
|
|
function GetActivePageComponent: TCustomPage;
|
|
function GetDisplayRect: TRect;
|
|
function GetMultiLine: Boolean;
|
|
function FindVisiblePage(Index: Integer): Integer;
|
|
function IsStoredActivePage: boolean;
|
|
procedure MoveTab(Sender: TObject; NewIndex: Integer);
|
|
procedure SetMultiLine(const AValue: Boolean);
|
|
procedure SetStyle(AValue: TTabStyle); virtual;
|
|
procedure WSMovePage(APage: TCustomPage; NewIndex: Integer);
|
|
procedure PageRemoved(Index: Integer);
|
|
procedure SetActivePage(const Value: String);
|
|
procedure SetActivePageComponent(const AValue: TCustomPage);
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
|
procedure SetPageIndex(AValue: Integer);
|
|
procedure SetPages(AValue: TStrings);
|
|
procedure SetShowTabs(AValue: Boolean);
|
|
procedure SetTabHeight(AValue: Smallint);
|
|
procedure SetTabPosition(tabPos: TTabPosition); virtual;
|
|
procedure SetTabWidth(AValue: Smallint);
|
|
procedure ShowCurrentPage;
|
|
procedure UpdateAllDesignerFlags;
|
|
procedure UpdateDesignerFlags(APageIndex: integer);
|
|
procedure DoImageListDestroyResolutionHandle(Sender: TCustomImageList;
|
|
AWidth: Integer; AReferenceHandle: TLCLHandle);
|
|
procedure SetImageListAsync(Data: PtrInt);
|
|
protected
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
function GetPageClass: TCustomPageClass; virtual;
|
|
function GetListClass: TNBBasePagesClass; virtual;
|
|
procedure SetOptions(const AValue: TCTabControlOptions); virtual;
|
|
procedure AddRemovePageHandle(APage: TCustomPage); virtual;
|
|
procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
|
|
class procedure WSRegisterClass; override;
|
|
procedure CreateWnd; override;
|
|
procedure Loaded; override;
|
|
procedure DoChange; virtual;
|
|
procedure InitializeWnd; override;
|
|
procedure Change; virtual;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure ReadState(Reader: TReader); override;
|
|
function DialogChar(var Message: TLMKey): boolean; override;
|
|
procedure InternalSetPageIndex(AValue: Integer); // No OnChange
|
|
procedure ShowControl(APage: TControl); override;
|
|
function IndexOfTabAt(X, Y: Integer): Integer; virtual; overload;
|
|
function IndexOfTabAt(P: TPoint): Integer; virtual; overload;
|
|
function IndexOfPageAt(X, Y: Integer): Integer; virtual; overload;
|
|
function IndexOfPageAt(P: TPoint): Integer; virtual; overload;
|
|
procedure UpdateTabProperties; virtual;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
property ActivePageComponent: TCustomPage read GetActivePageComponent
|
|
write SetActivePageComponent;
|
|
property ActivePage: String read GetActivePage write SetActivePage
|
|
stored IsStoredActivePage;
|
|
protected //elevated visibility for un/paged
|
|
function GetPage(AIndex: Integer): TCustomPage; virtual;
|
|
function GetPageCount : integer; virtual;
|
|
procedure InsertPage(APage: TCustomPage; Index: Integer); virtual;
|
|
procedure RemovePage(Index: Integer); virtual;
|
|
//Delphi compatible properties
|
|
function CanChange: Boolean; virtual;
|
|
property DisplayRect: TRect read GetDisplayRect;
|
|
property Tabs: TStrings read FAccess write SetPages;
|
|
property TabIndex: Integer read FPageIndex write SetPageIndex default -1;
|
|
property OnChange: TNotifyEvent read FOnPageChanged write FOnPageChanged;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function TabRect(AIndex: Integer): TRect;
|
|
function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
|
|
function IndexOf(APage: TPersistent): integer; virtual;
|
|
function CustomPage(Index: integer): TCustomPage;
|
|
function CanChangePageIndex: boolean; virtual;
|
|
function GetMinimumTabWidth: integer; virtual;
|
|
function GetMinimumTabHeight: integer; virtual;
|
|
function GetCapabilities: TCTabControlCapabilities; virtual;
|
|
function TabToPageIndex(AIndex: integer): integer;
|
|
function PageToTabIndex(AIndex: integer): integer;
|
|
public
|
|
procedure DoCloseTabClicked(APage: TCustomPage); virtual;
|
|
property HotTrack: Boolean read FHotTrack write FHotTrack default False;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property MultiLine: Boolean read GetMultiLine write SetMultiLine default False;
|
|
property MultiSelect: Boolean read FMultiSelect write FMultiSelect default False;
|
|
property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
|
|
property OnCloseTabClicked: TNotifyEvent read FOnCloseTabClicked
|
|
write FOnCloseTabClicked;
|
|
property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex
|
|
write FOnGetImageIndex;
|
|
property Options: TCTabControlOptions read FOptions write SetOptions default [];
|
|
property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
|
|
property Page[Index: Integer]: TCustomPage read GetPage;
|
|
property PageCount: integer read GetPageCount;
|
|
property PageIndex: Integer read FPageIndex write SetPageIndex default -1;
|
|
//property PageList: TList read FPageList; - iff paged
|
|
property Pages: TStrings read FAccess write SetPages;
|
|
property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False;
|
|
property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False;
|
|
property ShowTabs: Boolean read FShowTabs write SetShowTabs default True;
|
|
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
|
|
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
|
|
property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop;
|
|
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
|
|
published
|
|
property TabStop default true;
|
|
end;
|
|
|
|
{ TTabSheet }
|
|
|
|
TPageControl = class;
|
|
|
|
TTabSheet = class(TCustomPage)
|
|
private
|
|
function GetPageControl: TPageControl;
|
|
function GetTabIndex: Integer;
|
|
procedure SetPageControl(APageControl: TPageControl);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property PageControl: TPageControl read GetPageControl write SetPageControl;
|
|
property TabIndex: Integer read GetTabIndex;
|
|
published
|
|
property BorderWidth;
|
|
property BiDiMode;
|
|
property Caption;
|
|
property ChildSizing;
|
|
property ClientHeight;
|
|
property ClientWidth;
|
|
property Enabled;
|
|
property Font;
|
|
property Height stored False;
|
|
property ImageIndex;
|
|
property Left stored False;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnHide;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnShow;
|
|
property OnStartDrag;
|
|
property PageIndex stored False;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabVisible default True;
|
|
property Top stored False;
|
|
property Width stored False;
|
|
end;
|
|
|
|
{ TPageControl }
|
|
|
|
TPageControl = class(TCustomTabControl)
|
|
private
|
|
FPageToUndock: TTabSheet;
|
|
function GetActivePageIndex: Integer;
|
|
function GetActiveTabSheet: TTabSheet;
|
|
function GetTabSheet(Index: Integer): TTabSheet;
|
|
procedure SetActivePageIndex(const AValue: Integer);
|
|
procedure SetActiveTabSheet(const AValue: TTabSheet);
|
|
function FindPageWithDockClient(Client: TControl): TTabSheet;
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
function GetPageClass: TCustomPageClass; override;
|
|
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
|
|
procedure DockOver(Source: TDragDockObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean); override;
|
|
procedure DoRemoveDockClient(Client: TControl); override;
|
|
function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override;
|
|
function ChildClassAllowed(ChildClass: TClass): boolean; override;
|
|
public
|
|
function FindNextPage(CurPage: TTabSheet;
|
|
GoForward, CheckTabVisible: Boolean): TTabSheet;
|
|
procedure SelectNextPage(GoForward: Boolean);
|
|
procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean);
|
|
function IndexOfTabAt(X, Y: Integer): Integer; override;
|
|
function IndexOfTabAt(P: TPoint): Integer; override;
|
|
function IndexOfPageAt(X, Y: Integer): Integer; override;
|
|
function IndexOfPageAt(P: TPoint): Integer; override;
|
|
function AddTabSheet: TTabSheet;
|
|
property ActivePageIndex: Integer read GetActivePageIndex
|
|
write SetActivePageIndex;
|
|
property Pages[Index: Integer]: TTabSheet read GetTabSheet;
|
|
published
|
|
property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet;
|
|
property OnGetDockCaption;
|
|
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property HotTrack;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property MultiLine;
|
|
//property OwnerDraw;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property RaggedRight;
|
|
property ScrollOpposite;
|
|
property ShowHint;
|
|
property ShowTabs;
|
|
property Style;
|
|
property TabHeight;
|
|
property TabIndex;
|
|
property TabOrder;
|
|
property TabPosition;
|
|
property TabStop;
|
|
property TabWidth;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnChanging;
|
|
property OnCloseTabClicked;
|
|
property OnContextPopup;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
//property OnDrawTab;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetImageIndex;
|
|
property OnGetSiteInfo;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
property Options;
|
|
end;
|
|
|
|
TTabControl = class;
|
|
|
|
{ TTabControlStrings }
|
|
|
|
TTabControlStrings = class(TStrings)
|
|
private
|
|
FHotTrack: Boolean;
|
|
FImages: TCustomImageList;
|
|
FMultiLine: Boolean;
|
|
FMultiSelect: Boolean;
|
|
FOwnerDraw: Boolean;
|
|
FRaggedRight: Boolean;
|
|
FScrollOpposite: Boolean;
|
|
FTabControl: TTabControl;
|
|
FUpdateCount: integer;
|
|
protected
|
|
function GetTabIndex: integer; virtual; abstract;
|
|
procedure SetHotTrack(const AValue: Boolean); virtual;
|
|
procedure SetImages(const AValue: TCustomImageList); virtual;
|
|
procedure SetMultiLine(const AValue: Boolean); virtual;
|
|
procedure SetMultiSelect(const AValue: Boolean); virtual;
|
|
procedure SetOwnerDraw(const AValue: Boolean); virtual;
|
|
procedure SetRaggedRight(const AValue: Boolean); virtual;
|
|
procedure SetScrollOpposite(const AValue: Boolean); virtual;
|
|
procedure SetTabIndex(const AValue: integer); virtual; abstract;
|
|
public
|
|
constructor Create(TheTabControl: TTabControl); virtual;
|
|
function GetHitTestInfoAt(X, Y: Integer): THitTests; virtual;
|
|
function GetSize: integer; virtual; abstract;
|
|
function IndexOfTabAt(X, Y: Integer): Integer; virtual;
|
|
function RowCount: Integer; virtual;
|
|
function TabRect(Index: Integer): TRect; virtual;
|
|
procedure ImageListChange(Sender: TObject); virtual;
|
|
procedure ScrollTabs(Delta: Integer); virtual;
|
|
procedure TabControlBoundsChange; virtual;
|
|
procedure UpdateTabImages; virtual;
|
|
procedure BeginUpdate; virtual;
|
|
procedure EndUpdate; virtual;
|
|
function IsUpdating: boolean; virtual;
|
|
public
|
|
property TabControl: TTabControl read FTabControl;
|
|
property TabIndex: integer read GetTabIndex write SetTabIndex;
|
|
property HotTrack: Boolean read FHotTrack write SetHotTrack;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property MultiLine: Boolean read FMultiLine write SetMultiLine;
|
|
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
|
|
property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw;
|
|
property RaggedRight: Boolean read FRaggedRight write SetRaggedRight;
|
|
property ScrollOpposite: Boolean read FScrollOpposite
|
|
write SetScrollOpposite;
|
|
end;
|
|
|
|
{ TNoteBookStringsTabControl }
|
|
|
|
TNoteBookStringsTabControl = class(TPageControl) // TCustomTabControl, TODO TCustomTabControl, and fix all widgetsets
|
|
protected
|
|
FHandleCreated: TNotifyEvent;
|
|
procedure CreateHandle; override;
|
|
procedure DoStartDrag(var DragObject: TDragObject); override;
|
|
procedure DragDrop(Source: TObject; X, Y: Integer); override;
|
|
procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
|
|
var Accept: Boolean); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
function GetPopupMenu: TPopupMenu; override;
|
|
class procedure WSRegisterClass; override;
|
|
end;
|
|
TNoteBookStringsTabControlClass = class of TNoteBookStringsTabControl;
|
|
|
|
{ TTabControlNoteBookStrings }
|
|
|
|
TTabControlNoteBookStrings = class(TTabControlStrings)
|
|
private
|
|
FNoteBook: TCustomTabControl{%H-};
|
|
FInHandleCreated: Boolean;
|
|
function GetStyle: TTabStyle;
|
|
procedure SetStyle(AValue: TTabStyle);
|
|
protected
|
|
function GetInternalTabControllClass: TNoteBookStringsTabControlClass; virtual;
|
|
function Get(Index: Integer): string; override;
|
|
function GetCount: Integer; override;
|
|
function GetObject(Index: Integer): TObject; override;
|
|
function GetTabIndex: integer; override;
|
|
function GetTabPosition: TTabPosition;
|
|
procedure NBChanging(Sender: TObject; var AllowChange: Boolean); virtual;
|
|
procedure NBGetImageIndex(Sender: TObject; TheTabIndex: Integer;
|
|
var ImageIndex: Integer); virtual;
|
|
procedure NBPageChanged(Sender: TObject); virtual;
|
|
procedure NBHandleCreated(Sender: TObject);
|
|
procedure Put(Index: Integer; const S: string); override;
|
|
procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
procedure SetImages(const AValue: TCustomImageList); override;
|
|
procedure SetMultiLine(const AValue: Boolean); override;
|
|
procedure SetTabIndex(const AValue: integer); override;
|
|
procedure SetUpdateState(Updating: Boolean); override;
|
|
procedure SetTabPosition(AValue: TTabPosition);
|
|
public
|
|
constructor Create(TheTabControl: TTabControl); override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
function GetSize: integer; override;
|
|
procedure TabControlBoundsChange; override;
|
|
function IndexOfTabAt(X, Y: Integer): Integer; override;
|
|
property TabPosition: TTabPosition read GetTabPosition write SetTabPosition;
|
|
property Style: TTabStyle read GetStyle write SetStyle;
|
|
public
|
|
property NoteBook: TCustomTabControl read FNoteBook;
|
|
end;
|
|
|
|
(* This is the new TTabControl which replaces the one one.
|
|
This new one is derived from TCustomTabControl.
|
|
|
|
Note: TabControls that do not implement "pages" MUST be derived from TTabControl !
|
|
*)
|
|
|
|
TTabControl = class(TCustomTabControl)
|
|
private
|
|
FImageChangeLink: TChangeLink;
|
|
FOnChange: TNotifyEvent;
|
|
FOnChangeNeeded: Boolean;
|
|
FTabControlCreating: Boolean;
|
|
FTabs: TStrings;// this is a TTabControlNoteBookStrings
|
|
FCanvas: TCanvas;
|
|
procedure AdjustDisplayRect(var ARect: TRect);
|
|
function GetDisplayRect: TRect;
|
|
function GetHotTrack: Boolean;
|
|
function GetMultiLine: Boolean;
|
|
function GetMultiSelect: Boolean;
|
|
function GetOwnerDraw: Boolean;
|
|
function GetRaggedRight: Boolean;
|
|
function GetScrollOpposite: Boolean;
|
|
function GetTabIndex: Integer;
|
|
function GetTabRectWithBorder: TRect;
|
|
function GetTabStop: Boolean;
|
|
procedure SetHotTrack(const AValue: Boolean);
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetMultiLine(const AValue: Boolean);
|
|
procedure SetMultiSelect(const AValue: Boolean);
|
|
procedure SetOwnerDraw(const AValue: Boolean);
|
|
procedure SetRaggedRight(const AValue: Boolean);
|
|
procedure SetScrollOpposite(const AValue: Boolean);
|
|
procedure SetStyle(AValue: TTabStyle); override;
|
|
procedure SetTabHeight(AValue: Smallint);
|
|
procedure SetTabPosition(AValue: TTabPosition); override;
|
|
procedure SetTabs(const AValue: TStrings);
|
|
procedure SetTabStop(const AValue: Boolean);
|
|
procedure SetTabWidth(AValue: Smallint);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure SetOptions(const AValue: TCTabControlOptions); override;
|
|
procedure AddRemovePageHandle(APage: TCustomPage); override;
|
|
function CanChange: Boolean; override;
|
|
function CanShowTab(ATabIndex: Integer): Boolean; virtual;
|
|
procedure Change; override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyHandle; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetDragMode(Value: TDragMode); override;
|
|
procedure SetTabIndex(Value: Integer); virtual;
|
|
procedure UpdateTabImages;
|
|
procedure ImageListChange(Sender: TObject);
|
|
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure PaintWindow(DC: HDC); override;
|
|
procedure Paint; virtual;
|
|
procedure AdjustDisplayRectWithBorder(var ARect: TRect); virtual;
|
|
procedure AdjustClientRect(var ARect: TRect); override;
|
|
function CreateTabNoteBookStrings: TTabControlNoteBookStrings; virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function IndexOfTabAt(X, Y: Integer): Integer; override;
|
|
function IndexOfTabAt(P: TPoint): Integer; override;
|
|
function GetHitTestInfoAt(X, Y: Integer): THitTests;
|
|
function GetImageIndex(ATabIndex: Integer): Integer; override;
|
|
function IndexOfTabWithCaption(const TabCaption: string): Integer;
|
|
function TabRect(Index: Integer): TRect;
|
|
function RowCount: Integer;
|
|
procedure ScrollTabs(Delta: Integer);
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function IsUpdating: boolean;
|
|
public
|
|
property DisplayRect: TRect read GetDisplayRect;
|
|
published
|
|
property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property MultiLine: Boolean read GetMultiLine write SetMultiLine default False;
|
|
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnChanging;
|
|
property OnGetImageIndex;
|
|
property OwnerDraw: Boolean read GetOwnerDraw write SetOwnerDraw default False;
|
|
property RaggedRight: Boolean read GetRaggedRight write SetRaggedRight default False;
|
|
property ScrollOpposite: Boolean read GetScrollOpposite
|
|
write SetScrollOpposite default False;
|
|
property Style default tsTabs;
|
|
property TabPosition default tpTop;
|
|
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
|
|
property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
|
|
property Tabs: TStrings read FTabs write SetTabs;
|
|
property TabStop: Boolean read GetTabStop write SetTabStop default true; // workaround, see #30305
|
|
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
|
|
//
|
|
property Align;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property Constraints;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property OnChangeBounds;
|
|
property OnContextPopup;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetSiteInfo;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
property Options;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property Visible;
|
|
end;
|
|
|
|
{ Custom draw }
|
|
|
|
TCustomDrawTarget = (
|
|
dtControl, // the whole control
|
|
dtItem, // one item (= line in report mode)
|
|
dtSubItem // one subitem, except for subitem 0, this one is drawn by dtItem
|
|
);
|
|
TCustomDrawStage = (
|
|
cdPrePaint,
|
|
cdPostPaint,
|
|
cdPreErase,
|
|
cdPostErase
|
|
);
|
|
TCustomDrawStateFlag = (
|
|
cdsSelected,
|
|
cdsGrayed,
|
|
cdsDisabled,
|
|
cdsChecked,
|
|
cdsFocused,
|
|
cdsDefault,
|
|
cdsHot,
|
|
cdsMarked,
|
|
cdsIndeterminate
|
|
);
|
|
TCustomDrawState = set of TCustomDrawStateFlag;
|
|
|
|
TCustomDrawResultFlag = (
|
|
cdrSkipDefault,
|
|
cdrNotifyPostpaint,
|
|
cdrNotifyItemdraw,
|
|
cdrNotifySubitemdraw,
|
|
cdrNotifyPosterase,
|
|
cdrNotifyItemerase
|
|
);
|
|
TCustomDrawResult = set of TCustomDrawResultFlag;
|
|
|
|
|
|
{ TListView }
|
|
|
|
TListItems = class; //forward declaration!
|
|
TCustomListView = class; //forward declaration!
|
|
TSortType = (stNone, stData, stText, stBoth);
|
|
|
|
TListItemState = (lisCut, lisDropTarget, lisFocused, lisSelected);
|
|
TListItemStates = set of TListItemState;
|
|
|
|
TListItemFlag = (lifDestroying, lifCreated);
|
|
TListItemFlags = set of TListItemFlag;
|
|
|
|
TDisplayCode = (drBounds, drIcon, drLabel, drSelectBounds);
|
|
|
|
{ TIconOptions }
|
|
|
|
TIconArrangement = (iaTop, iaLeft);
|
|
|
|
TIconOptions = class(TPersistent)
|
|
private
|
|
FListView: TCustomListView;
|
|
FArrangement: TIconArrangement;
|
|
function GetAutoArrange: Boolean;
|
|
function GetWrapText: Boolean;
|
|
procedure SetArrangement(Value: TIconArrangement);
|
|
procedure SetAutoArrange(Value: Boolean);
|
|
procedure SetWrapText(Value: Boolean);
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AOwner: TCustomListView);
|
|
published
|
|
property Arrangement: TIconArrangement read FArrangement write SetArrangement default iaTop;
|
|
property AutoArrange: Boolean read GetAutoArrange write SetAutoArrange default False;
|
|
property WrapText: Boolean read GetWrapText write SetWrapText default True;
|
|
end;
|
|
|
|
{ TListItem }
|
|
|
|
TListItem = class(TPersistent)
|
|
private
|
|
FOwner: TListItems;
|
|
FFlags: TListItemFlags;
|
|
FSubItems: TStrings;
|
|
FCaption: String;
|
|
FData: Pointer;
|
|
FImageIndex: TImageIndex;
|
|
FStateIndex: TImageIndex;
|
|
FStates: TListItemStates;
|
|
FChecked: Boolean;
|
|
function GetCaption: String; virtual;
|
|
function GetChecked: Boolean;
|
|
function GetLeft: Integer;
|
|
function GetListView: TCustomListView;
|
|
function GetPosition: TPoint;
|
|
function GetState(const ALisOrd: Integer): Boolean;
|
|
function GetImageIndex: TImageIndex; virtual;
|
|
function GetIndex: Integer; virtual;
|
|
function GetStateIndex: TImageIndex; virtual;
|
|
function GetSubItemImages(const AIndex: Integer): Integer;
|
|
function GetSubItems: TStrings; virtual;
|
|
function GetTop: Integer;
|
|
function WSUpdateAllowed: Boolean;
|
|
procedure WSUpdateText;
|
|
procedure WSUpdateImages;
|
|
procedure WSUpdateChecked;
|
|
procedure WSSetState;
|
|
procedure WSUpdateState;
|
|
|
|
procedure SetChecked(AValue: Boolean);
|
|
procedure SetState(const ALisOrd: Integer; const AIsSet: Boolean);
|
|
procedure SetData(const AValue: Pointer);
|
|
procedure SetImageIndex(const AValue: TImageIndex); virtual;
|
|
procedure SetLeft(Value: Integer);
|
|
procedure SetCaption(const AValue : String); virtual;
|
|
procedure SetPosition(const AValue: TPoint);
|
|
procedure SetStateIndex(const AValue: TImageIndex); virtual;
|
|
procedure SetSubItemImages(const AIndex, AValue: Integer);
|
|
procedure SetSubItems(const AValue: TStrings);
|
|
procedure SetTop(Value: Integer);
|
|
protected
|
|
function IsEqual(const AItem: TListItem): Boolean;
|
|
function IsOwnerData: Boolean; virtual;
|
|
function GetCheckedInternal: Boolean;
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
|
|
constructor Create(AOwner: TListItems); virtual;
|
|
destructor Destroy; override;
|
|
procedure Delete;
|
|
procedure MakeVisible(PartialOK: Boolean);
|
|
function DisplayRect(Code: TDisplayCode): TRect;
|
|
function DisplayRectSubItem(subItem: integer;Code: TDisplayCode): TRect;
|
|
function EditCaption: Boolean;
|
|
|
|
property Caption : String read GetCaption write SetCaption;
|
|
property Checked : Boolean read GetChecked write SetChecked;
|
|
property Cut: Boolean index Ord(lisCut) read GetState write SetState;
|
|
property Data: Pointer read FData write SetData;
|
|
property DropTarget: Boolean index Ord(lisDropTarget) read GetState write SetState;
|
|
property Focused: Boolean index Ord(lisFocused) read GetState write SetState;
|
|
property Index: Integer read GetIndex;
|
|
property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
|
|
property Left: Integer read GetLeft write SetLeft;
|
|
property ListView: TCustomListView read GetListView;
|
|
property Owner: TListItems read FOwner;
|
|
property Position: TPoint read GetPosition write SetPosition;
|
|
property Selected: Boolean index Ord(lisSelected) read GetState write SetState;
|
|
property StateIndex: TImageIndex read GetStateIndex write SetStateIndex;
|
|
property SubItems: TStrings read GetSubItems write SetSubItems;
|
|
property SubItemImages[const AIndex: Integer]: Integer read GetSubItemImages write SetSubItemImages;
|
|
property Top: Integer read GetTop write SetTop;
|
|
end;
|
|
TListItemClass = class of TListItem;
|
|
|
|
{ TOwnerDataListItem }
|
|
|
|
TOwnerDataListItem = class(TListItem)
|
|
private
|
|
FDataIndex: Integer;
|
|
FCached: Boolean;
|
|
function GetCaption: String; override;
|
|
function GetIndex: Integer; override;
|
|
function GetImageIndex: TImageIndex; override;
|
|
|
|
procedure SetCaption(const AValue : String); override;
|
|
procedure SetImageIndex(const AValue: TImageIndex); override;
|
|
function GetSubItems: TStrings; override;
|
|
procedure DoCacheItem;
|
|
protected
|
|
function IsOwnerData: Boolean; override;
|
|
public
|
|
procedure SetDataIndex(ADataIndex: Integer);
|
|
procedure SetOwner(AOwner: TListItems);
|
|
end;
|
|
|
|
{ TListItemsEnumerator }
|
|
|
|
TListItemsEnumerator = class
|
|
private
|
|
FItems: TListItems;
|
|
FPosition: Integer;
|
|
function GetCurrent: TListItem;
|
|
public
|
|
constructor Create(AItems: TListItems);
|
|
function MoveNext: Boolean;
|
|
property Current: TListItem read GetCurrent;
|
|
end;
|
|
|
|
TListItemsFlag = (lisfWSItemsCreated);
|
|
TListItemsFlags = set of TListItemsFlag;
|
|
|
|
|
|
{ TListItems }
|
|
{
|
|
Listitems have a build in cache of the last accessed item.
|
|
This will speed up interface updates since Item.Index is
|
|
often used for the same item updating more properties.
|
|
If FCacheIndex = -1 then the cache is not valid.
|
|
}
|
|
|
|
TListItems = class(TPersistent)
|
|
private
|
|
FOwner: TCustomListView;
|
|
FItems: TFPList;
|
|
FFlags: TListItemsFlags;
|
|
FCacheIndex: Integer; // Caches the last used item
|
|
FCacheItem: TListItem; //
|
|
procedure WSCreateCacheItem;
|
|
function WSUpdateAllowed: Boolean;
|
|
procedure WSUpdateItem(const AIndex:Integer; const AValue: TListItem);
|
|
procedure WSSetItemsCount(const ACount: Integer);
|
|
procedure ItemDestroying(const AItem: TListItem); //called by TListItem when freed
|
|
procedure ReadData(Stream: TStream); // read data in a Delphi compatible way
|
|
procedure ReadLazData(Stream: TStream); // read data in a 64 bits safe way
|
|
procedure WriteLazData(Stream: TStream); // write date in a 64 bits safe way
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetCount: Integer; virtual;
|
|
function GetItem(const AIndex: Integer): TListItem; virtual;
|
|
function GetOwner: TPersistent; override;
|
|
procedure WSCreateItems;
|
|
procedure DoFinalizeWnd;
|
|
procedure SetCount(const ACount: Integer); virtual;
|
|
procedure SetItem(const AIndex: Integer; const AValue: TListItem);
|
|
procedure ClearSelection;
|
|
procedure SelectAll;
|
|
public
|
|
function Add: TListItem;
|
|
procedure AddItem(AItem: TListItem);
|
|
procedure BeginUpdate;
|
|
procedure Clear; virtual;
|
|
constructor Create(AOwner : TCustomListView);
|
|
destructor Destroy; override;
|
|
procedure Delete(const AIndex : Integer);
|
|
procedure EndUpdate;
|
|
procedure Exchange(const AIndex1, AIndex2: Integer);
|
|
procedure Move(const AFromIndex, AToIndex: Integer);
|
|
function FindCaption(StartIndex: Integer; Value: string;
|
|
Partial, Inclusive, Wrap: Boolean;
|
|
PartStart: Boolean = True): TListItem;
|
|
function FindData(const AData: Pointer): TListItem; overload;
|
|
function FindData(StartIndex: Integer; Value: Pointer; Inclusive, Wrap: Boolean): TListItem; overload;
|
|
function GetEnumerator: TListItemsEnumerator;
|
|
function IndexOf(const AItem: TListItem): Integer;
|
|
function Insert(const AIndex: Integer) : TListItem;
|
|
procedure InsertItem(AItem: TListItem; const AIndex: Integer);
|
|
property Flags: TListItemsFlags read FFlags;
|
|
property Count: Integer read GetCount write SetCount;
|
|
property Item[const AIndex: Integer]: TListItem read GetItem write SetItem; default;
|
|
property Owner: TCustomListView read FOwner;
|
|
end;
|
|
|
|
{ TOwnerDataListItems }
|
|
|
|
TOwnerDataListItems = class(TListItems)
|
|
private
|
|
fItemsCount : Integer;
|
|
protected
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const ACount: Integer); override;
|
|
function GetItem(const AIndex: Integer): TListItem; override;
|
|
public
|
|
procedure Clear; override;
|
|
end;
|
|
|
|
|
|
{ TListColumn }
|
|
|
|
TWidth = 0..MaxInt;
|
|
|
|
TSortIndicator = (siNone, siAscending, siDescending);
|
|
|
|
TListColumn = class(TCollectionItem)
|
|
private
|
|
FAlignment: TAlignment;
|
|
FAutoSize: Boolean;
|
|
FCaption: TTranslateString;
|
|
FMinWidth: TWidth;
|
|
FMaxWidth: TWidth;
|
|
FVisible: Boolean;
|
|
FWidth: TWidth;
|
|
FImageIndex: TImageIndex;
|
|
FTag: PtrInt;
|
|
FSortIndicator: TSortIndicator;
|
|
function GetWidth: TWidth;
|
|
procedure WSCreateColumn;
|
|
procedure WSDestroyColumn;
|
|
function WSUpdateAllowed: Boolean;
|
|
function WSReadAllowed: Boolean;
|
|
procedure SetVisible(const AValue: Boolean);
|
|
procedure SetAutoSize(const AValue: Boolean);
|
|
procedure SetMinWidth(const AValue: TWidth);
|
|
procedure SetMaxWidth(const AValue: TWidth);
|
|
procedure SetWidth(const AValue: TWidth);
|
|
procedure SetCaption(const AValue: TTranslateString);
|
|
procedure SetAlignment(const AValue: TAlignment);
|
|
procedure SetImageIndex(const AValue: TImageIndex);
|
|
procedure SetSortIndicator(AValue: TSortIndicator);
|
|
protected
|
|
procedure SetIndex(AValue: Integer); override;
|
|
function GetDisplayName: string; override;
|
|
function GetStoredWidth: Integer;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(ASource: TPersistent); override;
|
|
property WidthType: TWidth read FWidth;
|
|
published
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
|
|
property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
|
|
property Caption: TTranslateString read FCaption write SetCaption;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property MaxWidth: TWidth read FMaxWidth write SetMaxWidth default 0;
|
|
property MinWidth: TWidth read FMinWidth write SetMinWidth default 0;
|
|
property Tag: PtrInt read FTag write FTag default 0;
|
|
property Visible: Boolean read FVisible write SetVisible default true;
|
|
property Width: TWidth read GetWidth write SetWidth default 50;
|
|
property SortIndicator: TSortIndicator read FSortIndicator write SetSortIndicator default siNone;
|
|
end;
|
|
|
|
|
|
{ TListColumns }
|
|
|
|
TListColumns = class(TCollection)
|
|
private
|
|
FOwner: TCustomListView;
|
|
FItemNeedsUpdate: TCollectionItem;
|
|
FNeedsUpdate: boolean;
|
|
function GetItem(const AIndex: Integer): TListColumn;
|
|
procedure WSCreateColumns;
|
|
procedure SetItem(const AIndex: Integer; const AValue: TListColumn);
|
|
procedure DoFinalizeWnd;
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AOwner: TCustomListView);
|
|
destructor Destroy; override;
|
|
procedure Update(Item: TCollectionItem); override;
|
|
function Add: TListColumn;
|
|
property Owner: TCustomListView read FOwner;
|
|
property Items[const AIndex: Integer]: TListColumn
|
|
read GetItem write SetItem; default;
|
|
procedure Assign(Source: TPersistent); override;
|
|
end;
|
|
|
|
|
|
{ TCustomListView }
|
|
|
|
TItemChange = (ctText, ctImage, ctState);
|
|
TViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport);
|
|
|
|
TItemFind = (ifData, ifPartialString, ifExactString, ifNearest);
|
|
TSearchDirection = (sdLeft, sdRight, sdAbove, sdBelow, sdAll);
|
|
|
|
TLVChangeEvent = procedure(Sender: TObject; Item: TListItem;
|
|
Change: TItemChange) of object;
|
|
|
|
TLVDataFindEvent = procedure(Sender: TObject; AFind: TItemFind;
|
|
const AFindString: string; const AFindPosition: TPoint; AFindData: Pointer;
|
|
AStartIndex: Integer; ADirection: TSearchDirection; AWrap: Boolean;
|
|
var AIndex: Integer) of object;
|
|
|
|
TLVDataHintEvent = procedure(Sender: TObject; StartIndex, EndIndex: Integer) of object;
|
|
TLVDataStateChangeEvent = procedure(Sender: TObject; StartIndex,
|
|
EndIndex: Integer; OldState, NewState: TListItemStates) of object;
|
|
|
|
TLVColumnClickEvent = procedure(Sender: TObject;
|
|
Column: TListColumn) of object;
|
|
TLVColumnRClickEvent = procedure(Sender: TObject; Column: TListColumn;
|
|
Point: TPoint) of object;
|
|
TLVCompare = function(Item1, Item2: TListItem; AOptionalParam: PtrInt): Integer stdcall;
|
|
TLVCompareEvent = procedure(Sender: TObject; Item1, Item2: TListItem;
|
|
Data: Integer; var Compare: Integer) of object;
|
|
TLVDeletedEvent = procedure(Sender: TObject; Item: TListItem) of object;
|
|
|
|
TLVEditingEvent = procedure(Sender: TObject; Item: TListItem;
|
|
var AllowEdit: Boolean) of object;
|
|
TLVEditedEvent = procedure(Sender: TObject; Item: TListItem;
|
|
var AValue: string) of object;
|
|
|
|
TLVInsertEvent = TLVDeletedEvent;
|
|
TLVDataEvent = TLVDeletedEvent;
|
|
TLVCheckedItemEvent = procedure (Sender: TObject; Item: TListItem) of object;
|
|
TLVSelectItemEvent = procedure(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean) of object;
|
|
TLVCustomDrawEvent = procedure(Sender: TCustomListView; const ARect: TRect;
|
|
var DefaultDraw: Boolean) of object;
|
|
TLVCustomDrawItemEvent = procedure(Sender: TCustomListView; Item: TListItem;
|
|
State: TCustomDrawState; var DefaultDraw: Boolean) of object;
|
|
TLVCustomDrawSubItemEvent=procedure(Sender: TCustomListView; Item: TListItem;
|
|
SubItem: Integer; State: TCustomDrawState;
|
|
var DefaultDraw: Boolean) of object;
|
|
TLVDrawItemEvent = procedure(Sender: TCustomListView; AItem: TListItem; ARect: TRect;
|
|
AState: TOwnerDrawState) of object;
|
|
TLVAdvancedCustomDrawEvent = procedure(Sender: TCustomListView; const ARect: TRect;
|
|
Stage: TCustomDrawStage; var DefaultDraw: Boolean) of object;
|
|
TLVAdvancedCustomDrawItemEvent = procedure(Sender: TCustomListView; Item: TListItem;
|
|
State: TCustomDrawState; Stage: TCustomDrawStage;
|
|
var DefaultDraw: Boolean) of object;
|
|
TLVAdvancedCustomDrawSubItemEvent=procedure(Sender: TCustomListView; Item: TListItem;
|
|
SubItem: Integer; State: TCustomDrawState;
|
|
Stage: TCustomDrawStage; var DefaultDraw: Boolean) of object;
|
|
TLVCreateItemClassEvent = procedure(Sender: TCustomListView; var ItemClass: TListItemClass) of object;
|
|
|
|
TListViewProperty = (
|
|
lvpAutoArrange,
|
|
lvpCheckboxes,
|
|
lvpColumnClick,
|
|
lvpFlatScrollBars,
|
|
lvpFullDrag,
|
|
lvpGridLines,
|
|
lvpHideSelection,
|
|
lvpHotTrack,
|
|
lvpMultiSelect,
|
|
lvpOwnerDraw,
|
|
lvpReadOnly,
|
|
lvpRowSelect,
|
|
lvpShowColumnHeaders,
|
|
lvpShowWorkAreas,
|
|
lvpWrapText,
|
|
lvpToolTips
|
|
);
|
|
TListViewProperties = set of TListViewProperty;
|
|
|
|
TListViewImageList = (lvilSmall, lvilLarge, lvilState);
|
|
|
|
TListHotTrackStyle = (htHandPoint, htUnderlineCold, htUnderlineHot);
|
|
TListHotTrackStyles = set of TListHotTrackStyle;
|
|
|
|
TListViewFlag = (
|
|
lffSelectedValid,
|
|
lffItemsMoving,
|
|
lffItemsSorting,
|
|
lffPreparingSorting // do not trigger when we are setting more rules
|
|
);
|
|
TListViewFlags = set of TListViewFlag;
|
|
|
|
TSortDirection = (sdAscending, sdDescending);
|
|
|
|
{ TCustomListViewEditor }
|
|
{used to provide multiplatform TCustomListView editing ability}
|
|
TCustomListViewEditor = class(TCustomEdit)
|
|
private
|
|
FItem: TListItem;
|
|
procedure ListViewEditorKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
protected
|
|
procedure DoExit; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property Item: TListItem read FItem write FItem;
|
|
end;
|
|
|
|
{ TCustomListView }
|
|
|
|
TCustomListView = class(TWinControl)
|
|
private
|
|
FEditor: TCustomListViewEditor;
|
|
FAllocBy: Integer;
|
|
FAutoSort: Boolean;
|
|
FAutoSortIndicator: Boolean;
|
|
FAutoWidthLastColumn: Boolean;
|
|
FCanvas: TCanvas;
|
|
FDefaultItemHeight: integer;
|
|
FHotTrackStyles: TListHotTrackStyles;
|
|
FIconOptions: TIconOptions;
|
|
FOnEdited: TLVEditedEvent;
|
|
FOnEditing: TLVEditingEvent;
|
|
|
|
FOwnerData: Boolean;
|
|
FOwnerDataItem: TOwnerDataListItem;
|
|
FListItems: TListItems;
|
|
FColumns: TListColumns;
|
|
FImages: array[TListViewImageList] of TCustomImageList;
|
|
FImagesWidth: array[TListViewImageList] of Integer;
|
|
FImageChangeLinks: array[TListViewImageList] of TChangeLink;
|
|
FFlags: TListViewFlags;
|
|
FShowEditorQueued: boolean;
|
|
FSortDirection: TSortDirection;
|
|
|
|
FViewStyle: TViewStyle;
|
|
FSortType: TSortType;
|
|
FSortColumn: Integer;
|
|
FCustomSort_Func: TLVCompare;
|
|
FCustomSort_Param: PtrInt;
|
|
FScrollBars: TScrollStyle;
|
|
FViewOriginCache: TPoint; // scrolled originwhile handle is not created
|
|
FSelected: TListItem; // temp copy of the selected item
|
|
FFocused: TListItem; // temp copy of the focused item
|
|
FSelectedIdx: Integer; // Index of Selected item, used if OwnerData = True;
|
|
FHoverTime: Integer; // temp copy of the hover time (the time a mouse must be over a item to auto select)
|
|
// MWE: not used: see updateScrollbars
|
|
// FLastHorzScrollInfo: TScrollInfo;
|
|
// FLastVertScrollInfo: TScrollInfo;
|
|
FUpdateCount: integer;
|
|
FOnChange: TLVChangeEvent;
|
|
FOnColumnClick: TLVColumnClickEvent;
|
|
FOnCompare: TLVCompareEvent;
|
|
FOnData: TLVDataEvent;
|
|
FOnDataFind: TLVDataFindEvent;
|
|
FOnDataHint: TLVDataHintEvent;
|
|
FOnDataStateChange: TLVDataStateChangeEvent;
|
|
FOnDeletion: TLVDeletedEvent;
|
|
FOnInsert: TLVInsertEvent;
|
|
FOnItemChecked: TLVCheckedItemEvent;
|
|
FOnSelectItem: TLVSelectItemEvent;
|
|
FOnCustomDraw: TLVCustomDrawEvent;
|
|
FOnCustomDrawItem: TLVCustomDrawItemEvent;
|
|
FOnCustomDrawSubItem: TLVCustomDrawSubItemEvent;
|
|
FOnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent;
|
|
FOnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent;
|
|
FOnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent;
|
|
FProperties: TListViewProperties;
|
|
function GetBoundingRect: TRect;
|
|
function GetColumnCount: Integer;
|
|
function GetColumnFromIndex(AIndex: Integer): TListColumn;
|
|
function GetDropTarget: TListItem;
|
|
function GetFocused: TListItem;
|
|
function GetImageList(const ALvilOrd: Integer): TCustomImageList;
|
|
function GetImageListWidth(const ALvilOrd: Integer): Integer;
|
|
function GetHoverTime: Integer;
|
|
function GetItemIndex: Integer;
|
|
function GetProperty(const ALvpOrd: Integer): Boolean;
|
|
function GetSelCount: Integer;
|
|
function GetSelection: TListItem;
|
|
function GetTopItem: TListItem;
|
|
function GetViewOrigin: TPoint;
|
|
function GetVisibleRowCount: Integer;
|
|
|
|
procedure ResizeLastColumn;
|
|
procedure SetAllocBy(const AValue: Integer);
|
|
procedure SetAutoWidthLastColumn(AValue: Boolean);
|
|
procedure SetColumns(const AValue: TListColumns);
|
|
procedure SetDefaultItemHeight(AValue: Integer);
|
|
procedure SetDropTarget(const AValue: TListItem);
|
|
procedure SetFocused(const AValue: TListItem);
|
|
procedure SetHotTrackStyles(const AValue: TListHotTrackStyles);
|
|
procedure SetHoverTime(const AValue: Integer);
|
|
procedure SetIconOptions(const AValue: TIconOptions);
|
|
procedure SetImageList(const ALvilOrd: Integer; const AValue: TCustomImageList);
|
|
procedure SetImageListWidth(const ALvilOrd: Integer; const AValue: Integer);
|
|
procedure SetImageListWS(const ALvil: TListViewImageList);
|
|
procedure SetItemIndex(const AValue: Integer);
|
|
procedure SetItems(const AValue : TListItems);
|
|
procedure SetItemVisible(const AValue: TListItem; const APartialOK: Boolean);
|
|
procedure SetOwnerData(const AValue: Boolean);
|
|
procedure SetProperty(const ALvpOrd: Integer; const AIsSet: Boolean);
|
|
procedure SetScrollBars(const AValue: TScrollStyle);
|
|
procedure SetSelection(const AValue: TListItem);
|
|
procedure SetShowEditorQueued(AValue: boolean);
|
|
procedure SetSortColumn(const AValue: Integer);
|
|
procedure SetSortDirection(const AValue: TSortDirection);
|
|
procedure SetSortType(const AValue: TSortType);
|
|
procedure SetViewOrigin(AValue: TPoint);
|
|
procedure SetViewStyle(const Avalue: TViewStyle);
|
|
procedure QueuedShowEditor(Data: PtrInt);
|
|
procedure SortWithParams(ACompareFunc: TListSortCompare);
|
|
procedure UpdateScrollbars;
|
|
procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY;
|
|
procedure CNDrawItem(var Message: TLMDrawListItem); message CN_DRAWITEM;
|
|
procedure InvalidateSelected;
|
|
procedure ImageResolutionHandleDestroyed(Sender: TCustomImageList;
|
|
AWidth: Integer; AReferenceHandle: TLCLHandle);
|
|
procedure SetImageListAsync(Data: PtrInt);
|
|
private
|
|
FOnCreateItemClass: TLVCreateItemClassEvent;
|
|
FOnDrawItem: TLVDrawItemEvent;
|
|
procedure HideEditor;
|
|
procedure ShowEditor;
|
|
procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL;
|
|
procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL;
|
|
property ShowEditorQueued: boolean read FShowEditorQueued write SetShowEditorQueued;
|
|
protected
|
|
//called by TListItems
|
|
procedure ItemDeleted(const AItem: TListItem);
|
|
procedure ItemInserted(const AItem: TListItem);
|
|
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure InitializeWnd; override;
|
|
procedure FinalizeWnd; override;
|
|
procedure DestroyWnd; override;
|
|
procedure BeginAutoDrag; override;
|
|
|
|
function CreateListItem: TListItem; virtual;
|
|
function CreateListItems: TListItems; virtual;
|
|
function CanEdit(Item: TListItem): Boolean; virtual;
|
|
procedure Change(AItem: TListItem; AChange: Integer); virtual;
|
|
procedure ColClick(AColumn: TListColumn); virtual;
|
|
|
|
procedure Delete(AItem : TListItem); virtual;
|
|
procedure DoDeletion(AItem: TListItem); virtual;
|
|
procedure DoInsert(AItem: TListItem); virtual;
|
|
procedure InsertItem(AItem : TListItem); virtual;
|
|
procedure DoItemChecked(AItem: TListItem);
|
|
procedure DoSelectItem(AItem: TListItem; ASelected: Boolean); virtual;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
|
|
|
procedure DoEndEdit(AItem: TListItem; const AValue: String); virtual;
|
|
procedure Edit(AItem: TListItem); virtual;
|
|
|
|
procedure ImageChanged(Sender : TObject);
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
function IsCustomDrawn(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage): Boolean; virtual;
|
|
function CustomDraw(const ARect: TRect; AStage: TCustomDrawStage): Boolean; virtual; // Return True if default drawing should be done
|
|
function CustomDrawItem(AItem: TListItem; AState: TCustomDrawState; AStage: TCustomDrawStage): Boolean; virtual; //
|
|
function CustomDrawSubItem(AItem: TListItem; ASubItem: Integer; AState: TCustomDrawState; AStage: TCustomDrawStage): Boolean; virtual; //
|
|
function IntfCustomDraw(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage; AItem, ASubItem: Integer; AState: TCustomDrawState; const ARect: PRect): TCustomDrawResult;
|
|
function GetUpdateCount: Integer;
|
|
procedure DrawItem(AItem: TListItem; ARect: TRect; AState: TOwnerDrawState);
|
|
|
|
procedure DoGetOwnerData(Item: TListItem); virtual;
|
|
function DoOwnerDataHint(AStartIndex, AEndIndex: Integer): Boolean; virtual;
|
|
function DoOwnerDataStateChange(AStartIndex, AEndIndex: Integer; AOldState,
|
|
ANewState: TListItemStates): Boolean; virtual;
|
|
protected
|
|
procedure DblClick; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
protected
|
|
property AllocBy: Integer read FAllocBy write SetAllocBy default 0;
|
|
property AutoSort: Boolean read FAutoSort write FAutoSort default True;
|
|
property AutoSortIndicator: Boolean read FAutoSortIndicator write FAutoSortIndicator default False;
|
|
property AutoWidthLastColumn: Boolean read FAutoWidthLastColumn write SetAutoWidthLastColumn default False;
|
|
property ColumnClick: Boolean index Ord(lvpColumnClick) read GetProperty write SetProperty default True;
|
|
property Columns: TListColumns read FColumns write SetColumns;
|
|
property DefaultItemHeight: integer read FDefaultItemHeight write SetDefaultItemHeight;
|
|
property HideSelection: Boolean index Ord(lvpHideSelection) read GetProperty write SetProperty default True;
|
|
property HoverTime: Integer read GetHoverTime write SetHoverTime default -1;
|
|
property LargeImages: TCustomImageList index Ord(lvilLarge) read GetImageList write SetImageList;
|
|
property LargeImagesWidth: Integer index Ord(lvilLarge) read GetImageListWidth write SetImageListWidth default 0;
|
|
property OwnerDraw: Boolean index Ord(lvpOwnerDraw) read GetProperty write SetProperty default False;
|
|
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
|
|
property ShowColumnHeaders: Boolean index Ord(lvpShowColumnHeaders) read GetProperty write SetProperty default True;
|
|
property ShowWorkAreas: Boolean index Ord(lvpShowWorkAreas) read GetProperty write SetProperty default False;
|
|
property SmallImages: TCustomImageList index Ord(lvilSmall) read GetImageList write SetImageList;
|
|
property SmallImagesWidth: Integer index Ord(lvilSmall) read GetImageListWidth write SetImageListWidth default 0;
|
|
property SortType: TSortType read FSortType write SetSortType default stNone;
|
|
property SortColumn: Integer read FSortColumn write SetSortColumn default -1;
|
|
property SortDirection: TSortDirection read FSortDirection write SetSortDirection default sdAscending;
|
|
property StateImages: TCustomImageList index Ord(lvilState) read GetImageList write SetImageList;
|
|
property StateImagesWidth: Integer index Ord(lvilState) read GetImageListWidth write SetImageListWidth default 0;
|
|
property ToolTips: Boolean index Ord(lvpToolTips) read GetProperty write SetProperty default True;
|
|
property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsList;
|
|
property OnChange: TLVChangeEvent read FOnChange write FOnChange;
|
|
property OnColumnClick: TLVColumnClickEvent read FOnColumnClick write FOnColumnClick;
|
|
property OnCompare: TLVCompareEvent read FOnCompare write FOnCompare;
|
|
property OnCreateItemClass: TLVCreateItemClassEvent read FOnCreateItemClass write FOnCreateItemClass;
|
|
property OnData: TLVDataEvent read FOnData write FOnData;
|
|
property OnDataFind: TLVDataFindEvent read FOnDataFind write FOnDataFind;
|
|
property OnDataHint: TLVDataHintEvent read FOnDataHint write FOnDataHint;
|
|
property OnDataStateChange: TLVDataStateChangeEvent read FOnDataStateChange write FOnDataStateChange;
|
|
property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion;
|
|
property OnEdited: TLVEditedEvent read FOnEdited write FOnEdited;
|
|
property OnEditing: TLVEditingEvent read FOnEditing write FOnEditing;
|
|
property OnInsert: TLVInsertEvent read FOnInsert write FOnInsert;
|
|
property OnItemChecked: TLVCheckedItemEvent read FOnItemChecked write FOnItemChecked;
|
|
property OnSelectItem: TLVSelectItemEvent read FOnSelectItem write FOnSelectItem;
|
|
property OnCustomDraw: TLVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
|
|
property OnCustomDrawItem: TLVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
|
|
property OnCustomDrawSubItem: TLVCustomDrawSubItemEvent read FOnCustomDrawSubItem write FOnCustomDrawSubItem;
|
|
property OnDrawItem: TLVDrawItemEvent read FOnDrawItem write FOnDrawItem; // Owner drawn item.Event triggers only when OwnerDraw=True and ListStyle=vsReport
|
|
property OnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw;
|
|
property OnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem;
|
|
property OnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent read FOnAdvancedCustomDrawSubItem write FOnAdvancedCustomDrawSubItem;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure AddItem(Item: string; AObject: TObject);
|
|
function AlphaSort: Boolean; // always sorts column 0 in sdAscending order
|
|
procedure Sort;
|
|
function CustomSort(ASortProc: TLVCompare; AOptionalParam: PtrInt): Boolean;
|
|
procedure BeginUpdate;
|
|
procedure Clear;
|
|
procedure EndUpdate;
|
|
procedure Repaint; override;
|
|
function FindCaption(StartIndex: Integer; Value: string;
|
|
Partial, Inclusive, Wrap: Boolean; PartStart: Boolean = True): TListItem;
|
|
function FindData(StartIndex: Integer; Value: Pointer; Inclusive, Wrap: Boolean): TListItem;
|
|
function GetHitTestInfoAt(X, Y: Integer): THitTests;
|
|
function GetItemAt(x,y: integer): TListItem;
|
|
|
|
|
|
{GetNearestItem is used to locate a list item from a position specified in
|
|
pixel coordinates relative to the top left corner of the list view.
|
|
It starts looking at the position specified by the Point parameter,
|
|
and moves in the direction indicated by the Direction parameter
|
|
until it locates a list item.If no item is found Nil is returned.}
|
|
function GetNearestItem(APoint: TPoint; Direction: TSearchDirection): TListItem;
|
|
|
|
{Used to find the next list item after StartItem in the direction
|
|
given by the Direction parameter.
|
|
Only items in the state indicated by the States parameter are considered.
|
|
If no item is found Nil is returned.}
|
|
function GetNextItem(StartItem: TListItem; Direction: TSearchDirection; States: TListItemStates): TListItem;
|
|
|
|
procedure ClearSelection;
|
|
procedure SelectAll;
|
|
|
|
function IsEditing: Boolean; // Delphi compatibile function which returns if our listview editor is active
|
|
property BoundingRect: TRect read GetBoundingRect;
|
|
property BorderStyle default bsSingle;
|
|
property Canvas: TCanvas read FCanvas;
|
|
property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False;
|
|
property Column[AIndex: Integer]: TListColumn read GetColumnFromIndex;
|
|
property ColumnCount: Integer read GetColumnCount;
|
|
property DropTarget: TListItem read GetDropTarget write SetDropTarget;
|
|
property FlatScrollBars: Boolean index Ord(lvpFlatScrollBars) read GetProperty write SetProperty default False;
|
|
property FullDrag: Boolean index Ord(lvpFullDrag) read GetProperty write SetProperty default False;
|
|
property GridLines: Boolean index Ord(lvpGridLines) read GetProperty write SetProperty default False;
|
|
property HotTrack: Boolean index Ord(lvpHotTrack) read GetProperty write SetProperty default False;
|
|
property HotTrackStyles: TListHotTrackStyles read FHotTrackStyles write SetHotTrackStyles default [];
|
|
property IconOptions: TIconOptions read FIconOptions write SetIconOptions;
|
|
property ItemFocused: TListItem read GetFocused write SetFocused;
|
|
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
|
|
property Items: TListItems read FListItems write SetItems;
|
|
// MultiSelect and ReadOnly should be protected, but can't because Carbon Interface
|
|
// needs to access this property and it cannot cast to TListItem, because we have
|
|
// other classes descending from TCustomListItem which need to work too
|
|
property MultiSelect: Boolean index Ord(lvpMultiselect) read GetProperty write SetProperty default False;
|
|
property OwnerData: Boolean read FOwnerData write SetOwnerData default False;
|
|
property ReadOnly: Boolean index Ord(lvpReadOnly) read GetProperty write SetProperty default False;
|
|
property RowSelect: Boolean index Ord(lvpRowSelect) read GetProperty write SetProperty default False;
|
|
property SelCount: Integer read GetSelCount;
|
|
property Selected: TListItem read GetSelection write SetSelection;
|
|
property LastSelected: TListItem read FSelected;
|
|
property TabStop default true;
|
|
property TopItem: TListItem read GetTopItem;
|
|
property ViewOrigin: TPoint read GetViewOrigin write SetViewOrigin;
|
|
property VisibleRowCount: Integer read GetVisibleRowCount;
|
|
end;
|
|
|
|
|
|
{ TListView }
|
|
|
|
TListView = class(TCustomListView)
|
|
published
|
|
property Align;
|
|
property AllocBy;
|
|
property Anchors;
|
|
property AutoSort;
|
|
property AutoSortIndicator;
|
|
property AutoWidthLastColumn: Boolean read FAutoWidthLastColumn write SetAutoWidthLastColumn default False; // resize last column to fit width of TListView
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property BorderWidth;
|
|
property Checkboxes;
|
|
property Color default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
|
|
property Columns;
|
|
property ColumnClick;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property GridLines;
|
|
property HideSelection;
|
|
property IconOptions;
|
|
// ItemIndex shouldn't be published, see bug 16367
|
|
|
|
property Items;
|
|
property LargeImages;
|
|
property LargeImagesWidth;
|
|
property MultiSelect;
|
|
property OwnerData;
|
|
property OwnerDraw;
|
|
property ParentColor default False;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property RowSelect;
|
|
property ScrollBars;
|
|
property ShowColumnHeaders;
|
|
property ShowHint;
|
|
property SmallImages;
|
|
property SmallImagesWidth;
|
|
property SortColumn;
|
|
property SortDirection;
|
|
property SortType;
|
|
property StateImages;
|
|
property StateImagesWidth;
|
|
property TabStop;
|
|
property TabOrder;
|
|
property ToolTips;
|
|
property Visible;
|
|
property ViewStyle;
|
|
property OnAdvancedCustomDraw;
|
|
property OnAdvancedCustomDrawItem;
|
|
property OnAdvancedCustomDrawSubItem;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnColumnClick;
|
|
property OnCompare;
|
|
property OnContextPopup;
|
|
property OnCreateItemClass;
|
|
property OnCustomDraw;
|
|
property OnCustomDrawItem;
|
|
property OnCustomDrawSubItem;
|
|
property OnData;
|
|
property OnDataFind;
|
|
property OnDataHint;
|
|
property OnDataStateChange;
|
|
property OnDblClick;
|
|
property OnDeletion;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnEdited;
|
|
property OnEditing;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnInsert;
|
|
property OnItemChecked;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnMouseWheelHorz;
|
|
property OnMouseWheelLeft;
|
|
property OnMouseWheelRight;
|
|
property OnResize;
|
|
property OnSelectItem;
|
|
property OnShowHint;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
TProgressBarOrientation = (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown);
|
|
|
|
TProgressBarStyle = (pbstNormal, pbstMarquee);
|
|
|
|
{ TCustomProgressBar }
|
|
{
|
|
@abstract(Simple progressbar.)
|
|
Introduced by Author Name <stoppok@osibisa.ms.sub.org>
|
|
Currently maintained by Maintainer Name <stoppok@osibisa.ms.sub.org>
|
|
}
|
|
TCustomProgressBar = class(TWinControl)
|
|
private
|
|
FMin: Integer;
|
|
FMax: Integer;
|
|
FStep: Integer;
|
|
FPosition: Integer;
|
|
FSmooth: boolean;
|
|
FBarShowText: boolean;
|
|
FBarTextFormat: string;
|
|
FOrientation: TProgressBarOrientation;
|
|
FStyle: TProgressBarStyle;
|
|
function GetMin: Integer;
|
|
function GetMax: Integer;
|
|
function GetPosition: Integer;
|
|
procedure SetParams(AMin, AMax: Integer);
|
|
procedure SetMin(Value: Integer);
|
|
procedure SetMax(Value: Integer);
|
|
procedure SetPosition(Value: Integer);
|
|
procedure SetStep(Value: Integer);
|
|
procedure SetSmooth (Value : boolean);
|
|
procedure SetBarShowText (Value : boolean);
|
|
procedure SetOrientation (Value : TProgressBarOrientation);
|
|
procedure SetStyle(const AValue: TProgressBarStyle);
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure ApplyChanges;
|
|
procedure InitializeWnd; override;
|
|
procedure Loaded; override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure StepIt;
|
|
procedure StepBy(Delta: Integer);
|
|
public
|
|
property Max: Integer read GetMax write SetMax default 100;
|
|
property Min: Integer read GetMin write SetMin default 0;
|
|
property Orientation: TProgressBarOrientation read FOrientation write SetOrientation default pbHorizontal;
|
|
property Position: Integer read GetPosition write SetPosition default 0;
|
|
property Smooth : boolean read FSmooth write SetSmooth default False;
|
|
property Step: Integer read FStep write SetStep default 10;
|
|
property Style: TProgressBarStyle read FStyle write SetStyle default pbstNormal;
|
|
property BarShowText : boolean read FBarShowText write SetBarShowText default False;
|
|
end;
|
|
|
|
|
|
{ TProgressBar }
|
|
|
|
TProgressBar = class(TCustomProgressBar)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderWidth;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Hint;
|
|
property Max;
|
|
property Min;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property Orientation;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property Position;
|
|
property ShowHint;
|
|
property Smooth;
|
|
property Step;
|
|
property Style;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property BarShowText;
|
|
end;
|
|
|
|
|
|
TUDAlignButton = (udLeft, udRight, udTop, udBottom);
|
|
TUDOrientation = (udHorizontal, udVertical);
|
|
TUpDownDirection = (updNone, updUp, updDown);
|
|
TUDBtnType = (btNext, btPrev);
|
|
TUDClickEvent = procedure (Sender: TObject; Button: TUDBtnType) of object;
|
|
TUDChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object;
|
|
TUDChangingEventEx = procedure (Sender: TObject; var AllowChange: Boolean; NewValue: SmallInt; Direction: TUpDownDirection) of object;
|
|
|
|
{ TCustomUpDown }
|
|
|
|
|
|
TCustomUpDown = class(TCustomControl)
|
|
private
|
|
FAlignButton: TUDAlignButton;
|
|
FArrowKeys: Boolean;
|
|
FAssociate: TWinControl;
|
|
FCanChangeDir: TUpDownDirection;
|
|
FCanChangePos: SmallInt;
|
|
FIncrement: Integer;
|
|
FMax: SmallInt;
|
|
FMaxBtn: TControl; // TSpeedButton (TUpDownButton)
|
|
FMin: SmallInt;
|
|
FMinBtn: TControl; // TSpeedButton (TUpDownButton)
|
|
FMinRepeatInterval: Byte; //Interval starts at 300 and this must be smaller always
|
|
FMouseDownBounds : TRect;
|
|
FMouseTimerEvent: TProcedureOfObject; // the Min/MaxBtn's Click method
|
|
FMouseInsideComp: Boolean; // Used for MouseEnter and MouseLeave events.
|
|
FOnChanging: TUDChangingEvent;
|
|
FOnChangingEx: TUDChangingEventEx;
|
|
FOnClick: TUDClickEvent;
|
|
FOrientation: TUDOrientation;
|
|
FPosition: SmallInt;
|
|
FThousands: Boolean;
|
|
FWrap: Boolean;
|
|
FUseWS: Boolean;
|
|
procedure CheckMouseEntering;
|
|
procedure CheckMouseLeaving;
|
|
function GetPosition: SmallInt;
|
|
procedure BTimerExec(Sender : TObject);
|
|
function GetFlat: Boolean;
|
|
procedure SetAlignButton(Value: TUDAlignButton);
|
|
procedure SetArrowKeys(Value: Boolean);
|
|
procedure SetAssociate(Value: TWinControl);
|
|
procedure SetIncrement(Value: Integer);
|
|
procedure SetMax(Value: SmallInt);
|
|
procedure SetMin(Value: SmallInt);
|
|
procedure SetMinRepeatInterval(AValue: Byte);
|
|
procedure SetOrientation(Value: TUDOrientation);
|
|
procedure SetPosition(Value: SmallInt);
|
|
procedure SetThousands(Value: Boolean);
|
|
procedure SetFlat(Value: Boolean);
|
|
procedure SetWrap(Value: Boolean);
|
|
procedure UpdateAlignButtonPos;
|
|
procedure UpdateOrientation;
|
|
procedure UpdateUpDownPositionText;
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure AdjustPos(incPos: Boolean);
|
|
procedure InitializeWnd; override;
|
|
procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
|
|
procedure AssociateMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint; var Handled: Boolean);
|
|
procedure OnAssociateChangeBounds(Sender: TObject);
|
|
procedure OnAssociateChangeEnabled(Sender: TObject);
|
|
procedure OnAssociateChangeVisible(Sender: TObject);
|
|
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
|
procedure SetEnabled(Value: Boolean); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
function CanChange: Boolean; virtual;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Click(Button: TUDBtnType); virtual; overload;
|
|
protected
|
|
property AlignButton: TUDAlignButton read FAlignButton write SetAlignButton default udRight;
|
|
property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True;
|
|
property Associate: TWinControl read FAssociate write SetAssociate;
|
|
property Increment: Integer read FIncrement write SetIncrement default 1;
|
|
property Max: SmallInt read FMax write SetMax default 100;
|
|
property Min: SmallInt read FMin write SetMin;
|
|
property MinRepeatInterval: Byte read FMinRepeatInterval write SetMinRepeatInterval default 100;
|
|
property OnChanging: TUDChangingEvent read FOnChanging write FOnChanging;
|
|
property OnChangingEx: TUDChangingEventEx read FOnChangingEx write FOnChangingEx;
|
|
property OnClick: TUDClickEvent read FOnClick write FOnClick;
|
|
property Orientation: TUDOrientation read FOrientation write SetOrientation default udVertical;
|
|
property Position: SmallInt read GetPosition write SetPosition;
|
|
property Thousands: Boolean read FThousands write SetThousands default True;
|
|
property Flat: Boolean read GetFlat write SetFlat default False;
|
|
property Wrap: Boolean read FWrap write SetWrap default False;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; Override;
|
|
end;
|
|
|
|
|
|
{ TUpDown }
|
|
|
|
TUpDown = class(TCustomUpDown)
|
|
published
|
|
property Align;
|
|
property AlignButton;
|
|
property Anchors;
|
|
property ArrowKeys;
|
|
property Associate;
|
|
property BorderSpacing;
|
|
property Color;
|
|
property Constraints;
|
|
property Enabled;
|
|
property Hint;
|
|
property Increment;
|
|
property Max;
|
|
property Min;
|
|
property MinRepeatInterval;
|
|
property OnChanging;
|
|
property OnChangingEx;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnMouseWheelHorz;
|
|
property OnMouseWheelLeft;
|
|
property OnMouseWheelRight;
|
|
property Orientation;
|
|
property ParentColor;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property Position;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Thousands;
|
|
property Flat;
|
|
property Visible;
|
|
property Wrap;
|
|
end;
|
|
|
|
|
|
{ TToolButton }
|
|
|
|
const
|
|
CN_DROPDOWNCLOSED = LM_USER + $1000;
|
|
|
|
type
|
|
TToolButtonStyle =
|
|
(
|
|
tbsButton, // button (can be clicked)
|
|
tbsCheck, // check item (click to toggle state, can be grouped)
|
|
tbsDropDown, // button with dropdown button to show a popup menu
|
|
tbsSeparator, // space holder
|
|
tbsDivider, // space holder with line
|
|
tbsButtonDrop // button with arrow (not separated from each other)
|
|
);
|
|
|
|
TToolButtonFlag =
|
|
(
|
|
tbfPressed, // set while mouse is pressed on button
|
|
tbfArrowPressed,// set while mouse is pressed on arrow button
|
|
tbfMouseInArrow,// set while mouse is on arrow button
|
|
tbfDropDownMenuShown // set while dropdownmenu is shown
|
|
);
|
|
TToolButtonFlags = set of TToolButtonFlag;
|
|
|
|
{ TToolButtonActionLink }
|
|
|
|
TToolButtonActionLink = class(TControlActionLink)
|
|
protected
|
|
procedure AssignClient(AClient: TObject); override;
|
|
procedure SetChecked(Value: Boolean); override;
|
|
procedure SetImageIndex(Value: Integer); override;
|
|
public
|
|
function IsCheckedLinked: Boolean; override;
|
|
function IsImageIndexLinked: Boolean; override;
|
|
end;
|
|
|
|
TToolButtonActionLinkClass = class of TToolButtonActionLink;
|
|
|
|
TToolBar = class;
|
|
|
|
TToolButton = class(TGraphicControl)
|
|
private
|
|
FAllowAllUp: Boolean;
|
|
FDown: Boolean;
|
|
FDropdownMenu: TPopupMenu;
|
|
FGrouped: Boolean;
|
|
FImageIndex: TImageIndex;
|
|
FIndeterminate: Boolean;
|
|
FMarked: Boolean;
|
|
FMenuItem: TMenuItem;
|
|
FMouseInControl: boolean;
|
|
FOnArrowClick: TNotifyEvent;
|
|
FShowCaption: boolean;
|
|
FStyle: TToolButtonStyle;
|
|
FToolButtonFlags: TToolButtonFlags;
|
|
FUpdateCount: Integer;
|
|
FWrap: Boolean;
|
|
FLastDropDownTick: QWord;
|
|
FLastDown: Boolean;
|
|
procedure GetGroupBounds(var StartIndex, EndIndex: integer);
|
|
function GetIndex: Integer;
|
|
function GetTextSize: TSize;
|
|
function IsCheckedStored: Boolean;
|
|
function IsHeightStored: Boolean;
|
|
function IsImageIndexStored: Boolean;
|
|
function IsWidthStored: Boolean;
|
|
procedure SetDown(Value: Boolean);
|
|
procedure SetDropdownMenu(Value: TPopupMenu);
|
|
procedure SetGrouped(Value: Boolean);
|
|
procedure SetImageIndex(Value: TImageIndex);
|
|
procedure SetIndeterminate(Value: Boolean);
|
|
procedure SetMarked(Value: Boolean);
|
|
procedure SetMenuItem(Value: TMenuItem);
|
|
procedure SetShowCaption(const AValue: boolean);
|
|
procedure SetStyle(Value: TToolButtonStyle);
|
|
procedure SetWrap(Value: Boolean);
|
|
procedure SetMouseInControl(NewMouseInControl: Boolean);
|
|
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
|
|
procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
|
|
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
|
|
protected const
|
|
cDefSeparatorWidth = 8;
|
|
cDefDividerWidth = 5;
|
|
cDefButtonDropDecArrowWidth = 2;
|
|
protected
|
|
FToolBar: TToolBar;
|
|
class procedure WSRegisterClass; override;
|
|
procedure CopyPropertiesFromMenuItem(const Value: TMenuItem);
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
procedure BeginUpdate; virtual;
|
|
procedure EndUpdate; virtual;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure TextChanged; override;
|
|
procedure CalculatePreferredSize(
|
|
var PreferredWidth, PreferredHeight: integer;
|
|
WithThemeSpace: Boolean); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure Loaded; override;
|
|
procedure RefreshControl; virtual;
|
|
procedure SetToolBar(NewToolBar: TToolBar);
|
|
procedure UpdateControl; virtual;
|
|
function GetButtonDrawDetail: TThemedElementDetails; virtual;
|
|
procedure SetParent(AParent: TWinControl); override;
|
|
procedure UpdateVisibleToolbar;
|
|
function GroupAllUpAllowed: boolean;
|
|
function DialogChar(var Message: TLMKey): boolean; override;
|
|
procedure SetAutoSize(Value: Boolean); override;
|
|
procedure RealSetText(const AValue: TCaption); override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
function CheckMenuDropdown: Boolean; virtual;
|
|
procedure Click; override;
|
|
procedure ArrowClick; virtual;
|
|
procedure GetCurrentIcon(var ImageList: TCustomImageList;
|
|
var TheIndex: integer;
|
|
var TheEffect: TGraphicsDrawEffect); virtual;
|
|
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
Raw: boolean = false;
|
|
WithThemeSpace: boolean = true); override;
|
|
property Index: Integer read GetIndex;
|
|
function PointInArrow(const X, Y: Integer): Boolean;
|
|
published
|
|
property Action;
|
|
property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;
|
|
property AutoSize default False;
|
|
property Caption;
|
|
property Down: Boolean read FDown write SetDown stored IsCheckedStored default False;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
|
|
property Enabled;
|
|
property Grouped: Boolean read FGrouped write SetGrouped default False;
|
|
property Height stored IsHeightStored;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
|
|
property Indeterminate: Boolean read FIndeterminate write SetIndeterminate default False;
|
|
property Marked: Boolean read FMarked write SetMarked default False;
|
|
property MenuItem: TMenuItem read FMenuItem write SetMenuItem;
|
|
property OnArrowClick: TNotifyEvent read FOnArrowClick write FOnArrowClick;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowCaption: boolean read FShowCaption write SetShowCaption default true;
|
|
property ShowHint;
|
|
property Style: TToolButtonStyle read FStyle write SetStyle default tbsButton;
|
|
property Visible;
|
|
property Width stored IsWidthStored;
|
|
property Wrap: Boolean read FWrap write SetWrap default False;
|
|
end;
|
|
|
|
{ TToolBarEnumerator }
|
|
|
|
TToolBarEnumerator = class
|
|
private
|
|
FToolBar: TToolBar;
|
|
FPosition: Integer;
|
|
function GetCurrent: TToolButton;
|
|
public
|
|
constructor Create(AToolBar: TToolBar);
|
|
function MoveNext: Boolean;
|
|
property Current: TToolButton read GetCurrent;
|
|
end;
|
|
|
|
{ TToolBar }
|
|
|
|
TToolBarOnPaintButton = procedure(Sender: TToolButton; State: integer) of object;
|
|
|
|
TToolBarFlag = (
|
|
tbfUpdateVisibleBarNeeded,
|
|
tbfPlacingControls
|
|
);
|
|
|
|
TToolBarFlags = set of TToolBarFlag;
|
|
|
|
TToolBar = class(TToolWindow)
|
|
private
|
|
FOnPaint: TNotifyEvent;
|
|
FOnPaintButton: TToolBarOnPaintButton;
|
|
FButtonHeight: Integer;
|
|
FRealizedButtonHeight,
|
|
FRealizedButtonWidth,
|
|
FRealizedDropDownWidth,
|
|
FRealizedButtonDropWidth: integer;
|
|
FButtons: TList;
|
|
FButtonWidth: Integer;
|
|
FDisabledImageChangeLink: TChangeLink;
|
|
FDisabledImages: TCustomImageList;
|
|
FDropDownWidth: integer;
|
|
FThemeDropDownWidth: integer;
|
|
FThemeButtonDropWidth: integer;
|
|
FDropDownButton: TToolButton;
|
|
FFlat: Boolean;
|
|
FHotImageChangeLink: TChangeLink;
|
|
FHotImages: TCustomImageList;
|
|
FImageChangeLink: TChangeLink;
|
|
FImages: TCustomImageList;
|
|
FIndent: Integer;
|
|
FList: Boolean;
|
|
FNewStyle: Boolean;
|
|
FRowCount: integer;
|
|
FShowCaptions: Boolean;
|
|
FCurrentMenu: TPopupMenu;
|
|
FCurrentMenuAutoFree: boolean;
|
|
FSrcMenu: TMenu;
|
|
FSrcMenuItem: TMenuItem;
|
|
FToolBarFlags: TToolBarFlags;
|
|
FWrapable: Boolean;
|
|
FImagesWidth: Integer;
|
|
procedure ApplyFontForButtons;
|
|
procedure CloseCurrentMenu;
|
|
function GetButton(Index: Integer): TToolButton;
|
|
function GetButtonCount: Integer;
|
|
function GetButtonDropWidth: Integer;
|
|
function GetButtonWidth: Integer;
|
|
function GetButtonHeight: Integer;
|
|
function GetDropDownWidth: Integer;
|
|
function GetTransparent: Boolean;
|
|
procedure SetButtonHeight(const AValue: Integer);
|
|
procedure SetButtonWidth(const AValue: Integer);
|
|
procedure SetDisabledImages(const AValue: TCustomImageList);
|
|
procedure SetDropDownWidth(const ADropDownWidth: Integer);
|
|
procedure SetFlat(const AValue: Boolean);
|
|
procedure SetHotImages(const AValue: TCustomImageList);
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
|
procedure SetIndent(const AValue: Integer);
|
|
procedure SetList(const AValue: Boolean);
|
|
procedure SetShowCaptions(const AValue: Boolean);
|
|
procedure SetTransparent(const AValue: Boolean);
|
|
procedure SetWrapable(const AValue: Boolean);
|
|
procedure ToolButtonDown(AButton: TToolButton; NewDown: Boolean);
|
|
procedure ImageListChange(Sender: TObject);
|
|
procedure DisabledImageListChange(Sender: TObject);
|
|
procedure HotImageListChange(Sender: TObject);
|
|
procedure UpdateVisibleBar;
|
|
procedure MoveSubMenuItems(SrcMenuItem, DestMenuItem: TMenuItem);
|
|
procedure AddButton(Button: TToolButton);
|
|
procedure RemoveButton(Button: TToolButton);
|
|
protected const
|
|
cDefButtonWidth = 23;
|
|
cDefButtonHeight = 22;
|
|
protected
|
|
FPrevVertical: Boolean;
|
|
function IsVertical: Boolean; virtual;
|
|
class procedure WSRegisterClass; override;
|
|
procedure AdjustClientRect(var ARect: TRect); override;
|
|
function ButtonHeightIsStored: Boolean;
|
|
function ButtonWidthIsStored: Boolean;
|
|
function DropDownWidthIsStored: Boolean;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure DoAutoSize; override;
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
function CheckMenuDropdown(Button: TToolButton): Boolean; virtual;
|
|
procedure ClickButton(Button: TToolButton); virtual;
|
|
procedure CreateWnd; override;
|
|
procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override;
|
|
function FindButtonFromAccel(Accel: Word): TToolButton;
|
|
procedure FontChanged(Sender: TObject); override;
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure RepositionButton(Index: Integer);
|
|
procedure RepositionButtons(Index: Integer);
|
|
function WrapButtons(UseSize: integer;
|
|
out NewWidth, NewHeight: Integer;
|
|
Simulate: boolean): Boolean;
|
|
procedure CNDropDownClosed(var Message: TLMessage); message CN_DROPDOWNCLOSED;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure EndUpdate; override;
|
|
procedure FlipChildren(AllLevels: Boolean); override;
|
|
function GetEnumerator: TToolBarEnumerator;
|
|
procedure SetButtonSize(NewButtonWidth, NewButtonHeight: integer);
|
|
function CanFocus: Boolean; override;
|
|
public
|
|
property ButtonCount: Integer read GetButtonCount;
|
|
property Buttons[Index: Integer]: TToolButton read GetButton;
|
|
property ButtonList: TList read FButtons;
|
|
property RowCount: Integer read FRowCount;
|
|
property ButtonDropWidth: Integer read GetButtonDropWidth;
|
|
published
|
|
property Align default alTop;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BorderSpacing;
|
|
property BorderWidth;
|
|
property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
|
|
property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
|
|
property Caption;
|
|
property ChildSizing;
|
|
property Constraints;
|
|
property Color;
|
|
property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth stored DropDownWidthIsStored;
|
|
property EdgeBorders default [ebTop];
|
|
property EdgeInner;
|
|
property EdgeOuter;
|
|
property Enabled;
|
|
property Flat: Boolean read FFlat write SetFlat default True;
|
|
property Font;
|
|
property Height default 32;
|
|
property HotImages: TCustomImageList read FHotImages write SetHotImages;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property Indent: Integer read FIndent write SetIndent default 1;
|
|
property List: Boolean read FList write SetList default False;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions default False;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Transparent: Boolean read GetTransparent write SetTransparent default False;
|
|
property Visible;
|
|
property Wrapable: Boolean read FWrapable write SetWrapable default True;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnPaintButton: TToolBarOnPaintButton read FOnPaintButton write FOnPaintButton;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
|
property OnResize;
|
|
property OnChangeBounds;
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
{ TCoolBar }
|
|
|
|
TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton);
|
|
TDragBand = (dbNone, dbMove, dbResize);
|
|
|
|
TCustomCoolBar = class;
|
|
|
|
{ TCoolBand }
|
|
|
|
TCoolBand = class(TCollectionItem)
|
|
private
|
|
FCoolBar: TCustomCoolBar;
|
|
FControl: TControl; // Associated control
|
|
FBitmap: TBitmap;
|
|
FBorderStyle: TBorderStyle;
|
|
FBreak: Boolean;
|
|
FColor: TColor;
|
|
FFixedBackground: Boolean;
|
|
FFixedSize: Boolean;
|
|
FHeight: Integer;
|
|
FHorizontalOnly: Boolean;
|
|
FImageIndex: TImageIndex;
|
|
FMinHeight: Integer;
|
|
FMinWidth: Integer;
|
|
FParentBitmap: Boolean;
|
|
FParentColor: Boolean;
|
|
FRealLeft: Integer;
|
|
FRealWidth: Integer;
|
|
FText: TTranslateString;
|
|
FVisible: Boolean;
|
|
FWidth: Integer;
|
|
FLeft: Integer;
|
|
FTop: Integer;
|
|
function IsBitmapStored: Boolean;
|
|
function IsColorStored: Boolean;
|
|
function GetRight: Integer;
|
|
function GetVisible: Boolean;
|
|
procedure SetBitmap(AValue: TBitmap);
|
|
procedure SetBorderStyle(AValue: TBorderStyle);
|
|
procedure SetBreak(AValue: Boolean);
|
|
procedure SetColor(AValue: TColor);
|
|
procedure SetControl(AValue: TControl);
|
|
procedure SetFixedBackground(AValue: Boolean);
|
|
procedure SetHorizontalOnly(AValue: Boolean);
|
|
procedure SetImageIndex(AValue: TImageIndex);
|
|
procedure SetMinHeight(AValue: Integer);
|
|
procedure SetMinWidth(AValue: Integer);
|
|
procedure SetParentBitmap(AValue: Boolean);
|
|
procedure SetParentColor(AValue: Boolean);
|
|
procedure SetText(const AValue: TTranslateString);
|
|
procedure SetVisible(AValue: Boolean);
|
|
procedure SetWidth(AValue: Integer);
|
|
protected const
|
|
cDefMinHeight = 25;
|
|
cDefMinWidth = 100;
|
|
cDefWidth = 180;
|
|
cDivider: SmallInt = 2;
|
|
cGrabIndent: SmallInt = 2;
|
|
protected
|
|
FControlLeft: Integer;
|
|
FControlTop: Integer;
|
|
FTextWidth: Integer;
|
|
function CalcControlLeft: Integer;
|
|
function CalcPreferredHeight: Integer;
|
|
function CalcPreferredWidth: Integer;
|
|
procedure CalcTextWidth;
|
|
function GetDisplayName: string; override;
|
|
public
|
|
constructor Create(aCollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(aSource: TPersistent); override;
|
|
procedure AutosizeWidth;
|
|
procedure InvalidateCoolBar(Sender: TObject);
|
|
property Height: Integer read FHeight;
|
|
property Left: Integer read FLeft;
|
|
property Right: Integer read GetRight;
|
|
property Top: Integer read FTop;
|
|
published
|
|
property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored;
|
|
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
|
|
property Break: Boolean read FBreak write SetBreak default True;
|
|
property Color: TColor read FColor write SetColor stored IsColorStored default clDefault;
|
|
property Control: TControl read FControl write SetControl;
|
|
property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True;
|
|
property FixedSize: Boolean read FFixedSize write FFixedSize default False;
|
|
property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight;
|
|
property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth;
|
|
property ParentColor: Boolean read FParentColor write SetParentColor default True;
|
|
property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True;
|
|
property Text: TTranslateString read FText write SetText;
|
|
property Visible: Boolean read GetVisible write SetVisible default True;
|
|
property Width: Integer read FWidth write SetWidth default cDefWidth;
|
|
end;
|
|
|
|
{ TCoolBands }
|
|
|
|
TCoolBands = class(TCollection)
|
|
private
|
|
FCoolBar: TCustomCoolBar;
|
|
function GetItem(Index: Integer): TCoolBand;
|
|
procedure SetItem(Index: Integer; Value: TCoolBand);
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
procedure Update(aItem: TCollectionItem); override;
|
|
procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override;
|
|
public
|
|
constructor Create(ACoolBar: TCustomCoolBar);
|
|
function Add: TCoolBand;
|
|
function FindBand(AControl: TControl): TCoolBand;
|
|
function FindBandIndex(AControl: TControl): Integer;
|
|
public
|
|
property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default;
|
|
end;
|
|
|
|
// BandMaximize is not used now but is needed for Delphi compatibility.
|
|
// It is not used in Delphi's TCoolBar either.
|
|
TCoolBandMaximize = (bmNone, bmClick, bmDblClick);
|
|
|
|
{ TCustomCoolBar }
|
|
|
|
TCustomCoolBar = class(TToolWindow)
|
|
private
|
|
FBands: TCoolBands;
|
|
FBandBorderStyle: TBorderStyle;
|
|
FBandMaximize: TCoolBandMaximize;
|
|
FBitmap: TBitmap;
|
|
FFixedSize: Boolean;
|
|
FFixedOrder: Boolean;
|
|
FGrabStyle: TGrabStyle;
|
|
FGrabWidth: Integer;
|
|
FHorizontalSpacing: Integer;
|
|
FImages: TCustomImageList;
|
|
FImageChangeLink: TChangeLink;
|
|
FOnChange: TNotifyEvent;
|
|
FShowText: Boolean;
|
|
FThemed: Boolean;
|
|
FVertical: Boolean;
|
|
FVerticalSpacing: Integer;
|
|
FImagesWidth: Integer;
|
|
function GetAlign: TAlign;
|
|
function RowEndHelper(ALeft, AVisibleIdx: Integer): Boolean;
|
|
procedure SetBandBorderStyle(AValue: TBorderStyle);
|
|
procedure SetBands(AValue: TCoolBands);
|
|
procedure SetBitmap(AValue: TBitmap);
|
|
procedure SetGrabStyle(AValue: TGrabStyle);
|
|
procedure SetGrabWidth(AValue: Integer);
|
|
procedure SetHorizontalSpacing(AValue: Integer);
|
|
procedure SetImages(AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
|
procedure SetShowText(AValue: Boolean);
|
|
procedure SetThemed(AValue: Boolean);
|
|
procedure SetVertical(AValue: Boolean);
|
|
procedure SetVerticalSpacing(AValue: Integer);
|
|
protected const
|
|
cDefGrabStyle = gsDouble;
|
|
cDefGrabWidth = 10;
|
|
cDefHorSpacing = 5;
|
|
cDefVertSpacing = 3;
|
|
cNewRowBelow: SmallInt = -1;
|
|
cNewRowAbove: SmallInt = -2;
|
|
protected
|
|
FBorderEdges: TEdgeBorders;
|
|
FBorderLeft, FBorderTop, FBorderRight, FBorderBottom: SmallInt;
|
|
FBorderWidth: SmallInt;
|
|
FCursorBkgnd: TCursor;
|
|
FDragBand: TDragBand;
|
|
FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area
|
|
FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands)
|
|
FLockCursor: Boolean;
|
|
FRightToLeft: Boolean;
|
|
FTextHeight: Integer;
|
|
FVisiBands: array of TCoolBand;
|
|
procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override;
|
|
procedure BitmapOrImageListChange(Sender: TObject);
|
|
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
{%H-}WithThemeSpace: Boolean); override;
|
|
procedure CalculateAndAlign;
|
|
function CalculateRealIndex(AVisibleIndex: Integer): Integer;
|
|
procedure ChangeCursor(ABand, AGrabber: Boolean);
|
|
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
|
|
procedure CreateWnd; override;
|
|
procedure DoFontChanged;
|
|
procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap);
|
|
procedure FontChanged(Sender: TObject); override;
|
|
function IsFirstAtRow(ABand: Integer): Boolean;
|
|
function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 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 SetAlign(aValue: TAlign); reintroduce;
|
|
procedure SetAutoSize(Value: Boolean); override;
|
|
procedure SetCursor(Value: TCursor); override;
|
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure AutosizeBands;
|
|
procedure EndUpdate; override;
|
|
procedure Invalidate; override;
|
|
procedure InsertControl(AControl: TControl; Index: integer); override;
|
|
procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean);
|
|
procedure RemoveControl(AControl: TControl); override;
|
|
public
|
|
property Align read GetAlign write SetAlign default alTop;
|
|
property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle;
|
|
property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick;
|
|
property Bands: TCoolBands read FBands write SetBands;
|
|
property Bitmap: TBitmap read FBitmap write SetBitmap;
|
|
property FixedSize: Boolean read FFixedSize write FFixedSize 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 HorizontalSpacing: Integer read FHorizontalSpacing write SetHorizontalSpacing default cDefHorSpacing;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property ShowText: Boolean read FShowText write SetShowText default True;
|
|
property Themed: Boolean read FThemed write SetThemed default True;
|
|
property Vertical: Boolean read FVertical write SetVertical default False;
|
|
property VerticalSpacing: Integer read FVerticalSpacing write SetVerticalSpacing default cDefVertSpacing;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
{ TCoolBar }
|
|
|
|
TCoolBar = class(TCustomCoolBar)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BandBorderStyle;
|
|
property BandMaximize;
|
|
property Bands;
|
|
property BiDiMode;
|
|
property BorderWidth;
|
|
property Color;
|
|
property Constraints;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property EdgeBorders;
|
|
property EdgeInner;
|
|
property EdgeOuter;
|
|
property Enabled;
|
|
property FixedSize;
|
|
property FixedOrder;
|
|
property Font;
|
|
property GrabStyle;
|
|
property GrabWidth;
|
|
property HorizontalSpacing;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property Bitmap;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property ShowText;
|
|
property Themed;
|
|
property Vertical;
|
|
property VerticalSpacing;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnGetSiteInfo;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
end;
|
|
|
|
{ TCustomTrackBar }
|
|
|
|
TTrackBarOrientation = (trHorizontal, trVertical);
|
|
TTickMark = (tmBottomRight, tmTopLeft, tmBoth);
|
|
TTickStyle = (tsNone, tsAuto, tsManual);
|
|
TTrackBarScalePos = (trLeft, trRight, trTop, trBottom);
|
|
|
|
TCustomTrackBar = class(TWinControl)
|
|
private
|
|
FOrientation: TTrackBarOrientation;
|
|
FReversed: Boolean;
|
|
FSelEnd: Integer;
|
|
FSelStart: Integer;
|
|
FShowSelRange: Boolean;
|
|
FTickMarks: TTickMark;
|
|
FTickStyle: TTickStyle;
|
|
FLineSize: Integer;
|
|
FPageSize: Integer;
|
|
FMin: Integer;
|
|
FMax: Integer;
|
|
FFrequency: Integer;
|
|
FPosition: Integer;
|
|
FScalePos: TTrackBarScalePos;
|
|
FScaleDigits: integer;
|
|
FOnChange: TNotifyEvent;
|
|
procedure SetFrequency(Value: Integer);
|
|
procedure SetLineSize(Value: Integer);
|
|
procedure SetMax(Value: Integer);
|
|
procedure SetMin(Value: Integer);
|
|
procedure SetOrientation(Value: TTrackBarOrientation);
|
|
procedure SetPageSize(Value: Integer);
|
|
procedure SetParams(APosition, AMin, AMax: Integer);
|
|
procedure SetPosition(Value: Integer);
|
|
procedure SetReversed(const AValue: Boolean);
|
|
procedure SetScalePos(Value: TTrackBarScalePos);
|
|
procedure SetSelEnd(const AValue: Integer);
|
|
procedure SetSelStart(const AValue: Integer);
|
|
procedure SetShowSelRange(const AValue: Boolean);
|
|
procedure SetTickMarks(Value: TTickMark);
|
|
procedure SetTickStyle(Value: TTickStyle);
|
|
procedure UpdateSelection;
|
|
protected
|
|
class procedure WSRegisterClass; override;
|
|
procedure ApplyChanges;
|
|
procedure Changed; virtual;
|
|
procedure DoChange(var msg); message LM_CHANGED;
|
|
procedure FixParams(var APosition, AMin, AMax: Integer);
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure InitializeWnd; override;
|
|
procedure Loaded; override;
|
|
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure SetTick(Value: Integer);
|
|
published
|
|
property AutoSize;
|
|
property Frequency: Integer read FFrequency write SetFrequency default 1;
|
|
property LineSize: Integer read FLineSize write SetLineSize default 1;
|
|
property Max: Integer read FMax write SetMax default 10;
|
|
property Min: Integer read FMin write SetMin default 0;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property Orientation: TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal;
|
|
property PageSize: Integer read FPageSize write SetPageSize default 2;
|
|
property Position: Integer read FPosition write SetPosition;
|
|
property Reversed: Boolean read FReversed write SetReversed default False;
|
|
property ScalePos: TTrackBarScalePos read FScalePos write SetScalePos default trTop;
|
|
property SelEnd: Integer read FSelEnd write SetSelEnd default 0;
|
|
property SelStart: Integer read FSelStart write SetSelStart default 0;
|
|
property ShowSelRange: Boolean read FShowSelRange write SetShowSelRange default True;
|
|
property TabStop default True;
|
|
property TickMarks: TTickMark read FTickMarks write SetTickMarks default tmBottomRight;
|
|
property TickStyle: TTickStyle read FTickStyle write SetTickStyle default tsAuto;
|
|
end;
|
|
|
|
|
|
{ TTrackBar }
|
|
|
|
TTrackBar = class(TCustomTrackBar)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Frequency;
|
|
property Hint;
|
|
property LineSize;
|
|
property Max;
|
|
property Min;
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnMouseWheelHorz;
|
|
property OnMouseWheelLeft;
|
|
property OnMouseWheelRight;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property Orientation;
|
|
property PageSize;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property Position;
|
|
property Reversed;
|
|
property ScalePos;
|
|
property SelEnd;
|
|
property SelStart;
|
|
property ShowHint;
|
|
property ShowSelRange;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property TickMarks;
|
|
property TickStyle;
|
|
property Visible;
|
|
end;
|
|
|
|
{ TTreeNode }
|
|
|
|
type
|
|
TCustomTreeView = class;
|
|
TTreeNodes = class;
|
|
TTreeNode = class;
|
|
TTreeNodeClass = class of TTreeNode;
|
|
|
|
TNodeState = (
|
|
nsCut, // = Node.Cut
|
|
nsDropHilited, // = Node.DropTarget
|
|
nsFocused, // = Node.Focused
|
|
nsSelected, // = Node.Selected
|
|
nsMultiSelected, // = Node.MultiSelected
|
|
nsExpanded, // = Node.Expanded
|
|
nsHasChildren, // = Node.HasChildren
|
|
nsDeleting, // = Node.Deleting, set on Destroy
|
|
nsVisible, // = Node.Visible
|
|
nsBound // bound to a tree, e.g. has Parent or is top lvl node
|
|
);
|
|
TNodeStates = set of TNodeState;
|
|
|
|
TNodeAttachMode = (
|
|
naAdd, // add as last sibling of Destination
|
|
naAddFirst, // add as first sibling of Destination
|
|
naAddChild, // add as last child of Destination
|
|
naAddChildFirst, // add as first child of Destination
|
|
naInsert, // insert in front of Destination
|
|
naInsertBehind // insert behind Destination
|
|
);
|
|
|
|
TAddMode = (taAddFirst, taAdd, taInsert);
|
|
|
|
TMultiSelectStyles = (msControlSelect, msShiftSelect, msVisibleOnly, msSiblingOnly);
|
|
TMultiSelectStyle = set of TMultiSelectStyles;
|
|
|
|
TTreeNodeArray = ^TTreeNode;
|
|
|
|
ETreeNodeError = class(Exception);
|
|
ETreeViewError = class(ETreeNodeError);
|
|
|
|
TTreeNodeChangeReason = (
|
|
ncTextChanged, //The Node's Text has changed
|
|
ncDataChanged, //The Node's Data has changed
|
|
ncHeightChanged, //The Node's Height has changed
|
|
ncImageEffect, //The Node's Image Effect has changed
|
|
ncImageIndex, //The Node's Image Index has changed
|
|
ncParentChanged, //The Node's Parent has changed
|
|
ncVisibility, //The Node's Visibility has changed
|
|
ncOverlayIndex, //The Node's Overlay Index has Changed
|
|
ncStateIndex, //The Node's State Index has Changed
|
|
ncSelectedIndex //The Node's Selected Index has Changed
|
|
);
|
|
|
|
const
|
|
LCLStreamID = -7;
|
|
|
|
type
|
|
TTVChangingEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
var AllowChange: Boolean) of object;
|
|
TTVChangedEvent = procedure(Sender: TObject; Node: TTreeNode) of object;
|
|
TTVNodeChangedEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
ChangeReason: TTreeNodeChangeReason) of object;
|
|
TTVEditingEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
var AllowEdit: Boolean) of object;
|
|
TTVEditingEndEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
Cancel: Boolean) of object;
|
|
TTVEditedEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
var S: string) of object;
|
|
TTVExpandingEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
var AllowExpansion: Boolean) of object;
|
|
TTVCollapsingEvent = procedure(Sender: TObject; Node: TTreeNode;
|
|
var AllowCollapse: Boolean) of object;
|
|
TTVExpandedEvent = procedure(Sender: TObject; Node: TTreeNode) of object;
|
|
TTVCompareEvent = procedure(Sender: TObject; Node1, Node2: TTreeNode;
|
|
var Compare: Integer) of object;
|
|
TTVCustomDrawEvent = procedure(Sender: TCustomTreeView; const ARect: TRect;
|
|
var DefaultDraw: Boolean) of object;
|
|
TTVCustomDrawItemEvent = procedure(Sender: TCustomTreeView; Node: TTreeNode;
|
|
State: TCustomDrawState; var DefaultDraw: Boolean) of object;
|
|
TTVCustomDrawArrowEvent = procedure(Sender: TCustomTreeView;
|
|
const ARect: TRect; ACollapsed: Boolean) of object;
|
|
TTVAdvancedCustomDrawEvent = procedure(Sender: TCustomTreeView;
|
|
const ARect: TRect; Stage: TCustomDrawStage;
|
|
var DefaultDraw: Boolean) of object;
|
|
TTVAdvancedCustomDrawItemEvent = procedure(Sender: TCustomTreeView;
|
|
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
|
|
var PaintImages, DefaultDraw: Boolean) of object;
|
|
TTVCustomCreateNodeEvent = procedure(Sender: TCustomTreeView;
|
|
var ATreeNode: TTreenode) of object;
|
|
TTVCreateNodeClassEvent = procedure(Sender: TCustomTreeView;
|
|
var NodeClass: TTreeNodeClass) of object;
|
|
|
|
TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object;
|
|
|
|
TOldTreeNodeInfo = packed record
|
|
ImageIndex: Integer;
|
|
SelectedIndex: Integer;
|
|
StateIndex: Integer;
|
|
OverlayIndex: Integer;
|
|
Data: PtrUInt;
|
|
Count: Integer;
|
|
Height: integer;
|
|
Expanded: boolean;
|
|
TextLen: integer;
|
|
// here follows the text
|
|
end;
|
|
|
|
TTreeNodeInfo = packed record
|
|
ImageIndex: Integer;
|
|
SelectedIndex: Integer;
|
|
StateIndex: Integer;
|
|
OverlayIndex: Integer;
|
|
Count: Integer;
|
|
Height: integer;
|
|
Expanded: boolean;
|
|
TextLen: integer;
|
|
// here follows the text
|
|
end;
|
|
|
|
// this is the delphi node stream record
|
|
PDelphiNodeInfo = ^TDelphiNodeInfo;
|
|
TDelphiNodeInfo = packed record
|
|
ImageIndex: Integer;
|
|
SelectedIndex: Integer;
|
|
StateIndex: Integer;
|
|
OverlayIndex: Integer;
|
|
Data: Cardinal; // Always 32-bit, assigned to a Pointer.
|
|
Count: Integer;
|
|
Text: string[255];
|
|
end;
|
|
|
|
{ TTreeNode }
|
|
|
|
TTreeNode = class(TPersistent)
|
|
private
|
|
FOwner: TTreeNodes; // the object, which contains all nodes of the tree
|
|
FCapacity: integer; // size of FItems
|
|
FCount: integer; // # of first level children in FItems
|
|
FData: Pointer; // custom data
|
|
FHeight: integer; // height in pixels
|
|
FNodeEffect: TGraphicsDrawEffect;
|
|
FImageIndex: TImageIndex;
|
|
FIndex: integer; // index in parent
|
|
FItems: TTreeNodeArray; // first level child nodes
|
|
FNextBrother: TTreeNode; // next sibling
|
|
FNextMultiSelected: TTreeNode;
|
|
FOverlayIndex: Integer;
|
|
FParent: TTreeNode;
|
|
FPrevBrother: TTreeNode; // previous sibling
|
|
FPrevMultiSelected: TTreeNode;
|
|
FSelectedIndex: Integer;
|
|
FStateIndex: Integer;
|
|
FStates: TNodeStates;
|
|
FSubTreeCount: integer;// total of all child nodes and self
|
|
FText: string;
|
|
FTop: integer; // top coordinate
|
|
function AreParentsExpandedAndVisible: Boolean;
|
|
procedure BindToMultiSelected;
|
|
function CompareCount(CompareMe: Integer): Boolean;
|
|
function DoCanExpand(ExpandIt: Boolean): Boolean;
|
|
procedure DoExpand(ExpandIt: Boolean);
|
|
procedure ExpandItem(ExpandIt, Recurse: Boolean);
|
|
function GetAbsoluteIndex: Integer;
|
|
function GetDeleting: Boolean;
|
|
function GetHasChildren: Boolean;
|
|
function GetCount: Integer;
|
|
function GetCut: boolean;
|
|
function GetDropTarget: Boolean;
|
|
function GetExpanded: Boolean;
|
|
function GetFocused: Boolean;
|
|
function GetHeight: integer;
|
|
function GetIndex: Integer;
|
|
function GetItems(AnIndex: Integer): TTreeNode;
|
|
function GetLevel: Integer;
|
|
function GetMultiSelected: Boolean;
|
|
function GetSelected: Boolean;
|
|
function GetState(NodeState: TNodeState): Boolean;
|
|
function GetTreeNodes: TTreeNodes;
|
|
function GetTreeView: TCustomTreeView;
|
|
function GetTop: integer;
|
|
function GetVisible: Boolean;
|
|
procedure InternalMove(ANode: TTreeNode; AddMode: TAddMode);
|
|
function IsEqual(Node: TTreeNode): Boolean;
|
|
function IsNodeVisible: Boolean;
|
|
function IsNodeHeightFullVisible: Boolean;
|
|
procedure ReadData(Stream: TStream; StreamVersion: integer);
|
|
procedure ReadDelphiData(Stream: TStream; Info: PDelphiNodeInfo);
|
|
procedure SetCut(AValue: Boolean);
|
|
procedure SetData(AValue: Pointer);
|
|
procedure SetDropTarget(AValue: Boolean);
|
|
procedure SetExpanded(AValue: Boolean);
|
|
procedure SetFocused(AValue: Boolean);
|
|
procedure SetHasChildren(AValue: Boolean);
|
|
procedure SetHeight(AValue: integer);
|
|
procedure SetImageEffect(AValue: TGraphicsDrawEffect);
|
|
procedure SetImageIndex(AValue: TImageIndex);
|
|
procedure SetIndex(const AValue: Integer);
|
|
procedure SetItems(AnIndex: Integer; AValue: TTreeNode);
|
|
procedure SetMultiSelected(const AValue: Boolean);
|
|
procedure SetOverlayIndex(AValue: Integer);
|
|
procedure SetSelected(AValue: Boolean);
|
|
procedure SetSelectedIndex(AValue: Integer);
|
|
procedure SetStateIndex(AValue: Integer);
|
|
procedure SetText(const S: string);
|
|
procedure SetVisible(const AValue: Boolean);
|
|
procedure Unbind;
|
|
procedure UnbindFromMultiSelected;
|
|
procedure WriteData(Stream: TStream; StreamVersion: integer);
|
|
procedure WriteDelphiData(Stream: TStream; Info: PDelphiNodeInfo);
|
|
protected
|
|
procedure Changed(ChangeReason: TTreeNodeChangeReason);
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AnOwner: TTreeNodes); virtual;
|
|
destructor Destroy; override;
|
|
function AlphaSort: Boolean;
|
|
function Bottom: integer;
|
|
function BottomExpanded: integer;
|
|
function CustomSort(SortProc: TTreeNodeCompare): Boolean;
|
|
function DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer;
|
|
function DisplayExpandSignLeft: integer;
|
|
function DisplayExpandSignRect: TRect;
|
|
function DisplayExpandSignRight: integer;
|
|
function DisplayIconLeft: integer;
|
|
function DisplayRect(TextOnly: Boolean): TRect;
|
|
function DisplayStateIconLeft: integer;
|
|
function DisplayTextLeft: integer;
|
|
function DisplayTextRight: integer;
|
|
function EditText: Boolean;
|
|
function FindNode(const NodeText: string): TTreeNode;
|
|
function GetFirstChild: TTreeNode;
|
|
function GetFirstSibling: TTreeNode;
|
|
function GetFirstVisibleChild: TTreeNode;
|
|
function GetHandle: THandle;
|
|
function GetLastChild: TTreeNode;
|
|
function GetLastSibling: TTreeNode;
|
|
function GetLastSubChild: TTreeNode;
|
|
function GetLastVisibleChild: TTreeNode;
|
|
function GetNext: TTreeNode;
|
|
function GetNextChild(AValue: TTreeNode): TTreeNode;
|
|
function GetNextExpanded: TTreeNode;
|
|
function GetNextMultiSelected: TTreeNode;
|
|
function GetNextSibling: TTreeNode;
|
|
function GetNextSkipChildren: TTreeNode;
|
|
function GetNextVisible: TTreeNode;
|
|
function GetNextVisibleSibling: TTreeNode;
|
|
function GetParentNodeOfAbsoluteLevel(TheAbsoluteLevel: integer): TTreeNode;
|
|
function GetPrev: TTreeNode;
|
|
function GetPrevChild(AValue: TTreeNode): TTreeNode;
|
|
function GetPrevExpanded: TTreeNode;
|
|
function GetPrevMultiSelected: TTreeNode;
|
|
function GetPrevSibling: TTreeNode;
|
|
function GetPrevVisible: TTreeNode;
|
|
function GetPrevVisibleSibling: TTreeNode;
|
|
function GetTextPath: string;
|
|
function HasAsParent(AValue: TTreeNode): Boolean;
|
|
function IndexOf(AValue: TTreeNode): Integer;
|
|
function IndexOfText(const NodeText: string): Integer;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Collapse(Recurse: Boolean);
|
|
procedure ConsistencyCheck;
|
|
procedure Delete;
|
|
procedure DeleteChildren;
|
|
procedure EndEdit(Cancel: Boolean);
|
|
procedure Expand(Recurse: Boolean);
|
|
procedure ExpandParents;
|
|
procedure FreeAllNodeData;
|
|
procedure MakeVisible;
|
|
procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual;
|
|
procedure MultiSelectGroup;
|
|
procedure Update;
|
|
procedure WriteDebugReport(const Prefix: string; Recurse: boolean);
|
|
property AbsoluteIndex: Integer read GetAbsoluteIndex;
|
|
property Count: Integer read GetCount;
|
|
property Cut: Boolean read GetCut write SetCut;
|
|
property Data: Pointer read FData write SetData;
|
|
property Deleting: Boolean read GetDeleting;
|
|
property DropTarget: Boolean read GetDropTarget write SetDropTarget;
|
|
property Expanded: Boolean read GetExpanded write SetExpanded;
|
|
property Focused: Boolean read GetFocused write SetFocused;
|
|
property Handle: THandle read GetHandle;
|
|
property HasChildren: Boolean read GetHasChildren write SetHasChildren;
|
|
property Height: integer read GetHeight write SetHeight;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property Index: Integer read GetIndex write SetIndex;
|
|
property IsFullHeightVisible: Boolean read IsNodeHeightFullVisible;
|
|
property IsVisible: Boolean read IsNodeVisible;
|
|
property Items[ItemIndex: Integer]: TTreeNode read GetItems write SetItems; default;
|
|
property Level: Integer read GetLevel;
|
|
property MultiSelected: Boolean read GetMultiSelected write SetMultiSelected;
|
|
property NodeEffect: TGraphicsDrawEffect read FNodeEffect write SetImageEffect;
|
|
property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex default -1;
|
|
property Owner: TTreeNodes read FOwner;
|
|
property Parent: TTreeNode read FParent;
|
|
property Selected: Boolean read GetSelected write SetSelected;
|
|
property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default -1;
|
|
property StateIndex: Integer read FStateIndex write SetStateIndex default -1;
|
|
property States: TNodeStates read FStates;
|
|
property SubTreeCount: integer read FSubTreeCount;
|
|
property Text: string read FText write SetText;
|
|
property Top: integer read GetTop;
|
|
property TreeNodes: TTreeNodes read GetTreeNodes;
|
|
property TreeView: TCustomTreeView read GetTreeView;
|
|
property Visible: Boolean read GetVisible write SetVisible default True;
|
|
end;
|
|
|
|
{ TTreeNodesEnumerator }
|
|
|
|
TTreeNodesEnumerator = class
|
|
private
|
|
FNodes: TTreeNodes;
|
|
FPosition: Integer;
|
|
function GetCurrent: TTreeNode;
|
|
public
|
|
constructor Create(ANodes: TTreeNodes);
|
|
function MoveNext: Boolean;
|
|
property Current: TTreeNode read GetCurrent;
|
|
end;
|
|
|
|
{ TTreeNodes }
|
|
|
|
PNodeCache = ^TNodeCache;
|
|
TNodeCache = record
|
|
CacheNode: TTreeNode;
|
|
CacheIndex: Integer;
|
|
end;
|
|
|
|
{ TTreeNodes }
|
|
|
|
TTreeNodes = class(TPersistent)
|
|
private
|
|
FCount: integer;
|
|
FSelection: TFPList;
|
|
FStartMultiSelected: TTreeNode; // node where user started multiselection
|
|
FFirstMultiSelected: TTreeNode;
|
|
FLastMultiSelected: TTreeNode;
|
|
FKeepCollapsedNodes: boolean;
|
|
FNodeCache: TNodeCache;
|
|
FOwner: TCustomTreeView;
|
|
FTopLvlCapacity: integer;
|
|
FTopLvlCount: integer;
|
|
FTopLvlItems: TTreeNodeArray; // root and root siblings
|
|
FUpdateCount: Integer;
|
|
fNewNodeToBeAdded: TTreeNode;
|
|
procedure ClearCache;
|
|
function GetHandle: THandle;
|
|
function GetNodeFromIndex(Index: Integer): TTreeNode;
|
|
function GetSelectionCount: Cardinal;
|
|
function GetTopLvlItems(Index: integer): TTreeNode;
|
|
procedure GrowTopLvlItems;
|
|
function IndexOfTopLvlItem(Node: TTreeNode): integer;
|
|
procedure MoveTopLvlNode(TopLvlFromIndex, TopLvlToIndex: integer;
|
|
Node: TTreeNode);
|
|
procedure ReadData(Stream: TStream);
|
|
procedure ReadExpandedState(Stream: TStream);
|
|
procedure Repaint(ANode: TTreeNode);
|
|
procedure ShrinkTopLvlItems;
|
|
procedure SetTopLvlItems(Index: integer; AValue: TTreeNode);
|
|
procedure WriteData(Stream: TStream); overload;
|
|
procedure WriteData(Stream: TStream; WriteDataPointer: boolean); overload;
|
|
procedure WriteExpandedState(Stream: TStream);
|
|
protected
|
|
function InternalAddObject(Node: TTreeNode; const S: string;
|
|
Data: Pointer; AddMode: TAddMode): TTreeNode;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetCount: Integer;
|
|
function GetOwner: TPersistent; override;
|
|
procedure SetItem(Index: Integer; AValue: TTreeNode);
|
|
procedure SetUpdateState(Updating: Boolean);
|
|
public
|
|
constructor Create(AnOwner: TCustomTreeView);
|
|
destructor Destroy; override;
|
|
function Add(SiblingNode: TTreeNode; const S: string): TTreeNode;
|
|
function AddChild(ParentNode: TTreeNode; const S: string): TTreeNode;
|
|
function AddChildFirst(ParentNode: TTreeNode; const S: string): TTreeNode;
|
|
function AddChildObject(ParentNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function AddChildObjectFirst(ParentNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function AddFirst(SiblingNode: TTreeNode; const S: string): TTreeNode;
|
|
function AddNode(Node: TTreeNode; Relative: TTreeNode; const S: string;
|
|
Ptr: Pointer; Method: TNodeAttachMode): TTreeNode;
|
|
function AddObject(SiblingNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function AddObjectFirst(SiblingNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function FindNodeWithData(const NodeData: Pointer): TTreeNode;
|
|
function FindNodeWithText(const NodeText: string): TTreeNode;
|
|
function FindNodeWithTextPath(TextPath: string): TTreeNode;
|
|
function FindTopLvlNode(const NodeText: string): TTreeNode;
|
|
function GetEnumerator: TTreeNodesEnumerator;
|
|
function GetFirstNode: TTreeNode;
|
|
function GetFirstVisibleNode: TTreeNode;
|
|
function GetLastExpandedSubNode: TTreeNode; // absolute last node
|
|
function GetLastNode: TTreeNode; // last top level node
|
|
function GetLastSubNode: TTreeNode; // absolute last node
|
|
function GetLastVisibleNode: TTreeNode;
|
|
function GetSelections(const AIndex: Integer): TTreeNode;
|
|
function Insert(NextNode: TTreeNode; const S: string): TTreeNode;
|
|
function InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode;
|
|
function InsertObject(NextNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function InsertObjectBehind(PrevNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
function IsMultiSelection: boolean;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure BeginUpdate;
|
|
procedure Clear;
|
|
procedure ClearMultiSelection(ClearSelected: boolean = false);
|
|
procedure ConsistencyCheck;
|
|
procedure Delete(Node: TTreeNode);
|
|
procedure EndUpdate;
|
|
procedure FreeAllNodeData;
|
|
procedure SelectionsChanged(ANode: TTreeNode; const AIsSelected: Boolean);
|
|
procedure SelectOnlyThis(Node: TTreeNode);
|
|
procedure MultiSelect(Node: TTreeNode; ClearWholeSelection: Boolean);
|
|
procedure SortTopLevelNodes(SortProc: TTreeNodeCompare);
|
|
procedure WriteDebugReport(const Prefix: string; AllNodes: boolean);
|
|
property Count: Integer read GetCount;
|
|
property Item[Index: Integer]: TTreeNode read GetNodeFromIndex; default;
|
|
property KeepCollapsedNodes: boolean
|
|
read FKeepCollapsedNodes write FKeepCollapsedNodes;
|
|
property Owner: TCustomTreeView read FOwner;
|
|
property SelectionCount: Cardinal read GetSelectionCount;
|
|
property TopLvlCount: integer read FTopLvlCount;
|
|
property TopLvlItems[Index: integer]: TTreeNode
|
|
read GetTopLvlItems write SetTopLvlItems;
|
|
end;
|
|
|
|
|
|
{ TCustomTreeView }
|
|
|
|
TTreeViewState = (
|
|
tvsScrollbarChanged,
|
|
tvsMaxRightNeedsUpdate,
|
|
tvsTopsNeedsUpdate,
|
|
tvsMaxLvlNeedsUpdate,
|
|
tvsTopItemNeedsUpdate,
|
|
tvsBottomItemNeedsUpdate,
|
|
tvsCanvasChanged,
|
|
tvsDragged,
|
|
tvsIsEditing,
|
|
tvsStateChanging,
|
|
tvsManualNotify,
|
|
tvsUpdating,
|
|
tvsPainting,
|
|
tvoFocusedPainting,
|
|
tvsDblClicked,
|
|
tvsTripleClicked,
|
|
tvsQuadClicked,
|
|
tvsSelectionChanged,
|
|
tvsEditOnMouseUp, // if mouse up occurs on mouse down node: activate editing
|
|
tvsSingleSelectOnMouseUp // if mouse up occurs on mouse down node: single select this node
|
|
);
|
|
TTreeViewStates = set of TTreeViewState;
|
|
|
|
TTreeViewOption = (
|
|
tvoAllowMultiselect,
|
|
tvoAutoExpand,
|
|
tvoAutoInsertMark,
|
|
tvoAutoItemHeight,
|
|
tvoHideSelection,
|
|
tvoHotTrack,
|
|
tvoKeepCollapsedNodes,
|
|
tvoReadOnly,
|
|
tvoRightClickSelect,
|
|
tvoRowSelect,
|
|
tvoShowButtons,
|
|
tvoShowLines,
|
|
tvoShowRoot,
|
|
tvoShowSeparators,
|
|
tvoToolTips,
|
|
tvoNoDoubleClickExpand,
|
|
tvoThemedDraw,
|
|
tvoEmptySpaceUnselect
|
|
);
|
|
TTreeViewOptions = set of TTreeViewOption;
|
|
|
|
const
|
|
DefaultTreeViewOptions = [tvoShowRoot, tvoShowLines, tvoShowButtons,
|
|
tvoHideSelection, tvoToolTips,
|
|
tvoKeepCollapsedNodes, tvoAutoItemHeight, tvoThemedDraw];
|
|
DefaultMultiSelectStyle = [msControlSelect];
|
|
DefaultTreeNodeHeight = 20;
|
|
DefaultTreeNodeExpandSignSize = 9;
|
|
|
|
type
|
|
TTreeViewExpandSignType = (
|
|
tvestTheme, // use themed sign
|
|
tvestPlusMinus, // use +/- sign
|
|
tvestArrow, // use blank arrow
|
|
tvestArrowFill // use filled arrow
|
|
);
|
|
|
|
TTreeViewInsertMarkType = (
|
|
tvimNone,
|
|
tvimAsFirstChild, // or as root
|
|
tvimAsNextSibling,
|
|
tvimAsPrevSibling
|
|
);
|
|
|
|
|
|
TCustomTreeView = class(TCustomControl)
|
|
private
|
|
FAccessibilityOn: Boolean;
|
|
FBottomItem: TTreeNode;
|
|
FCallingChange: Boolean;
|
|
FEditingItem: TTreeNode;
|
|
FExpandSignType: TTreeViewExpandSignType;
|
|
FExpandSignSize: integer;
|
|
FThemeExpandSignSize: integer;
|
|
FDefItemHeight: integer;
|
|
FDefItemSpace: Integer;
|
|
FDragImage: TDragImageList;
|
|
FDragNode: TTreeNode;
|
|
FIndent: integer;
|
|
FImageChangeLink: TChangeLink;
|
|
FImages: TCustomImageList;
|
|
FImagesWidth: Integer;
|
|
FInsertMarkNode: TTreeNode;
|
|
FInsertMarkType: TTreeViewInsertMarkType;
|
|
FLastDropTarget: TTreeNode;
|
|
FLastHorzScrollInfo: TScrollInfo;
|
|
FLastVertScrollInfo: TScrollInfo;
|
|
FMaxLvl: integer; // maximum level of all nodes
|
|
FMaxRight: integer; // maximum text width of all nodes (needed for horizontal scrolling)
|
|
FMouseDownPos: TPoint;
|
|
FMouseDownOnFoldingSign: Boolean;
|
|
FMultiSelectStyle: TMultiSelectStyle;
|
|
FHotTrackColor: TColor;
|
|
FDisabledFontColor: TColor;
|
|
FOnAddition: TTVExpandedEvent;
|
|
FOnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent;
|
|
FOnAdvancedCustomDrawItem: TTVAdvancedCustomDrawItemEvent;
|
|
FOnChange: TTVChangedEvent;
|
|
FOnChanging: TTVChangingEvent;
|
|
FOnCollapsed: TTVExpandedEvent;
|
|
FOnCollapsing: TTVCollapsingEvent;
|
|
FOnCompare: TTVCompareEvent;
|
|
FOnCreateNodeClass: TTVCreateNodeClassEvent;
|
|
FOnCustomCreateItem: TTVCustomCreateNodeEvent;
|
|
FOnCustomDraw: TTVCustomDrawEvent;
|
|
FOnCustomDrawItem: TTVCustomDrawItemEvent;
|
|
FOnCustomDrawArrow: TTVCustomDrawArrowEvent;
|
|
FOnDeletion: TTVExpandedEvent;
|
|
FOnEditing: TTVEditingEvent;
|
|
FOnEditingEnd: TTVEditingEndEvent;
|
|
FOnEdited: TTVEditedEvent;
|
|
FOnExpanded: TTVExpandedEvent;
|
|
FOnExpanding: TTVExpandingEvent;
|
|
FOnGetImageIndex: TTVExpandedEvent;
|
|
FOnGetSelectedIndex: TTVExpandedEvent;
|
|
FOnNodeChanged: TTVNodeChangedEvent;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
FOptions: TTreeViewOptions;
|
|
FRClickNode: TTreeNode;
|
|
FSaveItems: TStringList;
|
|
FScrollBars: TScrollStyle;
|
|
FScrolledLeft: integer; // horizontal scrolled pixels (hidden pixels at left)
|
|
FScrolledTop: integer; // vertical scrolled pixels (hidden pixels at top)
|
|
FSBHorzShowing: ShortInt;
|
|
FSBVertShowing: ShortInt;
|
|
FSelectedColor: TColor;
|
|
FSelectedFontColor: TColor;
|
|
FSelectedFontColorUsed: boolean;
|
|
FSelectedNode: TTreeNode;
|
|
FSelectionChangeEventLock: integer;
|
|
fSeparatorColor: TColor;
|
|
FSortType: TSortType;
|
|
FStateChangeLink: TChangeLink;
|
|
FStateImages: TCustomImageList;
|
|
FStateImagesWidth: Integer;
|
|
FStates: TTreeViewStates;
|
|
FTopItem: TTreeNode;
|
|
FTreeLineColor: TColor;
|
|
FTreeLinePenStyle: TPenStyle;
|
|
FTreeLinePenPattern: TPenPattern;
|
|
FExpandSignColor : TColor;
|
|
FTreeNodes: TTreeNodes;
|
|
FHintWnd: THintWindow;
|
|
FNodeUnderCursor: TTreeNode;
|
|
FPrevToolTips: boolean;
|
|
FDragScrollMargin: integer;
|
|
FDragScrollTimer: TTimer;
|
|
procedure DragScrollTimerTick(Sender: TObject);
|
|
procedure CanvasChanged(Sender: TObject);
|
|
function GetAutoExpand: boolean;
|
|
function GetBackgroundColor: TColor;
|
|
function GetBottomItem: TTreeNode;
|
|
function GetDropTarget: TTreeNode;
|
|
function GetExpandSignSize: integer;
|
|
function GetHideSelection: boolean;
|
|
function GetHotTrack: boolean;
|
|
function GetIndent: Integer;
|
|
function GetKeepCollapsedNodes: boolean;
|
|
function GetMultiSelect: Boolean;
|
|
function GetReadOnly: boolean;
|
|
function GetRightClickSelect: boolean;
|
|
function GetRowSelect: boolean;
|
|
function GetSelection: TTreeNode;
|
|
function GetSelectionCount: Cardinal;
|
|
function GetSelections(AIndex: Integer): TTreeNode;
|
|
function GetShowButtons: boolean;
|
|
function GetShowLines: boolean;
|
|
function GetShowRoot: boolean;
|
|
function GetShowSeparators: boolean;
|
|
function GetToolTips: boolean;
|
|
function GetTopItem: TTreeNode;
|
|
function IsStoredBackgroundColor: Boolean;
|
|
procedure HintMouseLeave(Sender: TObject);
|
|
procedure ImageListChange(Sender: TObject);
|
|
function NodeIsSelected(aNode: TTreeNode): Boolean;
|
|
procedure OnChangeTimer(Sender: TObject);
|
|
procedure SetAutoExpand(Value: Boolean);
|
|
procedure SetBackgroundColor(Value: TColor);
|
|
procedure SetBottomItem(Value: TTreeNode);
|
|
procedure SetDefaultItemHeight(Value: integer);
|
|
procedure SetExpandSignType(Value: TTreeViewExpandSignType);
|
|
procedure SetDropTarget(Value: TTreeNode);
|
|
procedure SetHideSelection(Value: Boolean);
|
|
procedure SetHotTrack(Value: Boolean);
|
|
procedure SetIndent(Value: Integer);
|
|
procedure SetImages(Value: TCustomImageList);
|
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
|
procedure SetInsertMarkNode(const AValue: TTreeNode);
|
|
procedure SetInsertMarkType(const AValue: TTreeViewInsertMarkType);
|
|
procedure SetKeepCollapsedNodes(Value: Boolean);
|
|
procedure SetMultiSelect(const AValue: Boolean);
|
|
procedure SetMultiSelectStyle(const AValue: TMultiSelectStyle);
|
|
procedure SetReadOnly(Value: Boolean);
|
|
procedure SetRightClickSelect(Value: Boolean);
|
|
procedure SetRowSelect(Value: Boolean);
|
|
procedure SetScrollBars(const Value: TScrollStyle);
|
|
procedure SetScrolledLeft(AValue: integer);
|
|
procedure SetScrolledTop(AValue: integer);
|
|
procedure SetSelectedColor(Value: TColor);
|
|
procedure SetSelectedFontColor(Value: TColor);
|
|
procedure SetSelection(Value: TTreeNode);
|
|
procedure SetSeparatorColor(const AValue: TColor);
|
|
procedure SetShowButton(Value: Boolean);
|
|
procedure SetShowLines(Value: Boolean);
|
|
procedure SetShowRoot(Value: Boolean);
|
|
procedure SetShowScrollBar(Which: Integer; AShow: Boolean);
|
|
procedure SetShowSeparators(Value: Boolean);
|
|
procedure SetSortType(Value: TSortType);
|
|
procedure SetStateImages(Value: TCustomImageList);
|
|
procedure SetStateImagesWidth(const aStateImagesWidth: Integer);
|
|
procedure SetToolTips(Value: Boolean);
|
|
procedure SetTreeLineColor(Value: TColor);
|
|
procedure SetTreeNodes(Value: TTreeNodes);
|
|
procedure SetTopItem(Value: TTreeNode);
|
|
procedure UpdateAllTops;
|
|
procedure UpdateBottomItem;
|
|
procedure UpdateHotTrack(X, Y: Integer);
|
|
procedure UpdateMaxLvl;
|
|
procedure UpdateMaxRight;
|
|
procedure UpdateTopItem;
|
|
procedure UpdateScrollbars;
|
|
procedure UpdateTooltip(X, Y: integer);
|
|
procedure InternalSelectionChanged;
|
|
function AllowMultiSelectWithCtrl(AState: TShiftState): Boolean;
|
|
function AllowMultiSelectWithShift(AState: TShiftState): Boolean;
|
|
procedure SetExpandSignSize(const AExpandSignSize: integer);
|
|
protected
|
|
FChangeTimer: TTimer;
|
|
FEditor: TEdit;
|
|
class procedure WSRegisterClass; override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure Added(Node: TTreeNode); virtual;
|
|
procedure EditorEditingDone(Sender: TObject); virtual;
|
|
procedure EditorKeyDown(Sender: TObject; var Key : Word; Shift : TShiftState); virtual;
|
|
procedure BeginAutoDrag; override;
|
|
procedure BeginEditing(ANode: TTreeNode); virtual;
|
|
function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT; override;
|
|
function CanChange(Node: TTreeNode): Boolean; virtual;
|
|
function CanCollapse(Node: TTreeNode): Boolean; virtual;
|
|
function CanEdit(Node: TTreeNode): Boolean; virtual;
|
|
function CanExpand(Node: TTreeNode): Boolean; virtual;
|
|
function CreateNode: TTreeNode; virtual;
|
|
function CreateNodes: TTreeNodes; virtual;
|
|
function CustomDraw(const ARect: TRect;
|
|
Stage: TCustomDrawStage): Boolean; virtual;
|
|
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
|
|
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual;
|
|
function DefaultItemHeightIsStored: Boolean;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
function ExpandSignSizeIsStored: Boolean;
|
|
function GetDragImages: TDragImageList; override;
|
|
function GetMaxLvl: integer;
|
|
function GetMaxScrollLeft: integer;
|
|
function GetMaxScrollTop: integer;
|
|
function GetNodeAtY(Y: Integer): TTreeNode;
|
|
function GetNodeDrawAreaHeight: integer;
|
|
function GetNodeDrawAreaWidth: integer;
|
|
function IndentIsStored: Boolean;
|
|
function IsCustomDrawn(Target: TCustomDrawTarget;
|
|
Stage: TCustomDrawStage): Boolean; virtual;
|
|
function IsNodeVisible(ANode: TTreeNode): Boolean;
|
|
function IsNodeHeightFullVisible(ANode: TTreeNode): Boolean;
|
|
function IsInsertMarkVisible: boolean; virtual;
|
|
procedure MoveSelection(ANewNode: TTreeNode; ASelect: Boolean);
|
|
procedure Change(Node: TTreeNode); virtual;
|
|
procedure Collapse(Node: TTreeNode); virtual;
|
|
procedure CreateWnd; override;
|
|
procedure Click; override;
|
|
procedure DblClick; override;
|
|
procedure TripleClick; override;
|
|
procedure QuadClick; override;
|
|
procedure Delete(Node: TTreeNode); virtual;
|
|
procedure DestroyWnd; override;
|
|
procedure DoCreateNodeClass(var NewNodeClass: TTreeNodeClass); virtual;
|
|
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean; override;
|
|
function DoMouseWheelHorz(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean; override;
|
|
procedure DoPaint; virtual;
|
|
procedure DoPaintNode(Node: TTreeNode); virtual;
|
|
procedure DoStartDrag(var DragObject: TDragObject); override;
|
|
procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
|
|
var Accept: Boolean); override;
|
|
procedure EndEditing(Cancel: boolean = false); virtual;
|
|
procedure EnsureNodeIsVisible(ANode: TTreeNode);
|
|
procedure Expand(Node: TTreeNode); virtual;
|
|
procedure GetImageIndex(Node: TTreeNode); virtual;
|
|
procedure GetSelectedIndex(Node: TTreeNode); virtual;
|
|
procedure InitializeWnd; override;
|
|
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
|
|
procedure Loaded; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseLeave; override;
|
|
procedure NodeChanged(Node: TTreeNode; ChangeReason: TTreeNodeChangeReason); virtual;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure ScrollView(DeltaX, DeltaY: Integer);
|
|
procedure SetDragMode(Value: TDragMode); override;
|
|
procedure SetOptions(NewOptions: TTreeViewOptions); virtual;
|
|
procedure UpdateDefaultItemHeight; virtual;
|
|
procedure UpdateInsertMark(X,Y: integer); virtual;
|
|
procedure DoSelectionChanged; virtual;
|
|
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
|
|
procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
|
|
procedure WMLButtonDown(var AMessage: TLMLButtonDown); message LM_LBUTTONDOWN;
|
|
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
|
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
|
procedure Resize; override;
|
|
property EditingItem: TTreeNode read FEditingItem;
|
|
property States: TTreeViewStates read FStates;
|
|
public
|
|
// Accessibility
|
|
function GetSelectedChildAccessibleObject: TLazAccessibleObject; override;
|
|
function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; override;
|
|
// This property is provided for the case when a tree view contains a huge amount of items,
|
|
// lets say 10.000+. In this case accessibility might slow the tree down, so turning
|
|
// it off might make things faster
|
|
property AccessibilityOn: Boolean read FAccessibilityOn write FAccessibilityOn default True;
|
|
protected
|
|
property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False;
|
|
property BorderStyle default bsSingle;
|
|
property HideSelection: Boolean
|
|
read GetHideSelection write SetHideSelection default True;
|
|
property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
|
|
property HotTrackColor: TColor read FHotTrackColor write FHotTrackColor default clNone;
|
|
property DisabledFontColor: TColor read FDisabledFontColor write FDisabledFontColor default clGrayText;
|
|
property Indent: Integer read GetIndent write SetIndent stored IndentIsStored;
|
|
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False;
|
|
property OnAddition: TTVExpandedEvent read FOnAddition write FOnAddition;
|
|
property OnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent
|
|
read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw;
|
|
property OnAdvancedCustomDrawItem: TTVAdvancedCustomDrawItemEvent
|
|
read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem;
|
|
property OnChange: TTVChangedEvent read FOnChange write FOnChange;
|
|
property OnChanging: TTVChangingEvent read FOnChanging write FOnChanging;
|
|
property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed;
|
|
property OnCollapsing: TTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
|
|
property OnCompare: TTVCompareEvent read FOnCompare write FOnCompare;
|
|
property OnCreateNodeClass: TTVCreateNodeClassEvent read FOnCreateNodeClass write FOnCreateNodeClass;
|
|
property OnCustomCreateItem: TTVCustomCreateNodeEvent read FOnCustomCreateItem write FOnCustomCreateItem;
|
|
property OnCustomDraw: TTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
|
|
property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
|
|
property OnCustomDrawArrow: TTVCustomDrawArrowEvent read FOnCustomDrawArrow write FOnCustomDrawArrow;
|
|
property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion;
|
|
property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited;
|
|
property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing;
|
|
property OnEditingEnd: TTVEditingEndEvent read FOnEditingEnd write FOnEditingEnd;
|
|
property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
|
|
property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
|
|
property OnGetImageIndex: TTVExpandedEvent
|
|
read FOnGetImageIndex write FOnGetImageIndex;
|
|
property OnGetSelectedIndex: TTVExpandedEvent
|
|
read FOnGetSelectedIndex write FOnGetSelectedIndex;
|
|
property OnNodeChanged: TTVNodeChangedEvent read FOnNodeChanged write FOnNodeChanged;
|
|
property OnSelectionChanged: TNotifyEvent
|
|
read FOnSelectionChanged write FOnSelectionChanged;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
|
property RightClickSelect: Boolean
|
|
read GetRightClickSelect write SetRightClickSelect default False;
|
|
property RowSelect: Boolean read GetRowSelect write SetRowSelect default False;
|
|
property ScrolledLeft: integer read FScrolledLeft write SetScrolledLeft;
|
|
property ScrolledTop: integer read FScrolledTop write SetScrolledTop;
|
|
property ShowButtons: Boolean read GetShowButtons write SetShowButton default True;
|
|
property ShowLines: Boolean read GetShowLines write SetShowLines default True;
|
|
property ShowRoot: Boolean read GetShowRoot write SetShowRoot default True;
|
|
property ShowSeparators: Boolean read GetShowSeparators write SetShowSeparators default True;
|
|
property SortType: TSortType read FSortType write SetSortType default stNone;
|
|
property ToolTips: Boolean read GetToolTips write SetToolTips default True;
|
|
public
|
|
constructor Create(AnOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function AlphaSort: Boolean;
|
|
procedure ClearSelection(KeepPrimary: Boolean = false); virtual;
|
|
procedure ConsistencyCheck;
|
|
function CustomSort(SortProc: TTreeNodeCompare): Boolean;
|
|
function DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer;
|
|
procedure EraseBackground(DC: HDC); override;
|
|
function GetHitTestInfoAt(X, Y: Integer): THitTests;
|
|
function GetNodeAt(X, Y: Integer): TTreeNode;
|
|
function GetNodeWithExpandSignAt(X, Y: Integer): TTreeNode;
|
|
procedure GetInsertMarkAt(X, Y: Integer; out AnInsertMarkNode: TTreeNode;
|
|
out AnInsertMarkType: TTreeViewInsertMarkType);
|
|
procedure SetInsertMark(AnInsertMarkNode: TTreeNode;
|
|
AnInsertMarkType: TTreeViewInsertMarkType);
|
|
procedure SetInsertMarkAt(X,Y: integer); virtual;
|
|
procedure Invalidate; override;
|
|
function IsEditing: Boolean;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
procedure FullCollapse;
|
|
procedure FullExpand;
|
|
procedure LoadFromFile(const FileName: string);
|
|
procedure LoadFromStream(Stream: TStream);
|
|
procedure SaveToFile(const FileName: string);
|
|
procedure SaveToStream(Stream: TStream);
|
|
procedure WriteDebugReport(const Prefix: string; AllNodes: boolean);
|
|
procedure LockSelectionChangeEvent;
|
|
procedure UnlockSelectionChangeEvent;
|
|
function GetFirstMultiSelected: TTreeNode;
|
|
function GetLastMultiSelected: TTreeNode;
|
|
procedure Select(Node: TTreeNode; ShiftState: TShiftState = []);
|
|
procedure Select(const Nodes: array of TTreeNode); virtual;
|
|
procedure Select(Nodes: TList); virtual;
|
|
function SelectionVisible: boolean;
|
|
procedure MakeSelectionVisible;
|
|
procedure ClearInvisibleSelection;
|
|
function StoreCurrentSelection: TStringList;
|
|
procedure ApplyStoredSelection(ASelection: TStringList; FreeList: boolean = True);
|
|
procedure MoveToNextNode(ASelect: Boolean = False);
|
|
procedure MoveToPrevNode(ASelect: Boolean = False);
|
|
procedure MovePageDown(ASelect: Boolean = False);
|
|
procedure MovePageUp(ASelect: Boolean = False);
|
|
procedure MoveHome(ASelect: Boolean = False);
|
|
procedure MoveEnd(ASelect: Boolean = False);
|
|
public
|
|
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor stored IsStoredBackgroundColor;
|
|
property BorderWidth default 0;
|
|
property BottomItem: TTreeNode read GetBottomItem write SetBottomItem;
|
|
property Color default clWindow;
|
|
property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight stored DefaultItemHeightIsStored;
|
|
property DropTarget: TTreeNode read GetDropTarget write SetDropTarget;
|
|
property ExpandSignColor: TColor read FExpandSignColor write FExpandSignColor default clWindowFrame;
|
|
property ExpandSignSize: integer read GetExpandSignSize write SetExpandSignSize stored ExpandSignSizeIsStored;
|
|
property ExpandSignType: TTreeViewExpandSignType
|
|
read FExpandSignType write SetExpandSignType default tvestTheme;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property InsertMarkNode: TTreeNode read FInsertMarkNode write SetInsertMarkNode;
|
|
property InsertMarkType: TTreeViewInsertMarkType read FInsertMarkType write SetInsertMarkType;
|
|
property Items: TTreeNodes read FTreeNodes write SetTreeNodes;
|
|
property KeepCollapsedNodes: boolean read GetKeepCollapsedNodes write SetKeepCollapsedNodes;
|
|
property MultiSelectStyle: TMultiSelectStyle read FMultiSelectStyle
|
|
write SetMultiSelectStyle default DefaultMultiSelectStyle;
|
|
property Options: TTreeViewOptions read FOptions write SetOptions default DefaultTreeViewOptions;
|
|
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
|
|
property Selected: TTreeNode read GetSelection write SetSelection;
|
|
property SelectionColor: TColor read FSelectedColor write SetSelectedColor default clHighlight;
|
|
property SelectionCount: Cardinal read GetSelectionCount;
|
|
property SelectionFontColor: TColor read FSelectedFontColor write SetSelectedFontColor default clWhite;
|
|
property SelectionFontColorUsed: boolean read FSelectedFontColorUsed write FSelectedFontColorUsed default False;
|
|
property Selections[AIndex: Integer]: TTreeNode read GetSelections;
|
|
property SeparatorColor: TColor read fSeparatorColor write SetSeparatorColor default clGray;
|
|
property StateImages: TCustomImageList read FStateImages write SetStateImages;
|
|
property StateImagesWidth: Integer read FStateImagesWidth write SetStateImagesWidth default 0;
|
|
property TopItem: TTreeNode read GetTopItem write SetTopItem;
|
|
property TreeLineColor: TColor read FTreeLineColor write FTreeLineColor default clWindowFrame;
|
|
property TreeLinePenStyle: TPenStyle read FTreeLinePenStyle write FTreeLinePenStyle default psPattern;
|
|
published
|
|
property TabStop default true;
|
|
end;
|
|
|
|
|
|
{ TTreeView }
|
|
|
|
TTreeView = class(TCustomTreeView)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property AutoExpand;
|
|
property BorderSpacing;
|
|
property BackgroundColor;
|
|
property BorderStyle;
|
|
property BorderWidth;
|
|
property Color;
|
|
property Constraints;
|
|
property DefaultItemHeight;
|
|
property DisabledFontColor;
|
|
property DragKind;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExpandSignColor;
|
|
property ExpandSignSize;
|
|
property ExpandSignType;
|
|
property Font;
|
|
property HideSelection;
|
|
property HotTrack;
|
|
property HotTrackColor;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property Indent;
|
|
property MultiSelect;
|
|
property MultiSelectStyle;
|
|
property ParentColor default False;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property RightClickSelect;
|
|
property RowSelect;
|
|
property ScrollBars;
|
|
property SelectionColor;
|
|
property SelectionFontColor;
|
|
property SelectionFontColorUsed;
|
|
property SeparatorColor;
|
|
property ShowButtons;
|
|
property ShowHint;
|
|
property ShowLines;
|
|
property ShowRoot;
|
|
property SortType;
|
|
property StateImages;
|
|
property StateImagesWidth;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Tag;
|
|
property ToolTips;
|
|
property Visible;
|
|
property OnAddition;
|
|
property OnAdvancedCustomDraw;
|
|
property OnAdvancedCustomDrawItem;
|
|
property OnChange;
|
|
property OnChanging;
|
|
property OnClick;
|
|
property OnCollapsed;
|
|
property OnCollapsing;
|
|
property OnCompare;
|
|
property OnContextPopup;
|
|
property OnCreateNodeClass;
|
|
property OnCustomCreateItem;
|
|
property OnCustomDraw;
|
|
property OnCustomDrawItem;
|
|
property OnCustomDrawArrow;
|
|
property OnDblClick;
|
|
property OnDeletion;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEdited;
|
|
property OnEditing;
|
|
property OnEditingEnd;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnExpanded;
|
|
property OnExpanding;
|
|
property OnGetImageIndex;
|
|
property OnGetSelectedIndex;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnMouseWheelHorz;
|
|
property OnMouseWheelLeft;
|
|
property OnMouseWheelRight;
|
|
property OnNodeChanged;
|
|
property OnResize;
|
|
property OnSelectionChanged;
|
|
property OnShowHint;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property Options;
|
|
property Items;
|
|
property TreeLineColor;
|
|
property TreeLinePenStyle;
|
|
end;
|
|
|
|
|
|
TTVGetNodeText = function(Node: TTreeNode): string of object;
|
|
|
|
{ TTreeNodeExpandedState }
|
|
{ class to store and restore the expanded state of a TTreeView
|
|
The nodes are identified by their Text property.
|
|
|
|
Usage example:
|
|
// save old expanded state
|
|
OldExpanded:=TTreeNodeExpandedState.Create(ATreeView);
|
|
... change a lot of nodes ...
|
|
// restore old expanded state
|
|
OldExpanded.Apply(ATreeView);
|
|
OldExpanded.Free;
|
|
}
|
|
|
|
TTreeNodeExpandedState = class
|
|
private
|
|
FOnGetNodeText: TTVGetNodeText;
|
|
function DefaultGetNodeText(Node: TTreeNode): string;
|
|
public
|
|
NodeText: string;
|
|
Children: TAvlTree;
|
|
constructor Create(FirstTreeNode: TTreeNode; const GetNodeTextEvent: TTVGetNodeText = nil);
|
|
constructor Create(TreeView: TCustomTreeView; const GetNodeTextEvent: TTVGetNodeText = nil);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure CreateChildNodes(FirstTreeNode: TTreeNode);
|
|
procedure Apply(FirstTreeNode: TTreeNode; CollapseToo: boolean = true);
|
|
procedure Apply(TreeView: TCustomTreeView; CollapseToo: boolean = true);
|
|
property OnGetNodeText: TTVGetNodeText read FOnGetNodeText write FOnGetNodeText;
|
|
end;
|
|
|
|
|
|
|
|
TCustomHeaderControl = class;
|
|
|
|
|
|
{ THeaderSection }
|
|
THeaderSectionState =
|
|
(
|
|
hsNormal,
|
|
hsHot,
|
|
hsPressed
|
|
);
|
|
THeaderSection = class(TCollectionItem)
|
|
private
|
|
FAlignment: TAlignment;
|
|
FImageIndex: TImageIndex;
|
|
FMinWidth: Integer;
|
|
FMaxWidth: Integer;
|
|
FState: THeaderSectionState;
|
|
FText: TCaption;
|
|
FVisible: Boolean;
|
|
FWidth: Integer;
|
|
FOriginalIndex: Integer;
|
|
function GetWidth: Integer;
|
|
function GetLeft: Integer;
|
|
function GetRight: Integer;
|
|
procedure SetAlignment(const AValue: TAlignment);
|
|
procedure SetMaxWidth(AValue: Integer);
|
|
procedure SetMinWidth(AValue: Integer);
|
|
procedure SetState(const AValue: THeaderSectionState);
|
|
procedure SetText(const Value: TCaption);
|
|
procedure SetVisible(const AValue: Boolean);
|
|
procedure SetWidth(Value: Integer);
|
|
procedure SetImageIndex(const Value: TImageIndex);
|
|
procedure CheckConstraints;
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
property Left: Integer read GetLeft;
|
|
property Right: Integer read GetRight;
|
|
property State: THeaderSectionState read FState write SetState;
|
|
published
|
|
property Alignment: TAlignment read FAlignment write SetAlignment;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 10000;
|
|
property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
|
|
property Text: TCaption read FText write SetText;
|
|
property Width: Integer read GetWidth write SetWidth;
|
|
property Visible: Boolean read FVisible write SetVisible;
|
|
//index which doesn't change when the user reorders the sections
|
|
property OriginalIndex: Integer read FOriginalIndex;
|
|
end;
|
|
|
|
THeaderSectionClass = class of THeaderSection;
|
|
|
|
|
|
{ THeaderSections }
|
|
|
|
THeaderSections = class(TCollection)
|
|
private
|
|
FHeaderControl: TCustomHeaderControl;
|
|
function GetItem(Index: Integer): THeaderSection;
|
|
procedure SetItem(Index: Integer; Value: THeaderSection);
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(HeaderControl: TCustomHeaderControl);
|
|
function Add: THeaderSection;
|
|
function AddItem(Item: THeaderSection; Index: Integer): THeaderSection;
|
|
function Insert(Index: Integer): THeaderSection;
|
|
procedure Delete(Index: Integer);
|
|
property Items[Index: Integer]: THeaderSection read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TSectionTrackState = (tsTrackBegin, tsTrackMove, tsTrackEnd);
|
|
TCustomSectionTrackEvent = procedure(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState) of object;
|
|
TSectionDragEvent = procedure (Sender: TObject; FromSection, ToSection: THeaderSection;
|
|
var AllowDrag: Boolean) of object;
|
|
TCustomSectionNotifyEvent = procedure(HeaderControl: TCustomHeaderControl;
|
|
Section: THeaderSection) of object;
|
|
TCustomHCCreateSectionClassEvent = procedure(Sender: TCustomHeaderControl;
|
|
var SectionClass: THeaderSectionClass) of object;
|
|
|
|
|
|
{ TCustomHeaderControl }
|
|
|
|
TCustomHeaderControl = class(TCustomControl)
|
|
private
|
|
FDragReorder: boolean;
|
|
FSections: THeaderSections;
|
|
FImages: TCustomImageList;
|
|
FImagesWidth: Integer;
|
|
FPaintRect: TRect;
|
|
FDown: Boolean;
|
|
FDownPoint: TPoint;
|
|
FTracking, FDragging: Boolean;
|
|
FEndDragSectionIndex: longint;
|
|
FSelectedSection: longint;
|
|
FMouseInControl: Boolean;
|
|
FSavedCursor: TCursor;
|
|
|
|
FOnSectionClick: TCustomSectionNotifyEvent;
|
|
FOnSectionResize: TCustomSectionNotifyEvent;
|
|
FOnSectionTrack: TCustomSectionTrackEvent;
|
|
FOnSectionSeparatorDblClick: TCustomSectionNotifyEvent;
|
|
FOnSectionDrag: TSectionDragEvent;
|
|
FOnSectionEndDrag: TNotifyEvent;
|
|
FOnCreateSectionClass: TCustomHCCreateSectionClassEvent;
|
|
function GetSectionFromOriginalIndex(OriginalIndex: Integer): THeaderSection;
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const aImagesWidth: Integer);
|
|
procedure SetSections(const AValue: THeaderSections);
|
|
procedure UpdateSection(Index: Integer);
|
|
procedure UpdateSections;
|
|
protected
|
|
function CreateSection: THeaderSection; virtual;
|
|
function CreateSections: THeaderSections; virtual;
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SectionClick(Section: THeaderSection); virtual;
|
|
procedure SectionResize(Section: THeaderSection); virtual;
|
|
procedure SectionTrack(Section: THeaderSection; State: TSectionTrackState); virtual;
|
|
procedure SectionSeparatorDblClick(Section: THeaderSection); virtual;
|
|
procedure SectionEndDrag; virtual;
|
|
function SectionDrag(FromSection, ToSection: THeaderSection): Boolean; virtual;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure UpdateState;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
public
|
|
property SectionFromOriginalIndex[OriginalIndex: Integer]: THeaderSection read GetSectionFromOriginalIndex;
|
|
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Click; override;
|
|
procedure DblClick; override;
|
|
function GetSectionAt(P: TPoint): Integer;
|
|
procedure Paint; override;
|
|
procedure PaintSection(Index: Integer); virtual;
|
|
procedure ChangeScale(M, D: Integer);override;
|
|
published
|
|
property DragReorder: boolean read FDragReorder write FDragReorder;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property Sections: THeaderSections read FSections write SetSections;
|
|
|
|
property OnSectionDrag: TSectionDragEvent read FOnSectionDrag
|
|
write FOnSectionDrag;
|
|
property OnSectionEndDrag: TNotifyEvent read FOnSectionEndDrag write FOnSectionEndDrag;
|
|
property OnSectionClick: TCustomSectionNotifyEvent read FOnSectionClick
|
|
write FOnSectionClick;
|
|
property OnSectionResize: TCustomSectionNotifyEvent read FOnSectionResize
|
|
write FOnSectionResize;
|
|
property OnSectionTrack: TCustomSectionTrackEvent read FOnSectionTrack
|
|
write FOnSectionTrack;
|
|
property OnSectionSeparatorDblClick: TCustomSectionNotifyEvent read FOnSectionSeparatorDblClick
|
|
write FOnSectionSeparatorDblClick;
|
|
property OnCreateSectionClass: TCustomHCCreateSectionClassEvent read FOnCreateSectionClass
|
|
write FOnCreateSectionClass;
|
|
end;
|
|
|
|
|
|
{ THeaderControl }
|
|
|
|
THeaderControl = class(TCustomHeaderControl)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property BorderWidth;
|
|
property BorderSpacing;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property Constraints;
|
|
property Sections;
|
|
property ShowHint;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property Visible;
|
|
// events
|
|
property OnContextPopup;
|
|
property OnCreateSectionClass;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnMouseWheelHorz;
|
|
property OnMouseWheelLeft;
|
|
property OnMouseWheelRight;
|
|
property OnResize;
|
|
property OnSectionClick;
|
|
property OnSectionResize;
|
|
property OnSectionTrack;
|
|
end;
|
|
|
|
const
|
|
TCN_First = 0-550;
|
|
TCN_SELCHANGE = TCN_FIRST - 1;
|
|
TCN_SELCHANGING = TCN_FIRST - 2;
|
|
|
|
function CompareExpandedNodes(Data1, Data2: Pointer): integer;
|
|
function CompareTextWithExpandedNode(Key, Data: Pointer): integer;
|
|
function DbgS(Opt: TCTabControlOptions): String; overload;
|
|
|
|
procedure Register;
|
|
|
|
{ WidgetSetRegistration }
|
|
|
|
procedure RegisterCustomPage;
|
|
procedure RegisterCustomTabControl;
|
|
|
|
implementation
|
|
|
|
// !!! Avoid unit circles. Only add units if really needed.
|
|
uses
|
|
InterfaceBase, WSComCtrls, WSFactory;
|
|
|
|
const
|
|
AllPanelsParts = [Low(TPanelPart)..High(TPanelPart)];
|
|
|
|
{ TNBBasePages }
|
|
|
|
constructor TNBBasePages.Create(theNotebook: TCustomTabControl);
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
{$I custompage.inc}
|
|
{$I customnotebook.inc}
|
|
{$I statusbar.inc}
|
|
{$I statuspanel.inc}
|
|
{$I statuspanels.inc}
|
|
{$I tabsheet.inc}
|
|
{$I pagecontrol.inc}
|
|
{$I tabcontrol.inc}
|
|
{$I listcolumns.inc}
|
|
{$I listcolumn.inc}
|
|
{$I listitem.inc}
|
|
{$I listitems.inc}
|
|
{$I customlistview.inc}
|
|
{$I progressbar.inc}
|
|
{$I customupdown.inc}
|
|
{$I toolbutton.inc}
|
|
{$I toolbar.inc}
|
|
{$I coolbar.inc}
|
|
{$I trackbar.inc}
|
|
{$I treeview.inc}
|
|
{$I headercontrol.inc}
|
|
|
|
{ TTreeNodesEnumerator }
|
|
|
|
function TTreeNodesEnumerator.GetCurrent: TTreeNode;
|
|
begin
|
|
Result := FNodes[FPosition];
|
|
end;
|
|
|
|
constructor TTreeNodesEnumerator.Create(ANodes: TTreeNodes);
|
|
begin
|
|
inherited Create;
|
|
FNodes := ANodes;
|
|
FPosition := -1;
|
|
end;
|
|
|
|
function TTreeNodesEnumerator.MoveNext: Boolean;
|
|
begin
|
|
inc(FPosition);
|
|
Result := FPosition < FNodes.Count;
|
|
end;
|
|
|
|
{ TListItemsEnumerator }
|
|
|
|
function TListItemsEnumerator.GetCurrent: TListItem;
|
|
begin
|
|
Result := FItems[FPosition];
|
|
end;
|
|
|
|
constructor TListItemsEnumerator.Create(AItems: TListItems);
|
|
begin
|
|
inherited Create;
|
|
FItems := AItems;
|
|
FPosition := -1;
|
|
end;
|
|
|
|
function TListItemsEnumerator.MoveNext: Boolean;
|
|
begin
|
|
inc(FPosition);
|
|
Result := FPosition < FItems.Count;
|
|
end;
|
|
|
|
{ TToolBarEnumerator }
|
|
|
|
function TToolBarEnumerator.GetCurrent: TToolButton;
|
|
begin
|
|
Result := FToolBar.Buttons[FPosition];
|
|
end;
|
|
|
|
constructor TToolBarEnumerator.Create(AToolBar: TToolBar);
|
|
begin
|
|
inherited Create;
|
|
FToolBar := AToolBar;
|
|
FPosition := -1;
|
|
end;
|
|
|
|
function TToolBarEnumerator.MoveNext: Boolean;
|
|
begin
|
|
inc(FPosition);
|
|
Result := FPosition < FToolBar.ButtonCount;
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Common Controls',[TTrackbar,TProgressBar,TTreeView,
|
|
TListView,TStatusBar,TToolBar,TCoolBar,TUpDown,TPageControl,TTabControl,
|
|
THeaderControl]);
|
|
RegisterNoIcon([TToolButton,TTabSheet]);
|
|
end;
|
|
|
|
{ WidgetSetRegistration }
|
|
|
|
procedure RegisterCustomPage;
|
|
const
|
|
Done: Boolean = False;
|
|
begin
|
|
if Done then exit;
|
|
WSRegisterCustomPage;
|
|
// if not WSRegisterCustomPage then
|
|
// RegisterWSComponent(TCustomPage, TWSCustomPage);
|
|
Done := True;
|
|
end;
|
|
|
|
procedure RegisterCustomTabControl;
|
|
const
|
|
Done: Boolean = False;
|
|
begin
|
|
if Done then exit;
|
|
if not WSRegisterCustomNotebook then
|
|
RegisterWSComponent(TCustomTabControl, TWSCustomTabControl);
|
|
Done := True;
|
|
end;
|
|
|
|
end.
|