{ $Id: comctrls.pp 27046 2010-08-10 02:07:48Z paul $} { /*************************************************************************** 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 copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } { @abstract(Just a try to provide the same objects as the Delphi comctrls unit) @author(TCustomProgressBar - Stefan Hille ) @author(TTrackBar - Stefan Hille ) @created(1999) @lastmod(1999) } unit ComCtrls; {$mode objfpc} {$H+} interface uses SysUtils, Types, Classes, Math, LCLStrConsts, LResources, LCLIntf, LCLType, FileUtil, LCLProc, AvgLvlTree, LMessages, ImgList, ActnList, GraphType, Graphics, Menus, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons, Themes; 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 FText: string; 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: string); procedure SetWidth(Value: Integer); protected // field to use by interface. dont 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 Style: TStatusPanelStyle read FStyle write SetStyle default psText; property Text: string 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: String; FSimplePanel: Boolean; FOnDrawPanel: TDrawPanelEvent; FOnHint: TNotifyEvent; procedure SetPanels(Value: TStatusPanels); procedure SetSimpleText(const Value : String); 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; //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; 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 BorderSpacing; property Color default clBtnFace; property Constraints; property DragCursor; property DragKind; property DragMode; property Enabled; property Panels: TStatusPanels read FPanels write SetPanels; property ParentShowHint; property SimpleText: String 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 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 OnResize; property OnStartDock; property OnStartDrag; end; { TTabSheet } TPageControl = class; // TTabPosition is in extctrls.pas TTabStyle = (tsTabs, tsButtons, tsFlatButtons); { TTabSheet } 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 Caption; property ChildSizing; property ClientHeight; property ClientWidth; property Enabled; property Font; property Height stored False; property ImageIndex default 0; 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 OnResize; property OnShow; property OnStartDrag; property PageIndex stored False; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabVisible default True; property Top stored False; property Visible stored False; property Width stored False; end; { TPageControl } TPageControl = class(TCustomNotebook) private FPageToUndock: TTabSheet; FOnChange: TNotifyEvent; function GetActivePageIndex: Integer; function GetActiveTabSheet: TTabSheet; function GetTabIndex: Integer; function GetTabSheet(Index: Integer): TTabSheet; procedure SetActivePageIndex(const AValue: Integer); procedure SetActiveTabSheet(const AValue: TTabSheet); procedure SetTabIndex(const AValue: Integer); function FindPageWithDockClient(Client: TControl): TTabSheet; protected class procedure WSRegisterClass; 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; procedure DoChange; override; public constructor Create(TheOwner: TComponent); override; function FindNextPage(CurPage: TTabSheet; GoForward, CheckTabVisible: Boolean): TTabSheet; procedure SelectNextPage(GoForward: Boolean); procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean); 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 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: Integer read GetTabIndex write SetTabIndex default -1; property TabOrder; property TabPosition; property TabStop; //property TabWidth; property Visible; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChanging; 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 OnPageChanged; property OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; end; TCustomTabControl = class; { TTabControlStrings } TTabControlStrings = class(TStrings) private FHotTrack: Boolean; FImages: TCustomImageList; FMultiLine: Boolean; FMultiSelect: Boolean; FOwnerDraw: Boolean; FRaggedRight: Boolean; FScrollOpposite: Boolean; FTabControl: TCustomTabControl; FTabHeight: Smallint; FTabWidth: Smallint; 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 SetTabHeight(const AValue: Smallint); virtual; procedure SetTabIndex(const AValue: integer); virtual; abstract; procedure SetTabWidth(const AValue: Smallint); virtual; public constructor Create(TheTabControl: TCustomTabControl); 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: TCustomTabControl 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; property TabHeight: Smallint read FTabHeight write SetTabHeight; property TabWidth: Smallint read FTabWidth write SetTabWidth; end; { TTabControlNoteBookStrings } TTabControlNoteBookStrings = class(TTabControlStrings) private FNoteBook: TNoteBook; protected function Get(Index: Integer): string; override; function GetCount: Integer; override; function GetObject(Index: Integer): TObject; override; function GetTabIndex: integer; override; procedure NBChanging(Sender: TObject; var AllowChange: Boolean); virtual; procedure NBGetImageIndex(Sender: TObject; TheTabIndex: Integer; var ImageIndex: Integer); virtual; procedure NBPageChanged(Sender: TObject); virtual; procedure Put(Index: Integer; const S: string); override; procedure PutObject(Index: Integer; AObject: TObject); override; procedure SetImages(const AValue: TCustomImageList); override; procedure SetTabIndex(const AValue: integer); override; procedure SetUpdateState(Updating: Boolean); override; procedure SetTabHeight(const AValue: Smallint); override; procedure SetTabWidth(const AValue: Smallint); override; public constructor Create(TheTabControl: TCustomTabControl); 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; public property NoteBook: TNoteBook read FNoteBook; end; { TCustomTabControl } TDrawTabEvent = procedure(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean) of object; TCustomTabControl = class(TCustomControl) private FImageChangeLink: TChangeLink; FImages: TCustomImageList; FOnChange: TNotifyEvent; FOnChangeNeeded: Boolean; FOnChanging: TTabChangingEvent; FOnDrawTab: TDrawTabEvent; FOnGetImageIndex: TTabGetImageEvent; FStyle: TTabStyle; FTabControlCreating: Boolean; FTabPosition: TTabPosition; FTabs: TStrings;// this is a TTabControlNoteBookStrings 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 GetTabHeight: Smallint; function GetTabIndex: Integer; function GetTabRectWithBorder: TRect; function GetTabWidth: Smallint; 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(const AValue: TTabStyle); procedure SetTabHeight(const AValue: Smallint); procedure SetTabPosition(const AValue: TTabPosition); procedure SetTabs(const AValue: TStrings); procedure SetTabWidth(const AValue: Smallint); protected function CanChange: Boolean; virtual; function CanShowTab(ATabIndex: Integer): Boolean; virtual; procedure Change; virtual; procedure DrawTab(ATabIndex: Integer; const Rect: TRect; Active: Boolean); virtual; function GetImageIndex(ATabIndex: Integer): Integer; virtual; procedure Loaded; override; procedure CreateWnd; override; procedure DestroyHandle; override; procedure Notification(AComponent: TComponent; Operation: TOperation); 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 Paint; override; procedure AdjustDisplayRectWithBorder(var ARect: TRect); virtual; procedure AdjustClientRect(var ARect: TRect); override; protected property DisplayRect: TRect read GetDisplayRect; property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; property Images: TCustomImageList read FImages write SetImages; 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: TTabChangingEvent read FOnChanging write FOnChanging; property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab; property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex write FOnGetImageIndex; 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: TTabStyle read FStyle write SetStyle default tsTabs; property TabHeight: Smallint read GetTabHeight write SetTabHeight default 0; property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop; property TabWidth: Smallint read GetTabWidth write SetTabWidth default 0; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; function IndexOfTabAt(X, Y: Integer): Integer; function GetHitTestInfoAt(X, Y: Integer): THitTests; 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; property TabIndex: Integer read GetTabIndex write SetTabIndex default -1; property Tabs: TStrings read FTabs write SetTabs; public property TabStop default True; end; { TTabControl } TTabControl = class(TCustomTabControl) public property DisplayRect; published property Align; property Anchors; property BorderSpacing; property Constraints; property DockSite; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property HotTrack; property Images; property MultiLine; property MultiSelect; property OnChange; property OnChangeBounds; property OnChanging; 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 OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; property OwnerDraw; property ParentFont; property ParentShowHint; property PopupMenu; property RaggedRight; property ScrollOpposite; property ShowHint; property Style; property TabHeight; property TabIndex; property TabOrder; property TabPosition; property Tabs; property TabStop; property TabWidth; 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 GetCheckedInternal: Boolean; function GetOwner: TPersistent; override; public procedure Assign(ASource: TPersistent); override; constructor Create(AOwner: TListItems); destructor Destroy; override; procedure Delete; procedure MakeVisible(PartialOK: Boolean); function DisplayRect(Code: TDisplayCode): TRect; function DisplayRectSubItem(subItem: integer;Code: TDisplayCode): TRect; 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; { 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; public procedure SetDataIndex(ADataIndex: Integer); 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: TList; 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; function GetItem(const AIndex: Integer): TListItem; function GetOwner: TPersistent; override; procedure WSCreateItems; procedure DoFinalizeWnd; procedure SetCount(const ACount: Integer); procedure SetItem(const AIndex: Integer; const AValue: TListItem); public function Add: TListItem; procedure AddItem(AItem: TListItem); procedure BeginUpdate; procedure Clear; constructor Create(AOwner : TCustomListView); destructor Destroy; override; procedure Delete(const AIndex : Integer); procedure EndUpdate; function FindCaption(StartIndex: Integer; Value: string; Partial, Inclusive, Wrap: Boolean; PartStart: Boolean = True): TListItem; function FindData(const AData: Pointer): TListItem; 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; { TListColumn } TWidth = 0..MaxInt; TListColumn = class(TCollectionItem) private FAlignment: TAlignment; FAutoSize: Boolean; FCaption: TTranslateString; FMinWidth: TWidth; FMaxWidth: TWidth; FVisible: Boolean; FWidth: TWidth; FImageIndex: TImageIndex; FTag: Integer; 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); 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; 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: Integer read FTag write FTag default 0; property Visible: Boolean read FVisible write SetVisible default true; property Width: TWidth read GetWidth write SetWidth default 50; 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); 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); TLVChangeEvent = procedure(Sender: TObject; Item: TListItem; Change: TItemChange) of object; TLVColumnClickEvent = procedure(Sender: TObject; Column: TListColumn) of object; TLVColumnRClickEvent = procedure(Sender: TObject; Column: TListColumn; Point: TPoint) of object; TLVCompareEvent = procedure(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer) of object; TLVDeletedEvent = procedure(Sender: TObject; Item: TListItem) of object; TLVInsertEvent = TLVDeletedEvent; TLVDataEvent = TLVDeletedEvent; 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; 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; 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 ); TListViewFlags = set of TListViewFlag; { TCustomListView } TCustomListView = class(TWinControl) private FAllocBy: Integer; FCanvas: TCanvas; FDefaultItemHeight: integer; FHotTrackStyles: TListHotTrackStyles; FIconOptions: TIconOptions; FOwnerData: Boolean; FOwnerDataItem: TOwnerDataListItem; FListItems: TListItems; FColumns: TListColumns; FImages: array[TListViewImageList] of TCustomImageList; FImageChangeLinks: array[TListViewImageList] of TChangeLink; FFlags: TListViewFlags; FViewStyle: TViewStyle; FSortType: TSortType; FSortColumn: Integer; 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; FOnDeletion: TLVDeletedEvent; FOnInsert: TLVInsertEvent; FOnSelectItem: TLVSelectItemEvent; FOnCustomDraw: TLVCustomDrawEvent; FOnCustomDrawItem: TLVCustomDrawItemEvent; FOnCustomDrawSubItem: TLVCustomDrawSubItemEvent; FOnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent; FOnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent; FOnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent; FProperties: TListViewProperties; function GetBoundingRect: TRect; function GetColumnFromIndex(AIndex: Integer): TListColumn; function GetDropTarget: TListItem; function GetFocused: TListItem; function GetImageList(const ALvilOrd: Integer): TCustomImageList; 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 SetAllocBy(const AValue: Integer); 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 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 SetSortColumn(const AValue: Integer); procedure SetSortType(const AValue: TSortType); procedure SetViewOrigin(AValue: TPoint); procedure SetViewStyle(const Avalue: TViewStyle); procedure Sort; procedure UpdateScrollbars; procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY; procedure InvalidateSelected; 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; procedure Change(AItem: TListItem; AChange: Integer); virtual; procedure ColClick(AColumn: TListColumn); virtual; procedure Delete(Item : TListItem); procedure DoDeletion(AItem: TListItem); virtual; procedure DoInsert(AItem: TListItem); virtual; procedure DoSelectItem(AItem: TListItem; ASelected: Boolean); virtual; procedure InsertItem(Item : TListItem); procedure ImageChanged(Sender : TObject); procedure Loaded; 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 DoGetOwnerData(Item: TListItem); virtual; protected property AllocBy: Integer read FAllocBy write SetAllocBy default 0; 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 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 SortType: TSortType read FSortType write SetSortType default stNone; property SortColumn: Integer read FSortColumn write SetSortColumn default 0; property StateImages: TCustomImageList index Ord(lvilState) read GetImageList write SetImageList; 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 OnData: TLVDataEvent read FOnData write FOnData; property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion; property OnInsert: TLVInsertEvent read FOnInsert write FOnInsert; 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 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 BeginUpdate; procedure Clear; procedure EndUpdate; function FindCaption(StartIndex: Integer; Value: string; Partial, Inclusive, Wrap: Boolean; PartStart: Boolean = True): TListItem; function GetHitTestInfoAt(X, Y: Integer): THitTests; function GetItemAt(x,y: integer): TListItem; 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 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 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 BorderSpacing; property BorderStyle; property BorderWidth; property Checkboxes; property Color default clWindow; property Columns; property ColumnClick; property Constraints; property DragCursor; property DragKind; property DragMode; // property DefaultItemHeight; // property DropTarget; property Enabled; // property FlatScrollBars; property Font; // property FullDrag; // property GridLines; property HideSelection; // property HotTrack; // property HotTrackStyles; // property HoverTime; property IconOptions; property ItemIndex; property Items; property LargeImages; 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 ShowWorkAreas; property SmallImages; property SortColumn; property SortType; property StateImages; 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 OnCustomDraw; property OnCustomDrawItem; property OnCustomDrawSubItem; property OnData; property OnDblClick; property OnDeletion; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; property OnSelectItem; property OnStartDock; property OnStartDrag; property OnUTF8KeyPress; end; TProgressBarOrientation = (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown); TProgressBarStyle = (pbstNormal, pbstMarquee); { TCustomProgressBar } { @abstract(Simple progressbar.) Introduced by Author Name Currently maintained by Maintainer Name } 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 Constraints; property DragCursor; property DragKind; property DragMode; property Enabled; 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 OnStartDock; property OnStartDrag; property Orientation; 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); TUDBtnType = (btNext, btPrev); TUDClickEvent = procedure (Sender: TObject; Button: TUDBtnType) of object; TUDChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object; { TCustomUpDown } TCustomUpDown = class(TCustomControl) private MinBtn: TControl;// TSpeedButton MaxBtn: TControl;// TSpeedButton BTimerProc: procedure of Object; BTimerBounds : TRect; FArrowKeys: Boolean; FAssociate: TWinControl; FMin: SmallInt; FMax: SmallInt; FIncrement: Integer; FPosition: SmallInt; FThousands: Boolean; FWrap: Boolean; FOnClick: TUDClickEvent; FAlignButton: TUDAlignButton; FOrientation: TUDOrientation; FOnChanging: TUDChangingEvent; function GetPosition: SmallInt; procedure BTimerExec(Sender : TObject); 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 SetOrientation(Value: TUDOrientation); procedure SetPosition(Value: SmallInt); procedure SetThousands(Value: Boolean); procedure SetWrap(Value: Boolean); procedure UpdateAlignButtonPos; procedure UpdateOrientation; procedure UpdateUpDownPositionText; protected class procedure WSRegisterClass; override; procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState); procedure OnAssociateChangeBounds(Sender: TObject); procedure DoOnResize; override; class function GetControlClassDefaultSize: TSize; override; function CanChange: Boolean; virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Click(Button: TUDBtnType); virtual; overload; 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 Min: SmallInt read FMin write SetMin; property Max: SmallInt read FMax write SetMax default 100; property Increment: Integer read FIncrement write SetIncrement default 1; 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 Wrap: Boolean read FWrap write SetWrap; property OnChanging: TUDChangingEvent read FOnChanging write FOnChanging; property OnClick: TUDClickEvent read FOnClick write FOnClick; public constructor Create(AOwner: TComponent); override; destructor Destroy; Override; end; { TUpDown } TUpDown = class(TCustomUpDown) published property AlignButton; property Anchors; property Associate; property ArrowKeys; property BorderSpacing; property Enabled; property Hint; property Min; property Max; property Increment; property Constraints; property Orientation; property ParentShowHint; property PopupMenu; property Position; property ShowHint; property TabOrder; property TabStop; property Thousands; property Visible; property Wrap; property OnChanging; property OnClick; property OnContextPopup; property OnEnter; property OnExit; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; 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 ); TToolButtonFlag = ( tbfPressed, // set while mouse is pressed on button tbfArrowPressed // set while mouse is pressed on arrow button ); 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; FShowCaption: boolean; FStyle: TToolButtonStyle; FToolButtonFlags: TToolButtonFlags; FUpdateCount: Integer; FWrap: Boolean; procedure GetGroupBounds(var StartIndex, EndIndex: integer); function GetIndex: Integer; function GetTextSize: TSize; function IsCheckedStored: 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 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 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; 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 GetCurrentIcon(var ImageList: TCustomImageList; var TheIndex: integer); virtual; procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; Raw: boolean = false; WithThemeSpace: boolean = true); override; property Index: Integer read GetIndex; 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 False; 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 OnClick; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; 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 } TToolBarFlag = ( tbfUpdateVisibleBarNeeded, tbfPlacingControls ); TToolBarFlags = set of TToolBarFlag; TToolBar = class(TToolWindow) private FButtonHeight: Integer; FRealizedButtonHeight: integer; FButtons: TList; FButtonWidth: Integer; FDisabledImageChangeLink: TChangeLink; FDisabledImages: TCustomImageList; FDropDownWidth: 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; FTransparent: Boolean; FUpdateCount: Integer; FWrapable: Boolean; procedure ApplyFontForButtons; function GetButton(Index: Integer): TToolButton; function GetButtonCount: Integer; procedure SetButtonHeight(const AValue: Integer); procedure SetButtonWidth(const AValue: Integer); procedure SetDisabledImages(const AValue: TCustomImageList); procedure SetFlat(const AValue: Boolean); procedure SetHotImages(const AValue: TCustomImageList); procedure SetImages(const AValue: TCustomImageList); 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 OnTemporaryPopupMenuClose(Sender: TObject); procedure MoveSubMenuItems(SrcMenuItem, DestMenuItem: TMenuItem); procedure AddButton(Button: TToolButton); procedure RemoveButton(Button: TToolButton); function IsVertical: Boolean; protected class procedure WSRegisterClass; override; procedure AdjustClientRect(var ARect: TRect); override; 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 ControlsAligned; override; function FindButtonFromAccel(Accel: Word): TToolButton; procedure FontChanged(Sender: TObject); override; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure RepositionButton(Index: Integer); procedure RepositionButtons(Index: Integer); function WrapButtons(UseWidth: integer; out NewWidth, NewHeight: Integer; Simulate: boolean): Boolean; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure FlipChildren(AllLevels: Boolean); override; procedure BeginUpdate; virtual; procedure EndUpdate; virtual; function GetEnumerator: TToolBarEnumerator; procedure Paint; override; 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; published property Align default alTop; property Anchors; property AutoSize; property BorderSpacing; property BorderWidth; property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 22; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 23; property Caption; property ChildSizing; property Constraints; property Color; //property Customizable: Boolean read FCustomizable write SetCustomizable default False; property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages; property DragCursor; property DragKind; property DragMode; 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 HideClippedButtons: Boolean read FHideClippedButtons write SetHideClippedButtons default False; property HotImages: TCustomImageList read FHotImages write SetHotImages; property Images: TCustomImageList read FImages write SetImages; property Indent: Integer read FIndent write SetIndent default 1; property List: Boolean read FList write SetList default False; //property Menu: TMainMenu read FMenu write SetMenu; 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 FTransparent 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 OnEndDrag; property OnEnter; property OnExit; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseEnter; property OnMouseLeave; property OnResize; property OnChangeBounds; property OnStartDrag; end; { TCustomTrackBar } TTrackBarOrientation = (trHorizontal, trVertical); TTickMark = (tmBottomRight, tmTopLeft, tmBoth); TTickStyle = (tsNone, tsAuto, tsManual); TTrackBarScalePos = (trLeft, trRight, trTop, trBottom); TCustomTrackBar = class(TWinControl) private FOrientation: TTrackBarOrientation; 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 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; public constructor Create(AOwner: TComponent); override; procedure SetTick(Value: Integer); published 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 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 Constraints; property DragCursor; property DragMode; property Enabled; 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 OnKeyDown; property OnKeyPress; property OnKeyUp; property OnResize; property OnStartDrag; property OnUTF8KeyPress; property Orientation; property PageSize; property ParentShowHint; property PopupMenu; property Position; 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, nsDropHilited, nsFocused, nsSelected, nsMultiSelected, nsExpanded, nsHasChildren, nsInTree, nsDeleting, nsBound); 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); TTreeNodeArray = ^TTreeNode; ETreeNodeError = class(Exception); ETreeViewError = class(ETreeNodeError); const NodeAttachModeNames: array[TNodeAttachMode] of string = ('naAdd', 'naAddFirst', 'naAddChild', 'naAddChildFirst', 'naInsert', 'naInsertBehind'); AddModeNames: array[TAddMode] of string = ('taAddFirst', 'taAdd', 'taInsert'); LCLStreamID = -7; type TTVChangingEvent = procedure(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean) of object; TTVChangedEvent = procedure(Sender: TObject; Node: TTreeNode) of object; TTVEditingEvent = procedure(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean) of object; TTVEditedEvent = procedure(Sender: TObject; Node: TTreeNode; var S: string) of object; TTVEditEndEvent = procedure(Sender: TObject; Node: TTreeNode; Cancel: Boolean) 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; 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: Pointer; 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: 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 childs in FItems FData: Pointer; // custom data FHeight: integer; // height in pixels 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 AreParentsExpanded: Boolean; procedure BindToMultiSelected; function CompareCount(CompareMe: Integer): Boolean; function DoCanExpand(ExpandIt: Boolean): Boolean; procedure DoExpand(ExpandIt: Boolean); procedure ExpandItem(ExpandIt: Boolean; 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; 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 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 Unbind; procedure UnbindFromMultiSelected; procedure WriteData(Stream: TStream); procedure WriteDelphiData(Stream: TStream; Info: PDelphiNodeInfo); protected function GetOwner: TPersistent; override; public constructor Create(AnOwner: TTreeNodes); function AlphaSort: Boolean; procedure Assign(Source: TPersistent); override; procedure Collapse(Recurse: Boolean); function CustomSort(SortProc: TTreeNodeCompare): Boolean; function DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer; procedure Delete; procedure DeleteChildren; destructor Destroy; override; 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; procedure EndEdit(Cancel: Boolean); procedure Expand(Recurse: Boolean); procedure ExpandParents; function Bottom: integer; function BottomExpanded: integer; function GetParentNodeOfAbsoluteLevel(TheAbsoluteLevel: integer): TTreeNode; function GetFirstChild: TTreeNode; function GetHandle: THandle; function GetLastSibling: TTreeNode; function GetLastChild: TTreeNode; function GetLastSubChild: TTreeNode; function GetNext: TTreeNode; function GetNextChild(AValue: TTreeNode): TTreeNode; function GetNextExpanded: TTreeNode; function GetNextMultiSelected: TTreeNode; function GetNextSibling: TTreeNode; function GetNextVisible: TTreeNode; function GetPrev: TTreeNode; function GetPrevChild(AValue: TTreeNode): TTreeNode; function GetPrevExpanded: TTreeNode; function GetPrevMultiSelected: TTreeNode; function GetPrevSibling: TTreeNode; function GetPrevVisible: TTreeNode; function HasAsParent(AValue: TTreeNode): Boolean; function IndexOf(AValue: TTreeNode): Integer; function IndexOfText(const NodeText: string): Integer; function FindNode(const NodeText: string): TTreeNode; function GetTextPath: string; procedure MakeVisible; procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual; procedure MultiSelectGroup; procedure Update; procedure ConsistencyCheck; 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 Focused: Boolean read GetFocused write SetFocused; property DropTarget: Boolean read GetDropTarget write SetDropTarget; property Expanded: Boolean read GetExpanded write SetExpanded; 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 IsVisible: Boolean read IsNodeVisible; property IsFullHeightVisible: Boolean read IsNodeHeightFullVisible; property Items[ItemIndex: Integer]: TTreeNode read GetItems write SetItems; default; property Level: Integer read GetLevel; property MultiSelected: Boolean read GetMultiSelected write SetMultiSelected; 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 SubTreeCount: integer read FSubTreeCount; property StateIndex: Integer read FStateIndex write SetStateIndex default -1; property Text: string read FText write SetText; property TreeNodes: TTreeNodes read GetTreeNodes; property TreeView: TCustomTreeView read GetTreeView; property Top: integer read GetTop; 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; FFirstMultiSelected: TTreeNode; FLastMultiSelected: TTreeNode; FKeepCollapsedNodes: boolean; FNodeCache: TNodeCache; FOwner: TCustomTreeView; FTopLvlCapacity: integer; FTopLvlCount: integer; FTopLvlItems: TTreeNodeArray; // root and root siblings FUpdateCount: Integer; procedure ClearCache; function GetHandle: THandle; function GetNodeFromIndex(Index: Integer): TTreeNode; 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); 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 AddObject(SiblingNode: TTreeNode; const S: string; Data: Pointer): TTreeNode; function AddObjectFirst(SiblingNode: TTreeNode; const S: string; Data: Pointer): TTreeNode; procedure Assign(Source: TPersistent); override; procedure BeginUpdate; procedure Clear; procedure ClearMultiSelection(ClearSelected: boolean = false); procedure SelectOnlyThis(Node: TTreeNode); function IsMultiSelection: boolean; procedure Delete(Node: TTreeNode); procedure EndUpdate; function GetEnumerator: TTreeNodesEnumerator; function GetFirstNode: TTreeNode; function GetLastNode: TTreeNode; // last top level node function GetLastSubNode: TTreeNode; // absolute last node function GetLastExpandedSubNode: TTreeNode; // absolute last node function FindTopLvlNode(const NodeText: string): TTreeNode; function FindNodeWithText(const NodeText: string): TTreeNode; function FindNodeWithData(const NodeData: Pointer): TTreeNode; function Insert(NextNode: TTreeNode; const S: string): TTreeNode; function InsertObject(NextNode: TTreeNode; const S: string; Data: Pointer): TTreeNode; function InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode; function InsertObjectBehind(PrevNode: TTreeNode; const S: string; Data: Pointer): TTreeNode; procedure SortTopLevelNodes(SortProc: TTreeNodeCompare); procedure ConsistencyCheck; 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 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, tvsDblClicked, tvsTripleClicked, tvsQuadClicked, tvsSelectionChanged, tvsEditOnMouseUp ); TTreeViewStates = set of TTreeViewState; TTreeViewOption = ( tvoAllowMultiselect, tvoAutoExpand, tvoAutoInsertMark, tvoAutoItemHeight, tvoHideSelection, tvoHotTrack, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoShowSeparators, tvoToolTips, tvoNoDoubleClickExpand, tvoThemedDraw ); TTreeViewOptions = set of TTreeViewOption; const DefaultTreeViewOptions = [tvoShowRoot, tvoShowLines, tvoShowButtons, tvoHideSelection, tvoToolTips, tvoKeepCollapsedNodes, tvoAutoItemHeight, tvoThemedDraw]; type TTreeViewExpandSignType = ( tvestTheme, // use themed sign tvestPlusMinus, // use +/- sign tvestArrow // use arrow ); TTreeViewInsertMarkType = ( tvimNone, tvimAsFirstChild, // or as root tvimAsNextSibling, tvimAsPrevSibling ); TCustomTreeView = class(TCustomControl) private FBackgroundColor: TColor; FBottomItem: TTreeNode; FEditingItem: TTreeNode; FExpandSignType: TTreeViewExpandSignType; FExpandSignSize: integer; FDefItemHeight: integer; FDragImage: TDragImageList; FDragNode: TTreeNode; FIndent: integer; FImageChangeLink: TChangeLink; FImages: TCustomImageList; 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; FOnAddition: TTVExpandedEvent; FOnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent; FOnAdvancedCustomDrawItem: TTVAdvancedCustomDrawItemEvent; FOnChange: TTVChangedEvent; FOnChanging: TTVChangingEvent; FOnCollapsed: TTVExpandedEvent; FOnCollapsing: TTVCollapsingEvent; FOnCompare: TTVCompareEvent; FOnCreateNodeClass: TTVCreateNodeClassEvent; FOnCustomCreateItem: TTVCustomCreateNodeEvent; FOnCustomDraw: TTVCustomDrawEvent; FOnCustomDrawItem: TTVCustomDrawItemEvent; FOnDeletion: TTVExpandedEvent; FOnEditing: TTVEditingEvent; FOnEdited: TTVEditedEvent; FOnEditEnd: TTVEditEndEvent; FOnExpanded: TTVExpandedEvent; FOnExpanding: TTVExpandingEvent; FOnGetImageIndex: TTVExpandedEvent; FOnGetSelectedIndex: TTVExpandedEvent; 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) FSelectedColor: TColor; FSelectedNode: TTreeNode; fSelectionChangeEventLock: integer; fSeparatorColor: TColor; FSortType: TSortType; FStateChangeLink: TChangeLink; FStateImages: TCustomImageList; FStates: TTreeViewStates; FTopItem: TTreeNode; FTreeLineColor: TColor; FTreeLinePenStyle: TPenStyle; FExpandSignColor : TColor; FTreeNodes: TTreeNodes; procedure CanvasChanged(Sender: TObject); function GetAutoExpand: boolean; function GetBottomItem: TTreeNode; function GetDropTarget: TTreeNode; function GetHideSelection: boolean; function GetHotTrack: boolean; function GetKeepCollapsedNodes: boolean; function GetReadOnly: boolean; function GetRightClickSelect: boolean; function GetRowSelect: boolean; function GetSelection: TTreeNode; function GetShowButtons: boolean; function GetShowLines: boolean; function GetShowRoot: boolean; function GetShowSeparators: boolean; function GetToolTips: boolean; function GetTopItem: TTreeNode; procedure ImageListChange(Sender: TObject); 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 SetInsertMarkNode(const AValue: TTreeNode); procedure SetInsertMarkType(const AValue: TTreeViewInsertMarkType); procedure SetKeepCollapsedNodes(Value: Boolean); 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 SetSelection(Value: TTreeNode); procedure SetSeparatorColor(const AValue: TColor); procedure SetShowButton(Value: Boolean); procedure SetShowLines(Value: Boolean); procedure SetShowRoot(Value: Boolean); procedure SetShowSeparators(Value: Boolean); procedure SetSortType(Value: TSortType); procedure SetStateImages(Value: TCustomImageList); procedure SetToolTips(Value: Boolean); procedure SetTreeLineColor(Value: TColor); procedure SetTreeNodes(Value: TTreeNodes); procedure SetTopItem(Value: TTreeNode); procedure UpdateAllTops; procedure UpdateBottomItem; procedure UpdateExpandSignSize; procedure UpdateMaxLvl; procedure UpdateMaxRight; procedure UpdateTopItem; procedure UpdateScrollbars; procedure InternalSelectionChanged; 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); 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 CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; virtual; function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual; function GetDragImages: TDragImageList; override; function GetMaxLvl: integer; function GetMaxScrollLeft: integer; function GetMaxScrollTop: integer; function GetNodeAtInternalY(Y: Integer): TTreeNode; function GetNodeAtY(Y: Integer): TTreeNode; function GetNodeDrawAreaHeight: integer; function GetNodeDrawAreaWidth: integer; function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; function IsNodeVisible(ANode: TTreeNode): Boolean; function IsNodeHeightFullVisible(ANode: TTreeNode): Boolean; function IsInsertMarkVisible: boolean; virtual; procedure Change(Node: TTreeNode); virtual; procedure Collapse(Node: TTreeNode); virtual; procedure CreateWnd; override; procedure Delete(Node: TTreeNode); virtual; procedure DestroyWnd; override; procedure DoEndDrag(Target: TObject; X, Y: Integer); override; function DoMouseWheel(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); 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 Notification(AComponent: TComponent; Operation: TOperation); override; procedure Paint; override; procedure SetDragMode(Value: TDragMode); override; procedure SetOptions(NewOptions: TTreeViewOptions); procedure UpdateDefaultItemHeight; virtual; procedure WndProc(var Message: TLMessage); override; 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 WMNotify(var AMessage: TLMNotify); message LM_NOTIFY; procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; procedure Resize; override; 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 Images: TCustomImageList read FImages write SetImages; property Indent: Integer read FIndent write SetIndent default 15; property Items: TTreeNodes read FTreeNodes write SetTreeNodes; 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 OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion; property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited; property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing; property OnEditEnd: TTVEditEndEvent read FOnEditEnd write FOnEditEnd; 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 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 StateImages: TCustomImageList read FStateImages write SetStateImages; property ToolTips: Boolean read GetToolTips write SetToolTips default True; public constructor Create(AnOwner: TComponent); override; destructor Destroy; override; function AlphaSort: Boolean; 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; 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; function SelectionVisible: boolean; procedure MakeSelectionVisible; public property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clWindow; property BorderWidth default 0; property BottomItem: TTreeNode read GetBottomItem write SetBottomItem; property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight default 20; property DropTarget: TTreeNode read GetDropTarget write SetDropTarget; property ExpandSignType: TTreeViewExpandSignType read FExpandSignType write SetExpandSignType default tvestTheme; property InsertMarkNode: TTreeNode read FInsertMarkNode write SetInsertMarkNode; property InsertMarkType: TTreeViewInsertMarkType read FInsertMarkType write SetInsertMarkType; property KeepCollapsedNodes: boolean read GetKeepCollapsedNodes write SetKeepCollapsedNodes; 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 SeparatorColor: TColor read fSeparatorColor write SetSeparatorColor default clGray; 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; property ExpandSignColor: TColor read FExpandSignColor write FExpandSignColor default clWindowFrame; published property TabStop default true; end; { TTreeView } TTreeView = class(TCustomTreeView) published property Align; property Anchors; property AutoExpand; property BorderSpacing; //property BiDiMode; property BackgroundColor; property BorderStyle; property BorderWidth; property Color; property Constraints; property DefaultItemHeight; property DragKind; property DragCursor; property DragMode; property Enabled; property ExpandSignType; property Font; property HideSelection; property HotTrack; property Images; property Indent; //property ParentBiDiMode; property ParentColor default False; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property RightClickSelect; property RowSelect; property ScrollBars; property SelectionColor; property ShowButtons; property ShowHint; property ShowLines; property ShowRoot; property SortType; property StateImages; 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 OnDblClick; property OnDeletion; property OnDragDrop; property OnDragOver; property OnEdited; property OnEditing; property OnEditEnd; //property OnEndDock; 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 OnSelectionChanged; property OnShowHint; //property OnStartDock; property OnStartDrag; property OnUTF8KeyPress; property Options; property Items; property TreeLineColor; property TreeLinePenStyle; property ExpandSignColor; end; { 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 NodeText: string; Childs: TAvgLvlTree; constructor Create(FirstTreeNode: TTreeNode); constructor Create(TreeView: TCustomTreeView); destructor Destroy; override; procedure Clear; procedure CreateChildNodes(FirstTreeNode: TTreeNode); procedure Apply(FirstTreeNode: TTreeNode); procedure Apply(TreeView: TCustomTreeView); end; TCustomHeaderControl = class; { THeaderSection } THeaderSectionState = ( hsNormal, hsHot, hsPressed ); THeaderSection = class(TCollectionItem) private FAlignment: TAlignment; FImageIndex: TImageIndex; FMinWidth: Integer; FMaxWidth: Integer; FState: THeaderSectionState; FText: string; 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: string); 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: string 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; FPaintRect: TRect; FDown: Boolean; FDownPoint: TPoint; FTracking, FDragging: Boolean; FEndDragSectionIndex: longint; FSelectedSection: longint; FMouseInControl: Boolean; 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 SetSections(const AValue: THeaderSections); procedure UpdateSection(Index: Integer); procedure UpdateSections; protected function CreateSection: THeaderSection; virtual; function CreateSections: THeaderSections; virtual; 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; 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; published property DragReorder: boolean read FDragReorder write FDragReorder; property Images: TCustomImageList read FImages write SetImages; 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 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 OnResize; property OnSectionClick; property OnSectionResize; property OnSectionTrack; end; function CompareExpandedNodes(Data1, Data2: Pointer): integer; function CompareTextWithExpandedNode(Key, Data: Pointer): integer; procedure Register; implementation // !!! Avoid unit circles. Only add units if really needed. uses WSComCtrls; const ScrollBarWidth = 0; AllPanelsParts = [Low(TPanelPart)..High(TPanelPart)]; {$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 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,TUpDown,TPageControl,TTabControl, THeaderControl]); RegisterNoIcon([TToolButton,TTabSheet]); end; end.