home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Install / DATA.Z / COMCTRLS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-09  |  232.9 KB  |  8,427 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1996 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ComCtrls;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Messages, Windows, SysUtils, CommCtrl, Classes, Controls, Forms,
  17.   Menus, Graphics, StdCtrls, RichEdit;
  18.  
  19. type
  20.   TTabChangingEvent = procedure(Sender: TObject;
  21.     var AllowChange: Boolean) of object;
  22.  
  23.   TCustomTabControl = class(TWinControl)
  24.   private
  25.     FTabs: TStrings;
  26.     FSaveTabs: TStringList;
  27.     FSaveTabIndex: Integer;
  28.     FTabSize: TSmallPoint;
  29.     FMultiLine: Boolean;
  30.     FUpdating: Boolean;
  31.     FOnChange: TNotifyEvent;
  32.     FOnChanging: TTabChangingEvent;
  33.     function GetDisplayRect: TRect;
  34.     function GetTabIndex: Integer;
  35.     procedure SetMultiLine(Value: Boolean);
  36.     procedure SetTabHeight(Value: Smallint);
  37.     procedure SetTabIndex(Value: Integer);
  38.     procedure SetTabs(Value: TStrings);
  39.     procedure SetTabWidth(Value: Smallint);
  40.     procedure TabsChanged;
  41.     procedure UpdateTabSize;
  42.     procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
  43.     procedure CMTabStopChanged(var Message: TMessage); message CM_TABSTOPCHANGED;
  44.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  45.   protected
  46.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  47.     function CanChange: Boolean; dynamic;
  48.     procedure Change; dynamic;
  49.     procedure CreateParams(var Params: TCreateParams); override;
  50.     procedure CreateWnd; override;
  51.     procedure DestroyWnd; override;
  52.     property DisplayRect: TRect read GetDisplayRect;
  53.     property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
  54.     property TabHeight: Smallint read FTabSize.Y write SetTabHeight default 0;
  55.     property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
  56.     property Tabs: TStrings read FTabs write SetTabs;
  57.     property TabWidth: Smallint read FTabSize.X write SetTabWidth default 0;
  58.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  59.     property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
  60.   public
  61.     constructor Create(AOwner: TComponent); override;
  62.     destructor Destroy; override;
  63.     property TabStop default True;
  64.   end;
  65.  
  66.   TTabControl = class(TCustomTabControl)
  67.   public
  68.     property DisplayRect;
  69.   published
  70.     property Align;
  71.     property DragCursor;
  72.     property DragMode;
  73.     property Enabled;
  74.     property Font;
  75.     property MultiLine;
  76.     property ParentFont;
  77.     property ParentShowHint;
  78.     property PopupMenu;
  79.     property ShowHint;
  80.     property TabHeight;
  81.     property TabIndex;
  82.     property TabOrder;
  83.     property Tabs;
  84.     property TabStop;
  85.     property TabWidth;
  86.     property Visible;
  87.     property OnChange;
  88.     property OnChanging;
  89.     property OnDragDrop;
  90.     property OnDragOver;
  91.     property OnEndDrag;
  92.     property OnEnter;
  93.     property OnExit;
  94.     property OnMouseDown;
  95.     property OnMouseMove;
  96.     property OnMouseUp;
  97.     property OnStartDrag;
  98.   end;
  99.  
  100.   TPageControl = class;
  101.  
  102.   TTabSheet = class(TWinControl)
  103.   private
  104.     FPageControl: TPageControl;
  105.     FTabVisible: Boolean;
  106.     FTabShowing: Boolean;
  107.     function GetPageIndex: Integer;
  108.     function GetTabIndex: Integer;
  109.     procedure SetPageControl(APageControl: TPageControl);
  110.     procedure SetPageIndex(Value: Integer);
  111.     procedure SetTabShowing(Value: Boolean);
  112.     procedure SetTabVisible(Value: Boolean);
  113.     procedure UpdateTabShowing;
  114.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  115.   protected
  116.     procedure ReadState(Reader: TReader); override;
  117.   public
  118.     constructor Create(AOwner: TComponent); override;
  119.     destructor Destroy; override;
  120.     property PageControl: TPageControl read FPageControl write SetPageControl;
  121.     property TabIndex: Integer read GetTabIndex;
  122.   published
  123.     property Caption;
  124.     property Enabled;
  125.     property Font;
  126.     property Height stored False;
  127.     property Left stored False;
  128.     property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
  129.     property ParentFont;
  130.     property ParentShowHint;
  131.     property PopupMenu;
  132.     property ShowHint;
  133.     property TabVisible: Boolean read FTabVisible write SetTabVisible default True;
  134.     property Top stored False;
  135.     property Visible stored False;
  136.     property Width stored False;
  137.     property OnDragDrop;
  138.     property OnDragOver;
  139.     property OnEnter;
  140.     property OnExit;
  141.     property OnMouseDown;
  142.     property OnMouseMove;
  143.     property OnMouseUp;
  144.   end;
  145.  
  146.   TPageControl = class(TCustomTabControl)
  147.   private
  148.     FPages: TList;
  149.     FActivePage: TTabSheet;
  150.     procedure ChangeActivePage(Page: TTabSheet);
  151.     procedure DeleteTab(Page: TTabSheet);
  152.     function GetPage(Index: Integer): TTabSheet;
  153.     function GetPageCount: Integer;
  154.     procedure InsertPage(Page: TTabSheet);
  155.     procedure InsertTab(Page: TTabSheet);
  156.     procedure MoveTab(CurIndex, NewIndex: Integer);
  157.     procedure RemovePage(Page: TTabSheet);
  158.     procedure SetActivePage(Page: TTabSheet);
  159.     procedure UpdateTab(Page: TTabSheet);
  160.     procedure UpdateActivePage;
  161.     procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  162.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  163.   protected
  164.     procedure Change; override;
  165.     procedure GetChildren(Proc: TGetChildProc); override;
  166.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  167.     procedure ShowControl(AControl: TControl); override;
  168.   public
  169.     constructor Create(AOwner: TComponent); override;
  170.     destructor Destroy; override;
  171.     function FindNextPage(CurPage: TTabSheet;
  172.       GoForward, CheckTabVisible: Boolean): TTabSheet;
  173.     procedure SelectNextPage(GoForward: Boolean);
  174.     property PageCount: Integer read GetPageCount;
  175.     property Pages[Index: Integer]: TTabSheet read GetPage;
  176.   published
  177.     property ActivePage: TTabSheet read FActivePage write SetActivePage;
  178.     property Align;
  179.     property DragCursor;
  180.     property DragMode;
  181.     property Enabled;
  182.     property Font;
  183.     property MultiLine;
  184.     property ParentFont;
  185.     property ParentShowHint;
  186.     property PopupMenu;
  187.     property ShowHint;
  188.     property TabHeight;
  189.     property TabOrder;
  190.     property TabStop;
  191.     property TabWidth;
  192.     property Visible;
  193.     property OnChange;
  194.     property OnChanging;
  195.     property OnDragDrop;
  196.     property OnDragOver;
  197.     property OnEndDrag;
  198.     property OnEnter;
  199.     property OnExit;
  200.     property OnMouseDown;
  201.     property OnMouseMove;
  202.     property OnMouseUp;
  203.     property OnStartDrag;
  204.   end;
  205.  
  206.   TStatusBar = class;
  207.  
  208.   TStatusPanelStyle = (psText, psOwnerDraw);
  209.   TStatusPanelBevel = (pbNone, pbLowered, pbRaised);
  210.  
  211.   TStatusPanel = class(TCollectionItem)
  212.   private
  213.     FText: string;
  214.     FWidth: Integer;
  215.     FAlignment: TAlignment;
  216.     FBevel: TStatusPanelBevel;
  217.     FStyle: TStatusPanelStyle;
  218.     procedure SetAlignment(Value: TAlignment);
  219.     procedure SetBevel(Value: TStatusPanelBevel);
  220.     procedure SetStyle(Value: TStatusPanelStyle);
  221.     procedure SetText(const Value: string);
  222.     procedure SetWidth(Value: Integer);
  223.   public
  224.     constructor Create(Collection: TCollection); override;
  225.     procedure Assign(Source: TPersistent); override;
  226.   published
  227.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  228.     property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered;
  229.     property Style: TStatusPanelStyle read FStyle write SetStyle default psText;
  230.     property Text: string read FText write SetText;
  231.     property Width: Integer read FWidth write SetWidth;
  232.   end;
  233.  
  234.   TStatusPanels = class(TCollection)
  235.   private
  236.     FStatusBar: TStatusBar;
  237.     function GetItem(Index: Integer): TStatusPanel;
  238.     procedure SetItem(Index: Integer; Value: TStatusPanel);
  239.   protected
  240.     procedure Update(Item: TCollectionItem); override;
  241.   public
  242.     constructor Create(StatusBar: TStatusBar);
  243.     function Add: TStatusPanel;
  244.     property Items[Index: Integer]: TStatusPanel read GetItem write SetItem; default;
  245.   end;
  246.  
  247.   TDrawPanelEvent = procedure(StatusBar: TStatusBar; Panel: TStatusPanel;
  248.     const Rect: TRect) of object;
  249.  
  250.   TStatusBar = class(TWinControl)
  251.   private
  252.     FPanels: TStatusPanels;
  253.     FCanvas: TCanvas;
  254.     FSimpleText: string;
  255.     FSimplePanel: Boolean;
  256.     FSizeGrip: Boolean;
  257.     FOnDrawPanel: TDrawPanelEvent;
  258.     FOnResize: TNotifyEvent;
  259.     procedure SetPanels(Value: TStatusPanels);
  260.     procedure SetSimplePanel(Value: Boolean);
  261.     procedure SetSimpleText(const Value: string);
  262.     procedure SetSizeGrip(Value: Boolean);
  263.     procedure UpdatePanel(Index: Integer);
  264.     procedure UpdatePanels;
  265.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  266.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  267.   protected
  268.     procedure CreateParams(var Params: TCreateParams); override;
  269.     procedure CreateWnd; override;
  270.     procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); dynamic;
  271.     procedure Resize; dynamic;
  272.   public
  273.     constructor Create(AOwner: TComponent); override;
  274.     destructor Destroy; override;
  275.     property Canvas: TCanvas read FCanvas;
  276.   published
  277.     property Align default alBottom;
  278.     property DragCursor;
  279.     property DragMode;
  280.     property Enabled;
  281.     property Font;
  282.     property Panels: TStatusPanels read FPanels write SetPanels;
  283.     property ParentFont;
  284.     property ParentShowHint;
  285.     property PopupMenu;
  286.     property ShowHint;
  287.     property SimplePanel: Boolean read FSimplePanel write SetSimplePanel;
  288.     property SimpleText: string read FSimpleText write SetSimpleText;
  289.     property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
  290.     property Visible;
  291.     property OnClick;
  292.     property OnDblClick;
  293.     property OnDragDrop;
  294.     property OnDragOver;
  295.     property OnEndDrag;
  296.     property OnMouseDown;
  297.     property OnMouseMove;
  298.     property OnMouseUp;
  299.     property OnDrawPanel: TDrawPanelEvent read FOnDrawPanel write FOnDrawPanel;
  300.     property OnResize: TNotifyEvent read FOnResize write FOnResize;
  301.     property OnStartDrag;
  302.   end;
  303.  
  304.   THeaderControl = class;
  305.  
  306.   THeaderSectionStyle = (hsText, hsOwnerDraw);
  307.  
  308.   THeaderSection = class(TCollectionItem)
  309.   private
  310.     FText: string;
  311.     FWidth: Integer;
  312.     FMinWidth: Integer;
  313.     FMaxWidth: Integer;
  314.     FAlignment: TAlignment;
  315.     FStyle: THeaderSectionStyle;
  316.     FAllowClick: Boolean;
  317.     function GetLeft: Integer;
  318.     function GetRight: Integer;
  319.     procedure SetAlignment(Value: TAlignment);
  320.     procedure SetMaxWidth(Value: Integer);
  321.     procedure SetMinWidth(Value: Integer);
  322.     procedure SetStyle(Value: THeaderSectionStyle);
  323.     procedure SetText(const Value: string);
  324.     procedure SetWidth(Value: Integer);
  325.   public
  326.     constructor Create(Collection: TCollection); override;
  327.     procedure Assign(Source: TPersistent); override;
  328.     property Left: Integer read GetLeft;
  329.     property Right: Integer read GetRight;
  330.   published
  331.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  332.     property AllowClick: Boolean read FAllowClick write FAllowClick default True;
  333.     property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 10000;
  334.     property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
  335.     property Style: THeaderSectionStyle read FStyle write SetStyle default hsText;
  336.     property Text: string read FText write SetText;
  337.     property Width: Integer read FWidth write SetWidth;
  338.   end;
  339.  
  340.   THeaderSections = class(TCollection)
  341.   private
  342.     FHeaderControl: THeaderControl;
  343.     function GetItem(Index: Integer): THeaderSection;
  344.     procedure SetItem(Index: Integer; Value: THeaderSection);
  345.   protected
  346.     procedure Update(Item: TCollectionItem); override;
  347.   public
  348.     constructor Create(HeaderControl: THeaderControl);
  349.     function Add: THeaderSection;
  350.     property Items[Index: Integer]: THeaderSection read GetItem write SetItem; default;
  351.   end;
  352.  
  353.   TSectionTrackState = (tsTrackBegin, tsTrackMove, tsTrackEnd);
  354.  
  355.   TDrawSectionEvent = procedure(HeaderControl: THeaderControl;
  356.     Section: THeaderSection; const Rect: TRect; Pressed: Boolean) of object;
  357.   TSectionNotifyEvent = procedure(HeaderControl: THeaderControl;
  358.     Section: THeaderSection) of object;
  359.   TSectionTrackEvent = procedure(HeaderControl: THeaderControl;
  360.     Section: THeaderSection; Width: Integer;
  361.     State: TSectionTrackState) of object;
  362.  
  363.   THeaderControl = class(TWinControl)
  364.   private
  365.     FSections: THeaderSections;
  366.     FCanvas: TCanvas;
  367.     FOnDrawSection: TDrawSectionEvent;
  368.     FOnResize: TNotifyEvent;
  369.     FOnSectionClick: TSectionNotifyEvent;
  370.     FOnSectionResize: TSectionNotifyEvent;
  371.     FOnSectionTrack: TSectionTrackEvent;
  372.     procedure SetSections(Value: THeaderSections);
  373.     procedure UpdateItem(Message, Index: Integer);
  374.     procedure UpdateSection(Index: Integer);
  375.     procedure UpdateSections;
  376.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  377.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  378.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  379.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  380.   protected
  381.     procedure CreateParams(var Params: TCreateParams); override;
  382.     procedure CreateWnd; override;
  383.     procedure DrawSection(Section: THeaderSection; const Rect: TRect;
  384.       Pressed: Boolean); dynamic;
  385.     procedure Resize; dynamic;
  386.     procedure SectionClick(Section: THeaderSection); dynamic;
  387.     procedure SectionResize(Section: THeaderSection); dynamic;
  388.     procedure SectionTrack(Section: THeaderSection; Width: Integer;
  389.       State: TSectionTrackState); dynamic;
  390.   public
  391.     constructor Create(AOwner: TComponent); override;
  392.     destructor Destroy; override;
  393.     property Canvas: TCanvas read FCanvas;
  394.   published
  395.     property Align default alTop;
  396.     property DragCursor;
  397.     property DragMode;
  398.     property Enabled;
  399.     property Font;
  400.     property Sections: THeaderSections read FSections write SetSections;
  401.     property ShowHint;
  402.     property ParentFont;
  403.     property ParentShowHint;
  404.     property PopupMenu;
  405.     property Visible;
  406.     property OnDragDrop;
  407.     property OnDragOver;
  408.     property OnEndDrag;
  409.     property OnMouseDown;
  410.     property OnMouseMove;
  411.     property OnMouseUp;
  412.     property OnDrawSection: TDrawSectionEvent read FOnDrawSection write FOnDrawSection;
  413.     property OnResize: TNotifyEvent read FOnResize write FOnResize;
  414.     property OnSectionClick: TSectionNotifyEvent read FOnSectionClick write FOnSectionClick;
  415.     property OnSectionResize: TSectionNotifyEvent read FOnSectionResize write FOnSectionResize;
  416.     property OnSectionTrack: TSectionTrackEvent read FOnSectionTrack write FOnSectionTrack;
  417.     property OnStartDrag;
  418.   end;
  419.  
  420. { TTreeNode }
  421.  
  422.   TCustomTreeView = class;
  423.   TTreeNodes = class;
  424.  
  425.   TNodeState = (nsCut, nsDropHilited, nsFocused, nsSelected, nsExpanded);
  426.   TNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert);
  427.   TAddMode = (taAddFirst, taAdd, taInsert);
  428.  
  429.   PNodeInfo = ^TNodeInfo;
  430.   TNodeInfo = packed record
  431.     ImageIndex: Integer;
  432.     SelectedIndex: Integer;
  433.     StateIndex: Integer;
  434.     OverlayIndex: Integer;
  435.     Data: Pointer;
  436.     Count: Integer;
  437.     Text: string[255];
  438.   end;
  439.  
  440.   TTreeNode = class(TPersistent)
  441.   private
  442.     FOwner: TTreeNodes;
  443.     FText: string;
  444.     FData: Pointer;
  445.     FItemId: HTreeItem;
  446.     FImageIndex: Integer;
  447.     FSelectedIndex: Integer;
  448.     FOverlayIndex: Integer;
  449.     FStateIndex: Integer;
  450.     FDeleting: Boolean;
  451.     procedure ExpandItem(Expand: Boolean; Recurse: Boolean);
  452.     function GetAbsoluteIndex: Integer;
  453.     function GetExpanded: Boolean;
  454.     function GetLevel: Integer;
  455.     function GetParent: TTreeNode;
  456.     function GetChildren: Boolean;
  457.     function GetCut: Boolean;
  458.     function GetDropTarget: Boolean;
  459.     function GetFocused: Boolean;
  460.     function GetIndex: Integer;
  461.     function GetItem(Index: Integer): TTreeNode;
  462.     function GetSelected: Boolean;
  463.     function GetState(NodeState: TNodeState): Boolean;
  464.     function GetCount: Integer;
  465.     function GetTreeView: TCustomTreeView;
  466.     function HasVisibleParent: Boolean;
  467.     procedure InternalMove(ParentNode, Node: TTreeNode; HItem: HTreeItem;
  468.       AddMode: TAddMode);
  469.     function IsEqual(Node: TTreeNode): Boolean;
  470.     function IsNodeVisible: Boolean;
  471.     procedure ReadData(Stream: TStream; Info: PNodeInfo);
  472.     procedure SetChildren(Value: Boolean);
  473.     procedure SetCut(Value: Boolean);
  474.     procedure SetData(Value: Pointer);
  475.     procedure SetDropTarget(Value: Boolean);
  476.     procedure SetItem(Index: Integer; Value: TTreeNode);
  477.     procedure SetExpanded(Value: Boolean);
  478.     procedure SetFocused(Value: Boolean);
  479.     procedure SetImageIndex(Value: Integer);
  480.     procedure SetOverlayIndex(Value: Integer);
  481.     procedure SetSelectedIndex(Value: Integer);
  482.     procedure SetSelected(Value: Boolean);
  483.     procedure SetStateIndex(Value: Integer);
  484.     procedure SetText(const S: string);
  485.     procedure WriteData(Stream: TStream; Info: PNodeInfo);
  486.   public
  487.     constructor Create(AOwner: TTreeNodes);
  488.     destructor Destroy; override;
  489.     function AlphaSort: Boolean;
  490.     procedure Assign(Source: TPersistent); override;
  491.     procedure Collapse(Recurse: Boolean);
  492.     function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  493.     procedure Delete;
  494.     procedure DeleteChildren;
  495.     function DisplayRect(TextOnly: Boolean): TRect;
  496.     function EditText: Boolean;
  497.     procedure EndEdit(Cancel: Boolean);
  498.     procedure Expand(Recurse: Boolean);
  499.     function GetFirstChild: TTreeNode;
  500.     function GetHandle: HWND;
  501.     function GetLastChild: TTreeNode;
  502.     function GetNext: TTreeNode;
  503.     function GetNextChild(Value: TTreeNode): TTreeNode;
  504.     function GetNextSibling: TTreeNode;
  505.     function GetNextVisible: TTreeNode;
  506.     function GetPrev: TTreeNode;
  507.     function GetPrevChild(Value: TTreeNode): TTreeNode;
  508.     function GetPrevSibling: TTreeNode;
  509.     function GetPrevVisible: TTreeNode;
  510.     function HasAsParent(Value: TTreeNode): Boolean;
  511.     function IndexOf(Value: TTreeNode): Integer;
  512.     procedure MakeVisible;
  513.     procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
  514.     property AbsoluteIndex: Integer read GetAbsoluteIndex;
  515.     property Count: Integer read GetCount;
  516.     property Cut: Boolean read GetCut write SetCut;
  517.     property Data: Pointer read FData write SetData;
  518.     property Deleting: Boolean read FDeleting;
  519.     property Focused: Boolean read GetFocused write SetFocused;
  520.     property DropTarget: Boolean read GetDropTarget write SetDropTarget;
  521.     property Selected: Boolean read GetSelected write SetSelected;
  522.     property Expanded: Boolean read GetExpanded write SetExpanded;
  523.     property Handle: HWND read GetHandle;
  524.     property HasChildren: Boolean read GetChildren write SetChildren;
  525.     property ImageIndex: Integer read FImageIndex write SetImageIndex;
  526.     property Index: Integer read GetIndex;
  527.     property IsVisible: Boolean read IsNodeVisible;
  528.     property Item[Index: Integer]: TTreeNode read GetItem write SetItem; default;
  529.     property ItemId: HTreeItem read FItemId;
  530.     property Level: Integer read GetLevel;
  531.     property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex;
  532.     property Owner: TTreeNodes read FOwner;
  533.     property Parent: TTreeNode read GetParent;
  534.     property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
  535.     property StateIndex: Integer read FStateIndex write SetStateIndex;
  536.     property Text: string read FText write SetText;
  537.     property TreeView: TCustomTreeView read GetTreeView;
  538.   end;
  539.  
  540. { TTreeNodes }
  541.  
  542.   TTreeNodes = class(TPersistent)
  543.   private
  544.     FOwner: TCustomTreeView;
  545.     FUpdateCount: Integer;
  546.     procedure AddedNode(Value: TTreeNode);
  547.     function GetHandle: HWND;
  548.     function GetNodeFromIndex(Index: Integer): TTreeNode;
  549.     procedure ReadData(Stream: TStream);
  550.     procedure Repaint(Node: TTreeNode);
  551.     procedure WriteData(Stream: TStream);
  552.   protected
  553.     function AddItem(Parent, Target: HTreeItem; const Item: TTVItem;
  554.       AddMode: TAddMode): HTreeItem;
  555.     function InternalAddObject(Node: TTreeNode; const S: string;
  556.       Ptr: Pointer; AddMode: TAddMode): TTreeNode;
  557.     procedure DefineProperties(Filer: TFiler); override;
  558.     function CreateItem(Node: TTreeNode): TTVItem;
  559.     function GetCount: Integer;
  560.     procedure SetItem(Index: Integer; Value: TTreeNode);
  561.     procedure SetUpdateState(Updating: Boolean);
  562.   public
  563.     constructor Create(AOwner: TCustomTreeView);
  564.     destructor Destroy; override;
  565.     function AddChildFirst(Node: TTreeNode; const S: string): TTreeNode;
  566.     function AddChild(Node: TTreeNode; const S: string): TTreeNode;
  567.     function AddChildObjectFirst(Node: TTreeNode; const S: string;
  568.       Ptr: Pointer): TTreeNode;
  569.     function AddChildObject(Node: TTreeNode; const S: string;
  570.       Ptr: Pointer): TTreeNode;
  571.     function AddFirst(Node: TTreeNode; const S: string): TTreeNode;
  572.     function Add(Node: TTreeNode; const S: string): TTreeNode;
  573.     function AddObjectFirst(Node: TTreeNode; const S: string;
  574.       Ptr: Pointer): TTreeNode;
  575.     function AddObject(Node: TTreeNode; const S: string;
  576.       Ptr: Pointer): TTreeNode;
  577.     procedure Assign(Source: TPersistent); override;
  578.     procedure BeginUpdate;
  579.     procedure Clear;
  580.     procedure Delete(Node: TTreeNode);
  581.     procedure EndUpdate;
  582.     function GetFirstNode: TTreeNode;
  583.     function GetNode(ItemId: HTreeItem): TTreeNode;
  584.     function Insert(Node: TTreeNode; const S: string): TTreeNode;
  585.     function InsertObject(Node: TTreeNode; const S: string;
  586.       Ptr: Pointer): TTreeNode;
  587.     property Count: Integer read GetCount;
  588.     property Handle: HWND read GetHandle;
  589.     property Item[Index: Integer]: TTreeNode read GetNodeFromIndex; default;
  590.     property Owner: TCustomTreeView read FOwner;
  591.   end;
  592.  
  593. { TCustomTreeView }
  594.  
  595.   THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton,
  596.     htOnIcon, htOnIndent, htOnLabel, htOnRight,
  597.     htOnStateIcon, htToLeft, htToRight);
  598.   THitTests = set of THitTest;
  599.   ETreeViewError = class(Exception);
  600.  
  601.   TTVChangingEvent = procedure(Sender: TObject; Node: TTreeNode;
  602.     var AllowChange: Boolean) of object;
  603.   TTVChangedEvent = procedure(Sender: TObject; Node: TTreeNode) of object;
  604.   TTVEditingEvent = procedure(Sender: TObject; Node: TTreeNode;
  605.     var AllowEdit: Boolean) of object;
  606.   TTVEditedEvent = procedure(Sender: TObject; Node: TTreeNode; var S: string) of object;
  607.   TTVExpandingEvent = procedure(Sender: TObject; Node: TTreeNode;
  608.     var AllowExpansion: Boolean) of object;
  609.   TTVCollapsingEvent = procedure(Sender: TObject; Node: TTreeNode;
  610.     var AllowCollapse: Boolean) of object;
  611.   TTVExpandedEvent = procedure(Sender: TObject; Node: TTreeNode) of object;
  612.   TTVCompareEvent = procedure(Sender: TObject; Node1, Node2: TTreeNode;
  613.     Data: Integer; var Compare: Integer) of object;
  614.  
  615.   TSortType = (stNone, stData, stText, stBoth);
  616.  
  617.   TCustomTreeView = class(TWinControl)
  618.   private
  619.     FShowLines: Boolean;
  620.     FShowRoot: Boolean;
  621.     FShowButtons: Boolean;
  622.     FBorderStyle: TBorderStyle;
  623.     FReadOnly: Boolean;
  624.     FImages: TImageList;
  625.     FStateImages: TImageList;
  626.     FImageChangeLink: TChangeLink;
  627.     FStateChangeLink: TChangeLink;
  628.     FDragImage: TImageList;
  629.     FTreeNodes: TTreeNodes;
  630.     FSortType: TSortType;
  631.     FSaveItems: TStringList;
  632.     FSaveTopIndex: Integer;
  633.     FSaveIndex: Integer;
  634.     FSaveIndent: Integer;
  635.     FHideSelection: Boolean;
  636.     FMemStream: TMemoryStream;
  637.     FEditInstance: Pointer;
  638.     FDefEditProc: Pointer;
  639.     FEditHandle: HWND;
  640.     FDragged: Boolean;
  641.     FRClicked: Boolean;
  642.     FLastDropTarget: TTreeNode;
  643.     FDragNode: TTreeNode;
  644.     FOnEditing: TTVEditingEvent;
  645.     FOnEdited: TTVEditedEvent;
  646.     FOnExpanded: TTVExpandedEvent;
  647.     FOnExpanding: TTVExpandingEvent;
  648.     FOnCollapsed: TTVExpandedEvent;
  649.     FOnCollapsing: TTVCollapsingEvent;
  650.     FOnChanging: TTVChangingEvent;
  651.     FOnChange: TTVChangedEvent;
  652.     FOnCompare: TTVCompareEvent;
  653.     FOnDeletion: TTVExpandedEvent;
  654.     FOnGetImageIndex: TTVExpandedEvent;
  655.     FOnGetSelectedIndex: TTVExpandedEvent;
  656.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  657.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  658.     procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
  659.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  660.     procedure EditWndProc(var Message: TMessage);
  661.     procedure DoDragOver(Source: TDragObject; X, Y: Integer);
  662.     procedure GetImageIndex(Node: TTreeNode);
  663.     procedure GetSelectedIndex(Node: TTreeNode);
  664.     function GetDropTarget: TTreeNode;
  665.     function GetIndent: Integer;
  666.     function GetNodeFromItem(const Item: TTVItem): TTreeNode;
  667.     function GetSelection: TTreeNode;
  668.     function GetTopItem: TTreeNode;
  669.     procedure ImageListChange(Sender: TObject);
  670.     procedure SetBorderStyle(Value: TBorderStyle);
  671.     procedure SetButtonStyle(Value: Boolean);
  672.     procedure SetDropTarget(Value: TTreeNode);
  673.     procedure SetHideSelection(Value: Boolean);
  674.     procedure SetImageList(Value: HImageList; Flags: Integer);
  675.     procedure SetIndent(Value: Integer);
  676.     procedure SetImages(Value: TImageList);
  677.     procedure SetLineStyle(Value: Boolean);
  678.     procedure SetReadOnly(Value: Boolean);
  679.     procedure SetRootStyle(Value: Boolean);
  680.     procedure SetSelection(Value: TTreeNode);
  681.     procedure SetSortType(Value: TSortType);
  682.     procedure SetStateImages(Value: TImageList);
  683.     procedure SetStyle(Value: Integer; UseStyle: Boolean);
  684.     procedure SetTreeNodes(Value: TTreeNodes);
  685.     procedure SetTopItem(Value: TTreeNode);
  686.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  687.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  688.   protected
  689.     function CanEdit(Node: TTreeNode): Boolean; dynamic;
  690.     function CanChange(Node: TTreeNode): Boolean; dynamic;
  691.     function CanCollapse(Node: TTreeNode): Boolean; dynamic;
  692.     function CanExpand(Node: TTreeNode): Boolean; dynamic;
  693.     procedure Change(Node: TTreeNode); dynamic;
  694.     procedure Collapse(Node: TTreeNode); dynamic;
  695.     function CreateNode: TTreeNode; virtual;
  696.     procedure CreateParams(var Params: TCreateParams); override;
  697.     procedure CreateWnd; override;
  698.     procedure DestroyWnd; override;
  699.     procedure DoEndDrag(Target: TObject; X, Y: Integer); dynamic;
  700.     procedure DoStartDrag(var DragObject: TDragObject); override;
  701.     procedure Edit(const Item: TTVItem); dynamic;
  702.     procedure Expand(Node: TTreeNode); dynamic;
  703.     function GetDragImages: TCustomImageList; override;
  704.     procedure Loaded; override;
  705.     procedure Notification(AComponent: TComponent;
  706.       Operation: TOperation); override;
  707.     procedure SetDragMode(Value: TDragMode); override;
  708.     procedure WndProc(var Message: TMessage); override;
  709.     property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing;
  710.     property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited;
  711.     property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
  712.     property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
  713.     property OnCollapsing: TTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
  714.     property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed;
  715.     property OnChanging: TTVChangingEvent read FOnChanging write FOnChanging;
  716.     property OnChange: TTVChangedEvent read FOnChange write FOnChange;
  717.     property OnCompare: TTVCompareEvent read FOnCompare write FOnCompare;
  718.     property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion;
  719.     property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
  720.     property OnGetSelectedIndex: TTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex;
  721.     property ShowButtons: Boolean read FShowButtons write SetButtonStyle default True;
  722.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  723.     property ShowLines: Boolean read FShowLines write SetLineStyle default True;
  724.     property ShowRoot: Boolean read FShowRoot write SetRootStyle default True;
  725.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  726.     property Indent: Integer read GetIndent write SetIndent;
  727.     property Items: TTreeNodes read FTreeNodes write SetTreeNodes;
  728.     property SortType: TSortType read FSortType write SetSortType default stNone;
  729.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  730.     property Images: TImageList read FImages write SetImages;
  731.     property StateImages: TImageList read FStateImages write SetStateImages;
  732.   public
  733.     constructor Create(AOwner: TComponent); override;
  734.     destructor Destroy; override;
  735.     function AlphaSort: Boolean;
  736.     function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  737.     procedure FullCollapse;
  738.     procedure FullExpand;
  739.     function GetHitTestInfoAt(X, Y: Integer): THitTests;
  740.     function GetNodeAt(X, Y: Integer): TTreeNode;
  741.     function IsEditing: Boolean;
  742.     procedure LoadFromFile(const FileName: string);
  743.     procedure LoadFromStream(Stream: TStream);
  744.     procedure SaveToFile(const FileName: string);
  745.     procedure SaveToStream(Stream: TStream);
  746.     property DropTarget: TTreeNode read GetDropTarget write SetDropTarget;
  747.     property Selected: TTreeNode read GetSelection write SetSelection;
  748.     property TopItem: TTreeNode read GetTopItem write SetTopItem;
  749.   end;
  750.  
  751.   TTreeView = class(TCustomTreeView)
  752.   published
  753.     property ShowButtons;
  754.     property BorderStyle;
  755.     property DragCursor;
  756.     property ShowLines;
  757.     property ShowRoot;
  758.     property ReadOnly;
  759.     property DragMode;
  760.     property HideSelection;
  761.     property Indent;
  762.     property Items;
  763.     property OnEditing;
  764.     property OnEdited;
  765.     property OnExpanding;
  766.     property OnExpanded;
  767.     property OnCollapsing;
  768.     property OnCompare;
  769.     property OnCollapsed;
  770.     property OnChanging;
  771.     property OnChange;
  772.     property OnDeletion;
  773.     property OnGetImageIndex;
  774.     property OnGetSelectedIndex;
  775.     property Align;
  776.     property Enabled;
  777.     property Font;
  778.     property Color;
  779.     property ParentColor;
  780.     property ParentCtl3D;
  781.     property Ctl3D;
  782.     property SortType;
  783.     property TabOrder;
  784.     property TabStop default True;
  785.     property Visible;
  786.     property OnClick;
  787.     property OnEnter;
  788.     property OnExit;
  789.     property OnDragDrop;
  790.     property OnDragOver;
  791.     property OnStartDrag;
  792.     property OnEndDrag;
  793.     property OnMouseDown;
  794.     property OnMouseMove;
  795.     property OnMouseUp;
  796.     property OnDblClick;
  797.     property OnKeyDown;
  798.     property OnKeyPress;
  799.     property OnKeyUp;
  800.     property PopupMenu;
  801.     property ParentFont;
  802.     property ParentShowHint;
  803.     property ShowHint;
  804.     property Images;
  805.     property StateImages;
  806.   end;
  807.  
  808. { TTrackBar }
  809.  
  810.   TTrackBarOrientation = (trHorizontal, trVertical);
  811.   TTickMark = (tmBottomRight, tmTopLeft, tmBoth);
  812.   TTickStyle = (tsNone, tsAuto, tsManual);
  813.  
  814.   TTrackBar = class(TWinControl)
  815.   private
  816.     FOrientation: TTrackBarOrientation;
  817.     FTickMarks: TTickMark;
  818.     FTickStyle: TTickStyle;
  819.     FLineSize: Integer;
  820.     FPageSize: Integer;
  821.     FMin: Integer;
  822.     FMax: Integer;
  823.     FFrequency: Integer;
  824.     FPosition: Integer;
  825.     FSelStart: Integer;
  826.     FSelEnd: Integer;
  827.     FOnChange: TNotifyEvent;
  828.  
  829.     procedure SetOrientation(Value: TTrackBarOrientation);
  830.     procedure SetParams(APosition, AMin, AMax: Integer);
  831.     procedure SetPosition(Value: Integer);
  832.     procedure SetMin(Value: Integer);
  833.     procedure SetMax(Value: Integer);
  834.     procedure SetFrequency(Value: Integer);
  835.     procedure SetTickStyle(Value: TTickStyle);
  836.     procedure SetTickMarks(Value: TTickMark);
  837.     procedure SetLineSize(Value: Integer);
  838.     procedure SetPageSize(Value: Integer);
  839.     procedure SetSelStart(Value: Integer);
  840.     procedure SetSelEnd(Value: Integer);
  841.     procedure UpdateSelection;
  842.  
  843.     procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  844.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  845.   protected
  846.     procedure CreateParams(var Params: TCreateParams); override;
  847.     procedure CreateWnd; override;
  848.     procedure DestroyWnd; override;
  849.   public
  850.     constructor Create(AOwner: TComponent); override;
  851.     procedure SetTick(Value: Integer);
  852.   published
  853.     property Ctl3D;
  854.     property DragCursor;
  855.     property DragMode;
  856.     property Enabled;
  857.     property LineSize: Integer read FLineSize write SetLineSize default 1;
  858.     property Max: Integer read FMax write SetMax default 10;
  859.     property Min: Integer read FMin write SetMin default 0;
  860.     property Orientation: TTrackBarOrientation read FOrientation write SetOrientation;
  861.     property ParentCtl3D;
  862.     property ParentShowHint;
  863.     property PageSize: Integer read FPageSize write SetPageSize default 2;
  864.     property PopupMenu;
  865.     property Frequency: Integer read FFrequency write SetFrequency;
  866.     property Position: Integer read FPosition write SetPosition;
  867.     property SelEnd: Integer read FSelEnd write SetSelEnd;
  868.     property SelStart: Integer read FSelStart write SetSelStart;
  869.     property ShowHint;
  870.     property TabOrder;
  871.     property TabStop default True;
  872.     property TickMarks: TTickMark read FTickMarks write SetTickMarks;
  873.     property TickStyle: TTickStyle read FTickStyle write SetTickStyle;
  874.     property Visible;
  875.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  876.     property OnDragDrop;
  877.     property OnDragOver;
  878.     property OnEndDrag;
  879.     property OnEnter;
  880.     property OnExit;
  881.     property OnKeyDown;
  882.     property OnKeyPress;
  883.     property OnKeyUp;
  884.     property OnStartDrag;
  885.   end;
  886.  
  887. { TProgressBar }
  888.  
  889.   TProgressRange = 0..65535; // max & position limitation of Progess Bar
  890.   TProgressBar = class(TWinControl)
  891.   private
  892.     FMin: TProgressRange;
  893.     FMax: TProgressRange;
  894.     FStep: TProgressRange;
  895.     FPosition: TProgressRange;
  896.     function GetPosition: TProgressRange;
  897.     procedure SetParams(AMin, AMax: TProgressRange);
  898.     procedure SetMin(Value: TProgressRange);
  899.     procedure SetMax(Value: TProgressRange);
  900.     procedure SetPosition(Value: TProgressRange);
  901.     procedure SetStep(Value: TProgressRange);
  902.   protected
  903.     procedure CreateParams(var Params: TCreateParams); override;
  904.     procedure CreateWnd; override;
  905.   public
  906.     constructor Create(AOwner: TComponent); override;
  907.     procedure StepIt;
  908.     procedure StepBy(Delta: TProgressRange);
  909.   published
  910.     property Align;
  911.     property Enabled;
  912.     property Hint;
  913.     property Min: TProgressRange read FMin write SetMin;
  914.     property Max: TProgressRange read FMax write SetMax;
  915.     property ParentShowHint;
  916.     property PopupMenu;
  917.     property Position: TProgressRange read GetPosition write SetPosition default 0;
  918.     property Step: TProgressRange read FStep write SetStep default 10;
  919.     property ShowHint;
  920.     property TabOrder;
  921.     property TabStop;
  922.     property Visible;
  923.     property OnDragDrop;
  924.     property OnDragOver;
  925.     property OnEndDrag;
  926.     property OnEnter;
  927.     property OnExit;
  928.     property OnMouseDown;
  929.     property OnMouseMove;
  930.     property OnMouseUp;
  931.     property OnStartDrag;
  932.   end;
  933.  
  934. { TTextAttributes }
  935.  
  936.   TCustomRichEdit = class;
  937.  
  938.   TAttributeType = (atSelected, atDefaultText);
  939.   TConsistentAttribute = (caBold, caColor, caFace, caItalic,
  940.     caSize, caStrikeOut, caUnderline, caProtected);
  941.   TConsistentAttributes = set of TConsistentAttribute;
  942.  
  943.   TTextAttributes = class(TPersistent)
  944.   private
  945.     RichEdit: TCustomRichEdit;
  946.     FType: TAttributeType;
  947.     procedure GetAttributes(var Format: TCharFormat);
  948.     function GetColor: TColor;
  949.     function GetConsistentAttributes: TConsistentAttributes;
  950.     function GetHeight: Integer;
  951.     function GetName: TFontName;
  952.     function GetPitch: TFontPitch;
  953.     function GetProtected: Boolean;
  954.     function GetSize: Integer;
  955.     function GetStyle: TFontStyles;
  956.     procedure SetAttributes(var Format: TCharFormat);
  957.     procedure SetColor(Value: TColor);
  958.     procedure SetHeight(Value: Integer);
  959.     procedure SetName(Value: TFontName);
  960.     procedure SetPitch(Value: TFontPitch);
  961.     procedure SetProtected(Value: Boolean);
  962.     procedure SetSize(Value: Integer);
  963.     procedure SetStyle(Value: TFontStyles);
  964.   protected
  965.     procedure InitFormat(var Format: TCharFormat);
  966.     procedure AssignTo(Dest: TPersistent); override;
  967.   public
  968.     constructor Create(AOwner: TCustomRichEdit; AttributeType: TAttributeType);
  969.     procedure Assign(Source: TPersistent); override;
  970.     property Color: TColor read GetColor write SetColor;
  971.     property ConsistentAttributes: TConsistentAttributes read GetConsistentAttributes;
  972.     property Name: TFontName read GetName write SetName;
  973.     property Pitch: TFontPitch read GetPitch write SetPitch;
  974.     property Protected: Boolean read GetProtected write SetProtected;
  975.     property Size: Integer read GetSize write SetSize;
  976.     property Style: TFontStyles read GetStyle write SetStyle;
  977.     property Height: Integer read GetHeight write SetHeight;
  978.   end;
  979.  
  980. { TParaAttributes }
  981.  
  982.   TNumberingStyle = (nsNone, nsBullet);
  983.  
  984.   TParaAttributes = class(TPersistent)
  985.   private
  986.     RichEdit: TCustomRichEdit;
  987.     procedure GetAttributes(var Paragraph: TParaFormat);
  988.     function GetAlignment: TAlignment;
  989.     function GetFirstIndent: Longint;
  990.     function GetLeftIndent: Longint;
  991.     function GetRightIndent: Longint;
  992.     function GetNumbering: TNumberingStyle;
  993.     function GetTab(Index: Byte): Longint;
  994.     function GetTabCount: Integer;
  995.     procedure InitPara(var Paragraph: TParaFormat);
  996.     procedure SetAlignment(Value: TAlignment);
  997.     procedure SetAttributes(var Paragraph: TParaFormat);
  998.     procedure SetFirstIndent(Value: Longint);
  999.     procedure SetLeftIndent(Value: Longint);
  1000.     procedure SetRightIndent(Value: Longint);
  1001.     procedure SetNumbering(Value: TNumberingStyle);
  1002.     procedure SetTab(Index: Byte; Value: Longint);
  1003.     procedure SetTabCount(Value: Integer);
  1004.   public
  1005.     constructor Create(AOwner: TCustomRichEdit);
  1006.     procedure Assign(Source: TPersistent); override;
  1007.     property Alignment: TAlignment read GetAlignment write SetAlignment;
  1008.     property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
  1009.     property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
  1010.     property Numbering: TNumberingStyle read GetNumbering write SetNumbering;
  1011.     property RightIndent: Longint read GetRightIndent write SetRightIndent;
  1012.     property Tab[Index: Byte]: Longint read GetTab write SetTab;
  1013.     property TabCount: Integer read GetTabCount write SetTabCount;
  1014.   end;
  1015.  
  1016. { TCustomRichEdit }
  1017.  
  1018.   TRichEditResizeEvent = procedure(Sender: TObject; Rect: TRect) of object;
  1019.   TRichEditProtectChange = procedure(Sender: TObject;
  1020.     StartPos, EndPos: Integer; var AllowChange: Boolean) of object;
  1021.   TRichEditSaveClipboard = procedure(Sender: TObject;
  1022.     NumObjects, NumChars: Integer; var SaveClipboard: Boolean) of object;
  1023.   TSearchType = (stWholeWord, stMatchCase);
  1024.   TSearchTypes = set of TSearchType;
  1025.  
  1026.   TConversion = class(TObject)
  1027.   public
  1028.     function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; virtual;
  1029.     function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; virtual;
  1030.   end;
  1031.  
  1032.   TConversionClass = class of TConversion;
  1033.  
  1034.   PConversionFormat = ^TConversionFormat;
  1035.   TConversionFormat = record
  1036.     ConversionClass: TConversionClass;
  1037.     Extension: string;
  1038.     Next: PConversionFormat;
  1039.   end;
  1040.  
  1041.   PRichEditStreamInfo = ^TRichEditStreamInfo;
  1042.   TRichEditStreamInfo = record
  1043.     Converter: TConversion;
  1044.     Stream: TStream;
  1045.   end;
  1046.  
  1047.   TCustomRichEdit = class(TCustomMemo)
  1048.   private
  1049.     FLibHandle: THandle;
  1050.     FHideScrollBars: Boolean;
  1051.     FSelAttributes: TTextAttributes;
  1052.     FDefAttributes: TTextAttributes;
  1053.     FParagraph: TParaAttributes;
  1054.     FScreenLogPixels: Integer;
  1055.     FRichEditStrings: TStrings;
  1056.     FMemStream: TMemoryStream;
  1057.     FOnSelChange: TNotifyEvent;
  1058.     FHideSelection: Boolean;
  1059.     FModified: Boolean;
  1060.     FDefaultConverter: TConversionClass;
  1061.     FOnResizeRequest: TRichEditResizeEvent;
  1062.     FOnProtectChange: TRichEditProtectChange;
  1063.     FOnSaveClipboard: TRichEditSaveClipboard;
  1064.     FPageRect: TRect;
  1065.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  1066.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  1067.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  1068.     function GetPlainText: Boolean;
  1069.     function ProtectChange(StartPos, EndPos: Integer): Boolean;
  1070.     function SaveClipboard(NumObj, NumChars: Integer): Boolean;
  1071.     procedure SetHideScrollBars(Value: Boolean);
  1072.     procedure SetHideSelection(Value: Boolean);
  1073.     procedure SetPlainText(Value: Boolean);
  1074.     procedure SetRichEditStrings(Value: TStrings);
  1075.     procedure SetDefAttributes(Value: TTextAttributes);
  1076.     procedure SetSelAttributes(Value: TTextAttributes);
  1077.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  1078.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  1079.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  1080.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  1081.   protected
  1082.     procedure CreateParams(var Params: TCreateParams); override;
  1083.     procedure CreateWnd; override;
  1084.     procedure DestroyWnd; override;
  1085.     procedure RequestSize(const Rect: TRect); virtual;
  1086.     procedure SelectionChange; dynamic;
  1087.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  1088.     property HideScrollBars: Boolean read FHideScrollBars
  1089.       write SetHideScrollBars default True;
  1090.     property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
  1091.     property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
  1092.       write FOnSaveClipboard;
  1093.     property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  1094.     property OnProtectChange: TRichEditProtectChange read FOnProtectChange
  1095.       write FOnProtectChange;
  1096.     property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
  1097.       write FOnResizeRequest;
  1098.     property PlainText: Boolean read GetPlainText write SetPlainText default False;
  1099.   public
  1100.     constructor Create(AOwner: TComponent); override;
  1101.     destructor Destroy; override;
  1102.     function FindText(const SearchStr: string;
  1103.       StartPos, Length: Integer; Options: TSearchTypes): Integer;
  1104.     procedure Print(const Caption: string);
  1105.     class procedure RegisterConversionFormat(const AExtension: string;
  1106.       AConversionClass: TConversionClass);
  1107.     property DefaultConverter: TConversionClass
  1108.       read FDefaultConverter write FDefaultConverter;
  1109.     property DefAttributes: TTextAttributes read FDefAttributes write SetDefAttributes;
  1110.     property SelAttributes: TTextAttributes read FSelAttributes write SetSelAttributes;
  1111.     property PageRect: TRect read FPageRect write FPageRect;
  1112.     property Paragraph: TParaAttributes read FParagraph;
  1113.   end;
  1114.  
  1115.   TRichEdit = class(TCustomRichEdit)
  1116.   published
  1117.     property Align;
  1118.     property Alignment;
  1119.     property BorderStyle;
  1120.     property Color;
  1121.     property Ctl3D;
  1122.     property DragMode;
  1123.     property Enabled;
  1124.     property Font;
  1125.     property HideSelection;
  1126.     property HideScrollBars;
  1127.     property Lines;
  1128.     property MaxLength;
  1129.     property ParentColor;
  1130.     property ParentCtl3D;
  1131.     property ParentFont;
  1132.     property PlainText;
  1133.     property PopupMenu;
  1134.     property ReadOnly;
  1135.     property ScrollBars;
  1136.     property ShowHint;
  1137.     property TabOrder;
  1138.     property TabStop default True;
  1139.     property Visible;
  1140.     property WantTabs;
  1141.     property WantReturns;
  1142.     property WordWrap;
  1143.     property OnChange;
  1144.     property OnDragDrop;
  1145.     property OnDragOver;
  1146.     property OnEndDrag;
  1147.     property OnEnter;
  1148.     property OnExit;
  1149.     property OnKeyDown;
  1150.     property OnKeyPress;
  1151.     property OnKeyUp;
  1152.     property OnMouseDown;
  1153.     property OnMouseMove;
  1154.     property OnMouseUp;
  1155.     property OnResizeRequest;
  1156.     property OnSelectionChange;
  1157.     property OnStartDrag;
  1158.     property OnProtectChange;
  1159.     property OnSaveClipboard;
  1160.   end;
  1161.  
  1162. { TUpDown }
  1163.  
  1164.   TUDAlignButton = (udLeft, udRight);
  1165.   TUDOrientation = (udHorizontal, udVertical);
  1166.   TUDBtnType = (btNext, btPrev);
  1167.   TUDClickEvent = procedure (Sender: TObject; Button: TUDBtnType) of object;
  1168.   TUDChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object;
  1169.  
  1170.   TCustomUpDown = class(TWinControl)
  1171.   private
  1172.     FArrowKeys: Boolean;
  1173.     FAssociate: TWinControl;
  1174.     FMin: SmallInt;
  1175.     FMax: SmallInt;
  1176.     FIncrement: Integer;
  1177.     FPosition: SmallInt;
  1178.     FThousands: Boolean;
  1179.     FWrap: Boolean;
  1180.     FOnClick: TUDClickEvent;
  1181.     FAlignButton: TUDAlignButton;
  1182.     FOrientation: TUDOrientation;
  1183.     FOnChanging: TUDChangingEvent;
  1184.     procedure UndoAutoResizing(Value: TWinControl);
  1185.     procedure SetAssociate(Value: TWinControl);
  1186.     function GetPosition: SmallInt;
  1187.     procedure SetMin(Value: SmallInt);
  1188.     procedure SetMax(Value: SmallInt);
  1189.     procedure SetIncrement(Value: Integer);
  1190.     procedure SetPosition(Value: SmallInt);
  1191.     procedure SetAlignButton(Value: TUDAlignButton);
  1192.     procedure SetOrientation(Value: TUDOrientation);
  1193.     procedure SetArrowKeys(Value: Boolean);
  1194.     procedure SetThousands(Value: Boolean);
  1195.     procedure SetWrap(Value: Boolean);
  1196.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  1197.     procedure WMHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  1198.     procedure WMVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  1199.   protected
  1200.     function CanChange: Boolean;
  1201.     procedure CreateParams(var Params: TCreateParams); override;
  1202.     procedure CreateWnd; override;
  1203.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1204.     procedure Click(Button: TUDBtnType); dynamic;
  1205.     property AlignButton: TUDAlignButton read FAlignButton write SetAlignButton default udRight;
  1206.     property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True;
  1207.     property Associate: TWinControl read FAssociate write SetAssociate;
  1208.     property Min: SmallInt read FMin write SetMin;
  1209.     property Max: SmallInt read FMax write SetMax default 100;
  1210.     property Increment: Integer read FIncrement write SetIncrement default 1;
  1211.     property Orientation: TUDOrientation read FOrientation write SetOrientation default udVertical;
  1212.     property Position: SmallInt read GetPosition write SetPosition;
  1213.     property Thousands: Boolean read FThousands write SetThousands default True;
  1214.     property Wrap: Boolean read FWrap write SetWrap;
  1215.     property OnChanging: TUDChangingEvent read FOnChanging write FOnChanging;
  1216.     property OnClick: TUDClickEvent read FOnClick write FOnClick;
  1217.   public
  1218.     constructor Create(AOwner: TComponent); override;
  1219.   end;
  1220.  
  1221.   TUpDown = class(TCustomUpDown)
  1222.   published
  1223.     property AlignButton;
  1224.     property Associate;
  1225.     property ArrowKeys;
  1226.     property Enabled;
  1227.     property Hint;
  1228.     property Min;
  1229.     property Max;
  1230.     property Increment;
  1231.     property Orientation;
  1232.     property ParentShowHint;
  1233.     property PopupMenu;
  1234.     property Position;
  1235.     property ShowHint;
  1236.     property TabOrder;
  1237.     property TabStop;
  1238.     property Thousands;
  1239.     property Visible;
  1240.     property Wrap;
  1241.     property OnChanging;
  1242.     property OnClick;
  1243.     property OnEnter;
  1244.     property OnExit;
  1245.     property OnMouseDown;
  1246.     property OnMouseMove;
  1247.     property OnMouseUp;
  1248.   end;
  1249.  
  1250. { THotKey }
  1251.  
  1252.   THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
  1253.   THKModifiers = set of THKModifier;
  1254.   THKInvalidKey = (hcNone, hcShift, hcCtrl, hcAlt, hcShiftCtrl,
  1255.     hcShiftAlt, hcCtrlAlt, hcShiftCtrlAlt);
  1256.   THKInvalidKeys = set of THKInvalidKey;
  1257.  
  1258.   TCustomHotKey = class(TWinControl)
  1259.   private
  1260.     FAutoSize: Boolean;
  1261.     FModifiers: THKModifiers;
  1262.     FInvalidKeys: THKInvalidKeys;
  1263.     FHotKey: Word;
  1264.     FShiftState: TShiftState;
  1265.     procedure AdjustHeight;
  1266.     procedure SetAutoSize(Value: Boolean);
  1267.     procedure SetInvalidKeys(Value: THKInvalidKeys);
  1268.     procedure SetModifiers(Value: THKModifiers);
  1269.     procedure UpdateHeight;
  1270.     function GetHotKey: TShortCut;
  1271.     procedure SetHotKey(Value: TShortCut);
  1272.     procedure ShortCutToHotKey(Value: TShortCut);
  1273.     function HotKeyToShortCut(Value: Longint): TShortCut;
  1274.   protected
  1275.     procedure CreateParams(var Params: TCreateParams); override;
  1276.     procedure CreateWnd; override;
  1277.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  1278.     property InvalidKeys: THKInvalidKeys read FInvalidKeys write SetInvalidKeys;
  1279.     property Modifiers: THKModifiers read FModifiers write SetModifiers;
  1280.     property HotKey: TShortCut read GetHotKey write SetHotKey;
  1281.     property TabStop default True;
  1282.   public
  1283.     constructor Create(AOwner: TComponent); override;
  1284.   end;
  1285.  
  1286.   THotKey = class(TCustomHotKey)
  1287.   published
  1288.     property AutoSize;
  1289.     property Enabled;
  1290.     property Hint;
  1291.     property HotKey;
  1292.     property InvalidKeys;
  1293.     property Modifiers;
  1294.     property ParentShowHint;
  1295.     property PopupMenu;
  1296.     property ShowHint;
  1297.     property TabOrder;
  1298.     property TabStop;
  1299.     property Visible;
  1300.     property OnEnter;
  1301.     property OnExit;
  1302.     property OnMouseDown;
  1303.     property OnMouseMove;
  1304.     property OnMouseUp;
  1305.   end;
  1306.  
  1307. const
  1308.   ColumnHeaderWidth = LVSCW_AUTOSIZE_USEHEADER;
  1309.   ColumnTextWidth = LVSCW_AUTOSIZE;
  1310.  
  1311. type
  1312.   TListColumns = class;
  1313.   TListItems = class;
  1314.   TCustomListView = class;
  1315.   TWidth = ColumnHeaderWidth..MaxInt;
  1316.  
  1317.   TListColumn = class(TCollectionItem)
  1318.   private
  1319.     FCaption: string;
  1320.     FAlignment: TAlignment;
  1321.     FWidth: TWidth;
  1322.     procedure DoChange;
  1323.     function GetWidth: TWidth;
  1324.     procedure ReadData(Reader: TReader);
  1325.     procedure SetAlignment(Value: TAlignment);
  1326.     procedure SetCaption(const Value: string);
  1327.     procedure SetWidth(Value: TWidth);
  1328.     procedure WriteData(Writer: TWriter);
  1329.   protected
  1330.     procedure DefineProperties(Filer: TFiler); override;
  1331.   public
  1332.     constructor Create(Collection: TCollection); override;
  1333.     destructor Destroy; override;
  1334.     procedure Assign(Source: TPersistent); override;
  1335.     property WidthType: TWidth read FWidth;
  1336.   published
  1337.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  1338.     property Caption: string read FCaption write SetCaption;
  1339.     property Width: TWidth read GetWidth write SetWidth default 50;
  1340.   end;
  1341.  
  1342.   TListColumns = class(TCollection)
  1343.   private
  1344.     FOwner: TCustomListView;
  1345.     function GetItem(Index: Integer): TListColumn;
  1346.     procedure SetItem(Index: Integer; Value: TListColumn);
  1347.   protected
  1348.     procedure Update(Item: TCollectionItem); override;
  1349.   public
  1350.     constructor Create(AOwner: TCustomListView);
  1351.     function Add: TListColumn;
  1352.     property Owner: TCustomListView read FOwner;
  1353.     property Items[Index: Integer]: TListColumn read GetItem write SetItem; default;
  1354.   end;
  1355.  
  1356.   TDisplayCode = (drBounds, drIcon, drLabel, drSelectBounds);
  1357.  
  1358.   { TListItem }
  1359.  
  1360.   TListItem = class(TPersistent)
  1361.   private
  1362.     FOwner: TListItems;
  1363.     FSubItems: TStrings;
  1364.     FData: Pointer;
  1365.     FImageIndex: Integer;
  1366.     FOverlayIndex: Integer;
  1367.     FStateIndex: Integer;
  1368.     FCaption: string;
  1369.     FDeleting: Boolean;
  1370.     FProcessedDeleting: Boolean;
  1371.     function GetHandle: HWND;
  1372.     function GetIndex: Integer;
  1373.     function GetListView: TCustomListView;
  1374.     function GetLeft: Integer;
  1375.     function GetState(Index: Integer): Boolean;
  1376.     function GetTop: Integer;
  1377.     function IsEqual(Item: TListItem): Boolean;
  1378.     procedure SetCaption(const Value: string);
  1379.     procedure SetData(Value: Pointer);
  1380.     procedure SetImage(Index: Integer; Value: Integer);
  1381.     procedure SetLeft(Value: Integer);
  1382.     procedure SetState(Index: Integer; State: Boolean);
  1383.     procedure SetSubItems(Value: TStrings);
  1384.     procedure SetTop(Value: Integer);
  1385.   protected
  1386.     procedure Assign(Source: TPersistent); override;
  1387.   public
  1388.     constructor Create(AOwner: TListItems);
  1389.     destructor Destroy; override;
  1390.     procedure CancelEdit;
  1391.     procedure Delete;
  1392.     function DisplayRect(Code: TDisplayCode): TRect;
  1393.     function EditCaption: Boolean;
  1394.     function GetPosition: TPoint;
  1395.     procedure MakeVisible(PartialOK: Boolean);
  1396.     procedure Update;
  1397.     procedure SetPosition(const Value: TPoint);
  1398.     property Caption: string read FCaption write SetCaption;
  1399.     property Cut: Boolean index 0 read GetState write SetState;
  1400.     property Data: Pointer read FData write SetData;
  1401.     property DropTarget: Boolean index 1 read GetState write SetState;
  1402.     property Focused: Boolean index 2 read GetState write SetState;
  1403.     property Handle: HWND read GetHandle;
  1404.     property ImageIndex: Integer index 0 read FImageIndex write SetImage;
  1405.     property Index: Integer read GetIndex;
  1406.     property Left: Integer read GetLeft write SetLeft;
  1407.     property ListView: TCustomListView read GetListView;
  1408.     property Owner: TListItems read FOwner;
  1409.     property OverlayIndex: Integer index 1 read FOverlayIndex write SetImage;
  1410.     property Selected: Boolean index 3 read GetState write SetState;
  1411.     property StateIndex: Integer index 2 read FStateIndex write SetImage;
  1412.     property SubItems: TStrings read FSubItems write SetSubItems;
  1413.     property Top: Integer read GetTop write SetTop;
  1414.   end;
  1415.  
  1416. { TListItems }
  1417.  
  1418.   TListItems = class(TPersistent)
  1419.   private
  1420.     FOwner: TCustomListView;
  1421.     FUpdateCount: Integer;
  1422.     FNoRedraw: Boolean;
  1423.     procedure ReadData(Stream: TStream);
  1424.     procedure WriteData(Stream: TStream);
  1425.   protected
  1426.     procedure DefineProperties(Filer: TFiler); override;
  1427.     function CreateItem(Index: Integer; ListItem: TListItem): TLVItem;
  1428.     function GetCount: Integer;
  1429.     function GetHandle: HWND;
  1430.     function GetItem(Index: Integer): TListItem;
  1431.     procedure SetItem(Index: Integer; Value: TListItem);
  1432.     procedure SetUpdateState(Updating: Boolean);
  1433.   public
  1434.     constructor Create(AOwner: TCustomListView);
  1435.     destructor Destroy; override;
  1436.     function Add: TListItem;
  1437.     procedure Assign(Source: TPersistent); override;
  1438.     procedure BeginUpdate;
  1439.     procedure Clear;
  1440.     procedure Delete(Index: Integer);
  1441.     procedure EndUpdate;
  1442.     function IndexOf(Value: TListItem): Integer;
  1443.     function Insert(Index: Integer): TListItem;
  1444.     property Count: Integer read GetCount;
  1445.     property Handle: HWND read GetHandle;
  1446.     property Item[Index: Integer]: TListItem read GetItem write SetItem; default;
  1447.     property Owner: TCustomListView read FOwner;
  1448.   end;
  1449.  
  1450.   { TIconOptions }
  1451.   TIconArrangement = (iaTop, iaLeft);
  1452.  
  1453.   TIconOptions = class(TPersistent)
  1454.   private
  1455.     FListView: TCustomListView;
  1456.     FArrangement: TIconArrangement;
  1457.     FAutoArrange: Boolean;
  1458.     FWrapText: Boolean;
  1459.     procedure SetArrangement(Value: TIconArrangement);
  1460.     procedure SetAutoArrange(Value: Boolean);
  1461.     procedure SetWrapText(Value: Boolean);
  1462.   public
  1463.     constructor Create(AOwner: TCustomListView);
  1464.   published
  1465.     property Arrangement: TIconArrangement read FArrangement write SetArrangement default iaTop;
  1466.     property AutoArrange: Boolean read FAutoArrange write SetAutoArrange default False;
  1467.     property WrapText: Boolean read FWrapText write SetWrapText default True;
  1468.   end;
  1469.  
  1470.   TListArrangement = (arAlignBottom, arAlignLeft, arAlignRight,
  1471.     arAlignTop, arDefault, arSnapToGrid);
  1472.   TViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport);
  1473.   TItemState = (isNone, isCut, isDropHilited, isFocused, isSelected);
  1474.   TItemStates = set of TItemState;
  1475.   TItemChange = (ctText, ctImage, ctState);
  1476.   TLVDeletedEvent = procedure(Sender: TObject; Item: TListItem) of object;
  1477.   TLVEditingEvent = procedure(Sender: TObject; Item: TListItem;
  1478.     var AllowEdit: Boolean) of object;
  1479.   TLVEditedEvent = procedure(Sender: TObject; Item: TListItem; var S: string) of object;
  1480.   TLVChangeEvent = procedure(Sender: TObject; Item: TListItem;
  1481.     Change: TItemChange) of object;
  1482.   TLVChangingEvent = procedure(Sender: TObject; Item: TListItem;
  1483.     Change: TItemChange; var AllowChange: Boolean) of object;
  1484.   TLVColumnClickEvent = procedure(Sender: TObject; Column: TListColumn) of object;
  1485.   TLVCompareEvent = procedure(Sender: TObject; Item1, Item2: TListItem;
  1486.     Data: Integer; var Compare: Integer) of object;
  1487.   TSearchDirection = (sdLeft, sdRight, sdAbove, sdBelow, sdAll);
  1488.  
  1489.   { TCustomListView }
  1490.   TCustomListView = class(TWinControl)
  1491.   private
  1492.     FBorderStyle: TBorderStyle;
  1493.     FViewStyle: TViewStyle;
  1494.     FReadOnly: Boolean;
  1495.     FLargeImages: TImageList;
  1496.     FSmallImages: TImageList;
  1497.     FStateImages: TImageList;
  1498.     FDragImage: TImageList;
  1499.     FShareImages: Boolean;
  1500.     FMultiSelect: Boolean;
  1501.     FSortType: TSortType;
  1502.     FColumnClick: Boolean;
  1503.     FShowColumnHeaders: Boolean;
  1504.     FListItems: TListItems;
  1505.     FClicked: Boolean;
  1506.     FRClicked: Boolean;
  1507.     FIconOptions: TIconOptions;
  1508.     FHideSelection: Boolean;
  1509.     FListColumns: TListColumns;
  1510.     FMemStream: TMemoryStream;
  1511.     FEditInstance: Pointer;
  1512.     FDefEditProc: Pointer;
  1513.     FEditHandle: HWND;
  1514.     FHeaderInstance: Pointer;
  1515.     FDefHeaderProc: Pointer;
  1516.     FHeaderHandle: HWND;
  1517.     FAllocBy: Integer;
  1518.     FDragIndex: Integer;
  1519.     FLastDropTarget: TListItem;
  1520.     FLargeChangeLink: TChangeLink;
  1521.     FSmallChangeLink: TChangeLink;
  1522.     FStateChangeLink: TChangeLink;
  1523.     FOnChange: TLVChangeEvent;
  1524.     FOnChanging: TLVChangingEvent;
  1525.     FOnColumnClick: TLVColumnClickEvent;
  1526.     FOnDeletion: TLVDeletedEvent;
  1527.     FOnEditing: TLVEditingEvent;
  1528.     FOnEdited: TLVEditedEvent;
  1529.     FOnInsert: TLVDeletedEvent;
  1530.     FOnCompare: TLVCompareEvent;
  1531.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  1532.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  1533.     procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
  1534.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  1535.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  1536.     procedure DoDragOver(Source: TDragObject; X, Y: Integer);
  1537.     procedure EditWndProc(var Message: TMessage);
  1538.     function GetBoundingRect: TRect;
  1539.     function GetColumnFromIndex(Index: Integer): TListColumn;
  1540.     function GetDropTarget: TListItem;
  1541.     function GetFocused: TListItem;
  1542.     function GetItem(Value: TLVItem): TListItem;
  1543.     function GetSelCount: Integer;
  1544.     function GetSelection: TListItem;
  1545.     function GetTopItem: TListItem;
  1546.     function GetViewOrigin: TPoint;
  1547.     function GetVisibleRowCount: Integer;
  1548.     procedure HeaderWndProc(var Message: TMessage);
  1549.     procedure ImageListChange(Sender: TObject);
  1550.     procedure InsertItem(Item: TListItem); dynamic;
  1551.     procedure SetBorderStyle(Value: TBorderStyle);
  1552.     procedure SetColumnClick(Value: Boolean);
  1553.     procedure SetColumnHeaders(Value: Boolean);
  1554.     procedure SetDropTarget(Value: TListItem);
  1555.     procedure SetFocused(Value: TListItem);
  1556.     procedure SetHideSelection(Value: Boolean);
  1557.     procedure SetIconArrangement(Value: TIconArrangement);
  1558.     procedure SetIconOptions(Value: TIconOptions);
  1559.     procedure SetImageList(Value: HImageList; Flags: Integer);
  1560.     procedure SetLargeImages(Value: TImageList);
  1561.     procedure SetAllocBy(Value: Integer);
  1562.     procedure SetItems(Value: TListItems);
  1563.     procedure SetListColumns(Value: TListColumns);
  1564.     procedure SetMultiSelect(Value: Boolean);
  1565.     procedure SetReadOnly(Value: Boolean);
  1566.     procedure SetSmallImages(Value: TImageList);
  1567.     procedure SetSortType(Value: TSortType);
  1568.     procedure SetSelection(Value: TListItem);
  1569.     procedure SetStateImages(Value: TImageList);
  1570.     procedure SetTextBkColor(Value: TColor);
  1571.     procedure SetTextColor(Value: TColor);
  1572.     procedure SetViewStyle(Value: TViewStyle);
  1573.     function ValidHeaderHandle: Boolean;
  1574.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  1575.     procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  1576.     procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
  1577.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  1578.   protected
  1579.     function CanChange(Item: TListItem; Change: Integer): Boolean; dynamic;
  1580.     function CanEdit(Item: TListItem): Boolean; dynamic;
  1581.     procedure Change(Item: TListItem; Change: Integer); dynamic;
  1582.     procedure ColClick(Column: TListColumn); dynamic;
  1583.     function ColumnsShowing: Boolean;
  1584.     function CreateListItem: TListItem; virtual;
  1585.     procedure CreateParams(var Params: TCreateParams); override;
  1586.     procedure CreateWnd; override;
  1587.     procedure Delete(Item: TListItem); dynamic;
  1588.     procedure DestroyWnd; override;
  1589.     procedure DoEndDrag(Target: TObject; X, Y: Integer); dynamic;
  1590.     procedure DoStartDrag(var DragObject: TDragObject); override;
  1591.     procedure Edit(const Item: TLVItem); dynamic;
  1592.     function GetDragImages: TCustomImageList; override;
  1593.     function GetItemIndex(Value: TListItem): Integer;
  1594.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1595.     procedure UpdateColumn(Index: Integer);
  1596.     procedure UpdateColumns;
  1597.     procedure WndProc(var Message: TMessage); override;
  1598.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  1599.     property Columns: TListColumns read FListColumns write SetListColumns;
  1600.     property ColumnClick: Boolean read FColumnClick write SetColumnClick default True;
  1601.     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  1602.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  1603.     property IconOptions: TIconOptions read FIconOptions write SetIconOptions;
  1604.     property Items: TListItems read FListItems write SetItems;
  1605.     property AllocBy: Integer read FAllocBy write SetAllocBy default 0;
  1606.     property LargeImages: TImageList read FLargeImages write SetLargeImages;
  1607.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
  1608.     property OnChange: TLVChangeEvent read FOnChange write FOnChange;
  1609.     property OnChanging: TLVChangingEvent read FOnChanging write FOnChanging;
  1610.     property OnColumnClick: TLVColumnClickEvent read FOnColumnClick
  1611.       write FOnColumnClick;
  1612.     property OnCompare: TLVCompareEvent read FOnCompare write FOnCompare;
  1613.     property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion;
  1614.     property OnEdited: TLVEditedEvent read FOnEdited write FOnEdited;
  1615.     property OnEditing: TLVEditingEvent read FOnEditing write FOnEditing;
  1616.     property OnInsert: TLVDeletedEvent read FOnInsert write FOnInsert;
  1617.     property ShowColumnHeaders: Boolean read FShowColumnHeaders write
  1618.       SetColumnHeaders default True;
  1619.     property SmallImages: TImageList read FSmallImages write SetSmallImages;
  1620.     property SortType: TSortType read FSortType write SetSortType default stNone;
  1621.     property StateImages: TImageList read FStateImages write SetStateImages;
  1622.     property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsIcon;
  1623.   public
  1624.     constructor Create(AOwner: TComponent); override;
  1625.     destructor Destroy; override;
  1626.     function AlphaSort: Boolean;
  1627.     procedure Arrange(Code: TListArrangement);
  1628.     function FindCaption(StartIndex: Integer; Value: string;
  1629.       Partial, Inclusive, Wrap: Boolean): TListItem;
  1630.     function FindData(StartIndex: Integer; Value: Pointer;
  1631.       Inclusive, Wrap: Boolean): TListItem;
  1632.     function GetItemAt(X, Y: Integer): TListItem;
  1633.     function GetNearestItem(Point: TPoint;
  1634.       Direction: TSearchDirection): TListItem;
  1635.     function GetNextItem(StartItem: TListItem;
  1636.       Direction: TSearchDirection; States: TItemStates): TListItem;
  1637.     function GetSearchString: string;
  1638.     function IsEditing: Boolean;
  1639.     procedure Scroll(DX, DY: Integer);
  1640.     property Column[Index: Integer]: TListColumn read GetColumnFromIndex;
  1641.     property DropTarget: TListItem read GetDropTarget write SetDropTarget;
  1642.     property ItemFocused: TListItem read GetFocused write SetFocused;
  1643.     property SelCount: Integer read GetSelCount;
  1644.     property Selected: TListItem read GetSelection write SetSelection;
  1645.     function CustomSort(SortProc: TLVCompare; lParam: Longint): Boolean;
  1646.     function StringWidth(S: string): Integer;
  1647.     procedure UpdateItems(FirstIndex, LastIndex: Integer);
  1648.     property TopItem: TListItem read GetTopItem;
  1649.     property ViewOrigin: TPoint read GetViewOrigin;
  1650.     property VisibleRowCount: Integer read GetVisibleRowCount;
  1651.     property BoundingRect: TRect read GetBoundingRect;
  1652.   end;
  1653.  
  1654.   { TListView }
  1655.   TListView = class(TCustomListView)
  1656.   published
  1657.     property Align;
  1658.     property BorderStyle;
  1659.     property Color;
  1660.     property ColumnClick;
  1661.     property OnClick;
  1662.     property OnDblClick;
  1663.     property Columns;
  1664.     property Ctl3D;
  1665.     property DragMode;
  1666.     property ReadOnly;
  1667.     property Font;
  1668.     property HideSelection;
  1669.     property IconOptions;
  1670.     property Items;
  1671.     property AllocBy;
  1672.     property MultiSelect;
  1673.     property OnChange;
  1674.     property OnChanging;
  1675.     property OnColumnClick;
  1676.     property OnCompare;
  1677.     property OnDeletion;
  1678.     property OnEdited;
  1679.     property OnEditing;
  1680.     property OnEnter;
  1681.     property OnExit;
  1682.     property OnInsert;
  1683.     property OnDragDrop;
  1684.     property OnDragOver;
  1685.     property DragCursor;
  1686.     property OnStartDrag;
  1687.     property OnEndDrag;
  1688.     property OnMouseDown;
  1689.     property OnMouseMove;
  1690.     property OnMouseUp;
  1691.     property ParentShowHint;
  1692.     property ShowHint;
  1693.     property PopupMenu;
  1694.     property ShowColumnHeaders;
  1695.     property SortType;
  1696.     property TabOrder;
  1697.     property TabStop default True;
  1698.     property ViewStyle;
  1699.     property Visible;
  1700.     property OnKeyDown;
  1701.     property OnKeyPress;
  1702.     property OnKeyUp;
  1703.     property LargeImages;
  1704.     property SmallImages;
  1705.     property StateImages;
  1706.   end;
  1707.  
  1708. implementation
  1709.  
  1710. uses Printers, Consts, ComStrs;
  1711.  
  1712. const
  1713.   SectionSizeArea = 8;
  1714.   RTFConversionFormat: TConversionFormat = (
  1715.     ConversionClass: TConversion;
  1716.     Extension: 'rtf';
  1717.     Next: nil);
  1718.   TextConversionFormat: TConversionFormat = (
  1719.     ConversionClass: TConversion;
  1720.     Extension: 'txt';
  1721.     Next: @RTFConversionFormat);
  1722.  
  1723. var
  1724.   ConversionFormatList: PConversionFormat = @TextConversionFormat;
  1725.  
  1726. { TTabStrings }
  1727.  
  1728. type
  1729.   TTabStrings = class(TStrings)
  1730.   private
  1731.     FTabControl: TCustomTabControl;
  1732.   protected
  1733.     function Get(Index: Integer): string; override;
  1734.     function GetCount: Integer; override;
  1735.     function GetObject(Index: Integer): TObject; override;
  1736.     procedure Put(Index: Integer; const S: string); override;
  1737.     procedure PutObject(Index: Integer; AObject: TObject); override;
  1738.     procedure SetUpdateState(Updating: Boolean); override;
  1739.   public
  1740.     procedure Clear; override;
  1741.     procedure Delete(Index: Integer); override;
  1742.     procedure Insert(Index: Integer; const S: string); override;
  1743.   end;
  1744.  
  1745. procedure TabControlError;
  1746. begin
  1747.   raise EListError.CreateRes(sTabAccessError);
  1748. end;
  1749.  
  1750. procedure TTabStrings.Clear;
  1751. begin
  1752.   if SendMessage(FTabControl.Handle, TCM_DELETEALLITEMS, 0, 0) = 0 then
  1753.     TabControlError;
  1754.   FTabControl.TabsChanged;
  1755. end;
  1756.  
  1757. procedure TTabStrings.Delete(Index: Integer);
  1758. begin
  1759.   if SendMessage(FTabControl.Handle, TCM_DELETEITEM, Index, 0) = 0 then
  1760.     TabControlError;
  1761.   FTabControl.TabsChanged;
  1762. end;
  1763.  
  1764. function TTabStrings.Get(Index: Integer): string;
  1765. var
  1766.   TCItem: TTCItem;
  1767.   Buffer: array[0..4095] of Char;
  1768. begin
  1769.   TCItem.mask := TCIF_TEXT;
  1770.   TCItem.pszText := Buffer;
  1771.   TCItem.cchTextMax := SizeOf(Buffer);
  1772.   if SendMessage(FTabControl.Handle, TCM_GETITEM, Index,
  1773.     Longint(@TCItem)) = 0 then TabControlError;
  1774.   Result := Buffer;
  1775. end;
  1776.  
  1777. function TTabStrings.GetCount: Integer;
  1778. begin
  1779.   Result := SendMessage(FTabControl.Handle, TCM_GETITEMCOUNT, 0, 0);
  1780. end;
  1781.  
  1782. function TTabStrings.GetObject(Index: Integer): TObject;
  1783. var
  1784.   TCItem: TTCItem;
  1785. begin
  1786.   TCItem.mask := TCIF_PARAM;
  1787.   if SendMessage(FTabControl.Handle, TCM_GETITEM, Index,
  1788.     Longint(@TCItem)) = 0 then TabControlError;
  1789.   Result := TObject(TCItem.lParam);
  1790. end;
  1791.  
  1792. procedure TTabStrings.Put(Index: Integer; const S: string);
  1793. var
  1794.   TCItem: TTCItem;
  1795. begin
  1796.   TCItem.mask := TCIF_TEXT;
  1797.   TCItem.pszText := PChar(S);
  1798.   if SendMessage(FTabControl.Handle, TCM_SETITEM, Index,
  1799.     Longint(@TCItem)) = 0 then TabControlError;
  1800.   FTabControl.TabsChanged;
  1801. end;
  1802.  
  1803. procedure TTabStrings.PutObject(Index: Integer; AObject: TObject);
  1804. var
  1805.   TCItem: TTCItem;
  1806. begin
  1807.   TCItem.mask := TCIF_PARAM;
  1808.   TCItem.lParam := Longint(AObject);
  1809.   if SendMessage(FTabControl.Handle, TCM_SETITEM, Index,
  1810.     Longint(@TCItem)) = 0 then TabControlError;
  1811. end;
  1812.  
  1813. procedure TTabStrings.Insert(Index: Integer; const S: string);
  1814. var
  1815.   TCItem: TTCItem;
  1816. begin
  1817.   TCItem.mask := TCIF_TEXT;
  1818.   TCItem.pszText := PChar(S);
  1819.   if SendMessage(FTabControl.Handle, TCM_INSERTITEM, Index,
  1820.     Longint(@TCItem)) < 0 then TabControlError;
  1821.   FTabControl.TabsChanged;
  1822. end;
  1823.  
  1824. procedure TTabStrings.SetUpdateState(Updating: Boolean);
  1825. begin
  1826.   FTabControl.FUpdating := Updating;
  1827.   SendMessage(FTabControl.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1828.   if not Updating then
  1829.   begin
  1830.     FTabControl.Invalidate;
  1831.     FTabControl.TabsChanged;
  1832.   end;
  1833. end;
  1834.  
  1835. { TCustomTabControl }
  1836.  
  1837. constructor TCustomTabControl.Create(AOwner: TComponent);
  1838. begin
  1839.   inherited Create(AOwner);
  1840.   Width := 289;
  1841.   Height := 193;
  1842.   TabStop := True;
  1843.   ControlStyle := [csAcceptsControls, csDoubleClicks];
  1844.   FTabs := TTabStrings.Create;
  1845.   TTabStrings(FTabs).FTabControl := Self;
  1846. end;
  1847.  
  1848. destructor TCustomTabControl.Destroy;
  1849. begin
  1850.   FTabs.Free;
  1851.   FSaveTabs.Free;
  1852.   inherited Destroy;
  1853. end;
  1854.  
  1855. function TCustomTabControl.CanChange: Boolean;
  1856. begin
  1857.   Result := True;
  1858.   if Assigned(FOnChanging) then FOnChanging(Self, Result);
  1859. end;
  1860.  
  1861. procedure TCustomTabControl.Change;
  1862. begin
  1863.   if Assigned(FOnChange) then FOnChange(Self);
  1864. end;
  1865.  
  1866. procedure TCustomTabControl.CreateParams(var Params: TCreateParams);
  1867. begin
  1868.   InitCommonControls;
  1869.   inherited CreateParams(Params);
  1870.   CreateSubClass(Params, WC_TABCONTROL);
  1871.   with Params do
  1872.   begin
  1873.     Style := Style or WS_CLIPCHILDREN;
  1874.     if not TabStop then Style := Style or TCS_FOCUSNEVER;
  1875.     if FMultiLine then Style := Style or TCS_MULTILINE;
  1876.     if FTabSize.X <> 0 then Style := Style or TCS_FIXEDWIDTH;
  1877.     WindowClass.style := WindowClass.style or CS_DBLCLKS;
  1878.   end;
  1879. end;
  1880.  
  1881. procedure TCustomTabControl.CreateWnd;
  1882. begin
  1883.   inherited CreateWnd;
  1884.   if Integer(FTabSize) <> 0 then UpdateTabSize;
  1885.   if FSaveTabs <> nil then
  1886.   begin
  1887.     FTabs.Assign(FSaveTabs);
  1888.     SetTabIndex(FSaveTabIndex);
  1889.     FSaveTabs.Free;
  1890.     FSaveTabs := nil;
  1891.   end;
  1892. end;
  1893.  
  1894. procedure TCustomTabControl.DestroyWnd;
  1895. begin
  1896.   if FTabs.Count > 0 then
  1897.   begin
  1898.     FSaveTabs := TStringList.Create;
  1899.     FSaveTabs.Assign(FTabs);
  1900.     FSaveTabIndex := GetTabIndex;
  1901.   end;
  1902.   inherited DestroyWnd;
  1903. end;
  1904.  
  1905. procedure TCustomTabControl.AlignControls(AControl: TControl;
  1906.   var Rect: TRect);
  1907. begin
  1908.   Rect := DisplayRect;
  1909.   inherited AlignControls(AControl, Rect);
  1910. end;
  1911.  
  1912. function TCustomTabControl.GetDisplayRect: TRect;
  1913. begin
  1914.   Result := ClientRect;
  1915.   SendMessage(Handle, TCM_ADJUSTRECT, 0, Integer(@Result));
  1916.   Inc(Result.Top, 2);
  1917. end;
  1918.  
  1919. function TCustomTabControl.GetTabIndex: Integer;
  1920. begin
  1921.   Result := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
  1922. end;
  1923.  
  1924. procedure TCustomTabControl.SetMultiLine(Value: Boolean);
  1925. begin
  1926.   if FMultiLine <> Value then
  1927.   begin
  1928.     FMultiLine := Value;
  1929.     RecreateWnd;
  1930.   end;
  1931. end;
  1932.  
  1933. procedure TCustomTabControl.SetTabHeight(Value: Smallint);
  1934. begin
  1935.   if FTabSize.Y <> Value then
  1936.   begin
  1937.     if Value < 0 then
  1938.       raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  1939.     FTabSize.Y := Value;
  1940.     UpdateTabSize;
  1941.   end;
  1942. end;
  1943.  
  1944. procedure TCustomTabControl.SetTabIndex(Value: Integer);
  1945. begin
  1946.   SendMessage(Handle, TCM_SETCURSEL, Value, 0);
  1947. end;
  1948.  
  1949. procedure TCustomTabControl.SetTabs(Value: TStrings);
  1950. begin
  1951.   FTabs.Assign(Value);
  1952. end;
  1953.  
  1954. procedure TCustomTabControl.SetTabWidth(Value: Smallint);
  1955. var
  1956.   OldValue: Smallint;
  1957. begin
  1958.   if FTabSize.X <> Value then
  1959.   begin
  1960.     if Value < 0 then
  1961.       raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  1962.     OldValue := FTabSize.X;
  1963.     FTabSize.X := Value;
  1964.     if (OldValue = 0) or (Value = 0) then
  1965.       RecreateWnd else
  1966.       UpdateTabSize;
  1967.   end;
  1968. end;
  1969.  
  1970. procedure TCustomTabControl.TabsChanged;
  1971. begin
  1972.   if not FUpdating then
  1973.   begin
  1974.     if HandleAllocated then
  1975.       SendMessage(Handle, WM_SIZE, SIZE_RESTORED,
  1976.         Word(Width) or Word(Height) shl 16);
  1977.     Realign;
  1978.   end;
  1979. end;
  1980.  
  1981. procedure TCustomTabControl.UpdateTabSize;
  1982. begin
  1983.   SendMessage(Handle, TCM_SETITEMSIZE, 0, Integer(FTabSize));
  1984.   TabsChanged;
  1985. end;
  1986.  
  1987. procedure TCustomTabControl.WMDestroy(var Message: TWMDestroy);
  1988. var
  1989.   FocusHandle: HWnd;
  1990. begin
  1991.   FocusHandle := GetFocus;
  1992.   if (FocusHandle <> 0) and ((FocusHandle = Handle) or
  1993.     IsChild(Handle, FocusHandle)) then
  1994.     Windows.SetFocus(0);
  1995.   inherited;
  1996. end;
  1997.  
  1998. procedure TCustomTabControl.CMTabStopChanged(var Message: TMessage);
  1999. begin
  2000.   if not (csDesigning in ComponentState) then RecreateWnd;
  2001. end;
  2002.  
  2003. procedure TCustomTabControl.CNNotify(var Message: TWMNotify);
  2004. begin
  2005.   with Message.NMHdr^ do
  2006.     case code of
  2007.       TCN_SELCHANGE:
  2008.         Change;
  2009.       TCN_SELCHANGING:
  2010.         begin
  2011.           Message.Result := 1;
  2012.           if CanChange then Message.Result := 0;
  2013.         end;
  2014.     end;
  2015. end;
  2016.  
  2017. { TTabSheet }
  2018.  
  2019. constructor TTabSheet.Create(AOwner: TComponent);
  2020. begin
  2021.   inherited Create(AOwner);
  2022.   Align := alClient;
  2023.   ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
  2024.   Visible := False;
  2025.   FTabVisible := True;
  2026. end;
  2027.  
  2028. destructor TTabSheet.Destroy;
  2029. begin
  2030.   if FPageControl <> nil then FPageControl.RemovePage(Self);
  2031.   inherited Destroy;
  2032. end;
  2033.  
  2034. function TTabSheet.GetPageIndex: Integer;
  2035. begin
  2036.   if FPageControl <> nil then
  2037.     Result := FPageControl.FPages.IndexOf(Self) else
  2038.     Result := -1;
  2039. end;
  2040.  
  2041. function TTabSheet.GetTabIndex: Integer;
  2042. var
  2043.   I: Integer;
  2044. begin
  2045.   Result := 0;
  2046.   if not FTabShowing then Dec(Result) else
  2047.     for I := 0 to PageIndex - 1 do
  2048.       if TTabSheet(FPageControl.FPages[I]).FTabShowing then
  2049.         Inc(Result);
  2050. end;
  2051.  
  2052. procedure TTabSheet.ReadState(Reader: TReader);
  2053. begin
  2054.   inherited ReadState(Reader);
  2055.   if Reader.Parent is TPageControl then
  2056.     PageControl := TPageControl(Reader.Parent);
  2057. end;
  2058.  
  2059. procedure TTabSheet.SetPageControl(APageControl: TPageControl);
  2060. begin
  2061.   if FPageControl <> APageControl then
  2062.   begin
  2063.     if FPageControl <> nil then FPageControl.RemovePage(Self);
  2064.     Parent := APageControl;
  2065.     if APageControl <> nil then APageControl.InsertPage(Self);
  2066.   end;
  2067. end;
  2068.  
  2069. procedure TTabSheet.SetPageIndex(Value: Integer);
  2070. var
  2071.   I: Integer;
  2072. begin
  2073.   if FPageControl <> nil then
  2074.   begin
  2075.     I := TabIndex;
  2076.     FPageControl.FPages.Move(PageIndex, Value);
  2077.     if I >= 0 then FPageControl.MoveTab(I, TabIndex);
  2078.   end;
  2079. end;
  2080.  
  2081. procedure TTabSheet.SetTabShowing(Value: Boolean);
  2082. begin
  2083.   if FTabShowing <> Value then
  2084.     if Value then
  2085.     begin
  2086.       FTabShowing := True;
  2087.       FPageControl.InsertTab(Self);
  2088.     end else
  2089.     begin
  2090.       FPageControl.DeleteTab(Self);
  2091.       FTabShowing := False;
  2092.     end;
  2093. end;
  2094.  
  2095. procedure TTabSheet.SetTabVisible(Value: Boolean);
  2096. begin
  2097.   if FTabVisible <> Value then
  2098.   begin
  2099.     FTabVisible := Value;
  2100.     UpdateTabShowing;
  2101.   end;
  2102. end;
  2103.  
  2104. procedure TTabSheet.UpdateTabShowing;
  2105. begin
  2106.   SetTabShowing((FPageControl <> nil) and FTabVisible);
  2107. end;
  2108.  
  2109. procedure TTabSheet.CMTextChanged(var Message: TMessage);
  2110. begin
  2111.   if FTabShowing then FPageControl.UpdateTab(Self);
  2112. end;
  2113.  
  2114. { TPageControl }
  2115.  
  2116. constructor TPageControl.Create(AOwner: TComponent);
  2117. begin
  2118.   inherited Create(AOwner);
  2119.   ControlStyle := [csDoubleClicks];
  2120.   FPages := TList.Create;
  2121. end;
  2122.  
  2123. destructor TPageControl.Destroy;
  2124. var
  2125.   I: Integer;
  2126. begin
  2127.   for I := 0 to FPages.Count - 1 do TTabSheet(FPages[I]).FPageControl := nil;
  2128.   FPages.Free;
  2129.   inherited Destroy;
  2130. end;
  2131.  
  2132. procedure TPageControl.Change;
  2133. var
  2134.   Form: TForm;
  2135. begin
  2136.   UpdateActivePage;
  2137.   if csDesigning in ComponentState then
  2138.   begin
  2139.     Form := GetParentForm(Self);
  2140.     if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified;
  2141.   end;
  2142.   inherited Change;
  2143. end;
  2144.  
  2145. procedure TPageControl.ChangeActivePage(Page: TTabSheet);
  2146. var
  2147.   ParentForm: TForm;
  2148. begin
  2149.   if FActivePage <> Page then
  2150.   begin
  2151.     ParentForm := GetParentForm(Self);
  2152.     if (ParentForm <> nil) and (FActivePage <> nil) and
  2153.       FActivePage.ContainsControl(ParentForm.ActiveControl) then
  2154.       ParentForm.ActiveControl := FActivePage;
  2155.     if Page <> nil then
  2156.     begin
  2157.       Page.BringToFront;
  2158.       Page.Visible := True;
  2159.       if (ParentForm <> nil) and (FActivePage <> nil) and
  2160.         (ParentForm.ActiveControl = FActivePage) then
  2161.         if Page.CanFocus then
  2162.           ParentForm.ActiveControl := Page else
  2163.           ParentForm.ActiveControl := Self;
  2164.     end;
  2165.     if FActivePage <> nil then FActivePage.Visible := False;
  2166.     FActivePage := Page;
  2167.     if (ParentForm <> nil) and (FActivePage <> nil) and
  2168.       (ParentForm.ActiveControl = FActivePage) then
  2169.       FActivePage.SelectFirst;
  2170.   end;
  2171. end;
  2172.  
  2173. procedure TPageControl.DeleteTab(Page: TTabSheet);
  2174. begin
  2175.   Tabs.Delete(Page.TabIndex);
  2176.   UpdateActivePage;
  2177. end;
  2178.  
  2179. function TPageControl.FindNextPage(CurPage: TTabSheet;
  2180.   GoForward, CheckTabVisible: Boolean): TTabSheet;
  2181. var
  2182.   I, StartIndex: Integer;
  2183. begin
  2184.   if FPages.Count <> 0 then
  2185.   begin
  2186.     StartIndex := FPages.IndexOf(CurPage);
  2187.     if StartIndex = -1 then
  2188.       if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
  2189.     I := StartIndex;
  2190.     repeat
  2191.       if GoForward then
  2192.       begin
  2193.         Inc(I);
  2194.         if I = FPages.Count then I := 0;
  2195.       end else
  2196.       begin
  2197.         if I = 0 then I := FPages.Count;
  2198.         Dec(I);
  2199.       end;
  2200.       Result := FPages[I];
  2201.       if not CheckTabVisible or Result.TabVisible then Exit;
  2202.     until I = StartIndex;
  2203.   end;
  2204.   Result := nil;
  2205. end;
  2206.  
  2207. procedure TPageControl.GetChildren(Proc: TGetChildProc);
  2208. var
  2209.   I: Integer;
  2210. begin
  2211.   for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I]));
  2212. end;
  2213.  
  2214. function TPageControl.GetPage(Index: Integer): TTabSheet;
  2215. begin
  2216.   Result := FPages[Index];
  2217. end;
  2218.  
  2219. function TPageControl.GetPageCount: Integer;
  2220. begin
  2221.   Result := FPages.Count;
  2222. end;
  2223.  
  2224. procedure TPageControl.InsertPage(Page: TTabSheet);
  2225. begin
  2226.   FPages.Add(Page);
  2227.   Page.FPageControl := Self;
  2228.   Page.UpdateTabShowing;
  2229. end;
  2230.  
  2231. procedure TPageControl.InsertTab(Page: TTabSheet);
  2232. begin
  2233.   Tabs.InsertObject(Page.TabIndex, Page.Caption, Page);
  2234.   UpdateActivePage;
  2235. end;
  2236.  
  2237. procedure TPageControl.MoveTab(CurIndex, NewIndex: Integer);
  2238. begin
  2239.   Tabs.Move(CurIndex, NewIndex);
  2240. end;
  2241.  
  2242. procedure TPageControl.RemovePage(Page: TTabSheet);
  2243. begin
  2244.   if FActivePage = Page then SetActivePage(nil);
  2245.   Page.SetTabShowing(False);
  2246.   Page.FPageControl := nil;
  2247.   FPages.Remove(Page);
  2248. end;
  2249.  
  2250. procedure TPageControl.SelectNextPage(GoForward: Boolean);
  2251. var
  2252.   Page: TTabSheet;
  2253. begin
  2254.   Page := FindNextPage(ActivePage, GoForward, True);
  2255.   if (Page <> nil) and (Page <> ActivePage) and CanChange then
  2256.   begin
  2257.     TabIndex := Page.TabIndex;
  2258.     Change;
  2259.   end;
  2260. end;
  2261.  
  2262. procedure TPageControl.SetActivePage(Page: TTabSheet);
  2263. begin
  2264.   if (Page <> nil) and (Page.PageControl <> Self) then Exit;
  2265.   ChangeActivePage(Page);
  2266.   if Page <> nil then TabIndex := Page.TabIndex else TabIndex := -1;
  2267. end;
  2268.  
  2269. procedure TPageControl.SetChildOrder(Child: TComponent; Order: Integer);
  2270. begin
  2271.   TTabSheet(Child).PageIndex := Order;
  2272. end;
  2273.  
  2274. procedure TPageControl.ShowControl(AControl: TControl);
  2275. begin
  2276.   if (AControl is TTabSheet) and (TTabSheet(AControl).PageControl = Self) then
  2277.     SetActivePage(TTabSheet(AControl));
  2278.   inherited ShowControl(AControl);
  2279. end;
  2280.  
  2281. procedure TPageControl.UpdateTab(Page: TTabSheet);
  2282. begin
  2283.   Tabs[Page.TabIndex] := Page.Caption;
  2284. end;
  2285.  
  2286. procedure TPageControl.UpdateActivePage;
  2287. begin
  2288.   if TabIndex >= 0 then SetActivePage(TTabSheet(Tabs.Objects[TabIndex]));
  2289. end;
  2290.  
  2291. procedure TPageControl.CMDesignHitTest(var Message: TCMDesignHitTest);
  2292. var
  2293.   HitIndex: Integer;
  2294.   HitTestInfo: TTCHitTestInfo;
  2295. begin
  2296.   HitTestInfo.pt := SmallPointToPoint(Message.Pos);
  2297.   HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo));
  2298.   if (HitIndex >= 0) and (HitIndex <> TabIndex) then Message.Result := 1;
  2299. end;
  2300.  
  2301. procedure TPageControl.CMDialogKey(var Message: TCMDialogKey);
  2302. begin
  2303.   if (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  2304.   begin
  2305.     SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
  2306.     Message.Result := 1;
  2307.   end else
  2308.     inherited;
  2309. end;
  2310.  
  2311. { TStatusPanel }
  2312.  
  2313. constructor TStatusPanel.Create(Collection: TCollection);
  2314. begin
  2315.   FWidth := 50;
  2316.   FBevel := pbLowered;
  2317.   inherited Create(Collection);
  2318. end;
  2319.  
  2320. procedure TStatusPanel.Assign(Source: TPersistent);
  2321. begin
  2322.   if Source is TStatusPanel then
  2323.   begin
  2324.     Text := TStatusPanel(Source).Text;
  2325.     Width := TStatusPanel(Source).Width;
  2326.     Alignment := TStatusPanel(Source).Alignment;
  2327.     Bevel := TStatusPanel(Source).Bevel;
  2328.     Style := TStatusPanel(Source).Style;
  2329.     Exit;
  2330.   end;
  2331.   inherited Assign(Source);
  2332. end;
  2333.  
  2334. procedure TStatusPanel.SetAlignment(Value: TAlignment);
  2335. begin
  2336.   if FAlignment <> Value then
  2337.   begin
  2338.     FAlignment := Value;
  2339.     Changed(False);
  2340.   end;
  2341. end;
  2342.  
  2343. procedure TStatusPanel.SetBevel(Value: TStatusPanelBevel);
  2344. begin
  2345.   if FBevel <> Value then
  2346.   begin
  2347.     FBevel := Value;
  2348.     Changed(True);
  2349.   end;
  2350. end;
  2351.  
  2352. procedure TStatusPanel.SetStyle(Value: TStatusPanelStyle);
  2353. begin
  2354.   if FStyle <> Value then
  2355.   begin
  2356.     FStyle := Value;
  2357.     Changed(False);
  2358.   end;
  2359. end;
  2360.  
  2361. procedure TStatusPanel.SetText(const Value: string);
  2362. begin
  2363.   if FText <> Value then
  2364.   begin
  2365.     FText := Value;
  2366.     Changed(False);
  2367.   end;
  2368. end;
  2369.  
  2370. procedure TStatusPanel.SetWidth(Value: Integer);
  2371. begin
  2372.   if FWidth <> Value then
  2373.   begin
  2374.     FWidth := Value;
  2375.     Changed(True);
  2376.   end;
  2377. end;
  2378.  
  2379. { TStatusPanels }
  2380.  
  2381. constructor TStatusPanels.Create(StatusBar: TStatusBar);
  2382. begin
  2383.   inherited Create(TStatusPanel);
  2384.   FStatusBar := StatusBar;
  2385. end;
  2386.  
  2387. function TStatusPanels.Add: TStatusPanel;
  2388. begin
  2389.   Result := TStatusPanel(inherited Add);
  2390. end;
  2391.  
  2392. function TStatusPanels.GetItem(Index: Integer): TStatusPanel;
  2393. begin
  2394.   Result := TStatusPanel(inherited GetItem(Index));
  2395. end;
  2396.  
  2397. procedure TStatusPanels.SetItem(Index: Integer; Value: TStatusPanel);
  2398. begin
  2399.   inherited SetItem(Index, Value);
  2400. end;
  2401.  
  2402. procedure TStatusPanels.Update(Item: TCollectionItem);
  2403. begin
  2404.   if Item <> nil then
  2405.     FStatusBar.UpdatePanel(Item.Index) else
  2406.     FStatusBar.UpdatePanels;
  2407. end;
  2408.  
  2409. { TStatusBar }
  2410.  
  2411. constructor TStatusBar.Create(AOwner: TComponent);
  2412. begin
  2413.   inherited Create(AOwner);
  2414.   ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
  2415.   Color := clBtnFace;
  2416.   Height := 19;
  2417.   Align := alBottom;
  2418.   FPanels := TStatusPanels.Create(Self);
  2419.   FCanvas := TControlCanvas.Create;
  2420.   TControlCanvas(FCanvas).Control := Self;
  2421.   FSizeGrip := True;
  2422. end;
  2423.  
  2424. destructor TStatusBar.Destroy;
  2425. begin
  2426.   FCanvas.Free;
  2427.   FPanels.Free;
  2428.   inherited Destroy;
  2429. end;
  2430.  
  2431. procedure TStatusBar.CreateParams(var Params: TCreateParams);
  2432. begin
  2433.   InitCommonControls;
  2434.   inherited CreateParams(Params);
  2435.   CreateSubClass(Params, STATUSCLASSNAME);
  2436.   if FSizeGrip then
  2437.     Params.Style := Params.Style or SBARS_SIZEGRIP else
  2438.     Params.Style := Params.Style or CCS_TOP;
  2439. end;
  2440.  
  2441. procedure TStatusBar.CreateWnd;
  2442. begin
  2443.   inherited CreateWnd;
  2444.   UpdatePanels;
  2445.   if FSimpleText <> '' then
  2446.     SendMessage(Handle, SB_SETTEXT, 255, Integer(PChar(FSimpleText)));
  2447.   if FSimplePanel then
  2448.     SendMessage(Handle, SB_SIMPLE, 1, 0);
  2449. end;
  2450.  
  2451. procedure TStatusBar.DrawPanel(Panel: TStatusPanel; const Rect: TRect);
  2452. begin
  2453.   if Assigned(FOnDrawPanel) then
  2454.     FOnDrawPanel(Self, Panel, Rect) else
  2455.     FCanvas.FillRect(Rect);
  2456. end;
  2457.  
  2458. procedure TStatusBar.Resize;
  2459. begin
  2460.   if Assigned(FOnResize) then FOnResize(Self);
  2461. end;
  2462.  
  2463. procedure TStatusBar.SetPanels(Value: TStatusPanels);
  2464. begin
  2465.   FPanels.Assign(Value);
  2466. end;
  2467.  
  2468. procedure TStatusBar.SetSimplePanel(Value: Boolean);
  2469. begin
  2470.   if FSimplePanel <> Value then
  2471.   begin
  2472.     FSimplePanel := Value;
  2473.     if HandleAllocated then
  2474.       SendMessage(Handle, SB_SIMPLE, Ord(FSimplePanel), 0);
  2475.   end;
  2476. end;
  2477.  
  2478. procedure TStatusBar.SetSimpleText(const Value: string);
  2479. begin
  2480.   if FSimpleText <> Value then
  2481.   begin
  2482.     FSimpleText := Value;
  2483.     if HandleAllocated then
  2484.       SendMessage(Handle, SB_SETTEXT, 255, Integer(PChar(FSimpleText)));
  2485.   end;
  2486. end;
  2487.  
  2488. procedure TStatusBar.SetSizeGrip(Value: Boolean);
  2489. begin
  2490.   if FSizeGrip <> Value then
  2491.   begin
  2492.     FSizeGrip := Value;
  2493.     RecreateWnd;
  2494.   end;
  2495. end;
  2496.  
  2497. procedure TStatusBar.UpdatePanel(Index: Integer);
  2498. var
  2499.   Flags: Integer;
  2500.   S: string;
  2501. begin
  2502.   if HandleAllocated then
  2503.     with Panels[Index] do
  2504.     begin
  2505.       Flags := 0;
  2506.       case Bevel of
  2507.         pbNone: Flags := SBT_NOBORDERS;
  2508.         pbRaised: Flags := SBT_POPOUT;
  2509.       end;
  2510.       if Style = psOwnerDraw then Flags := Flags or SBT_OWNERDRAW;
  2511.       S := Text;
  2512.       case Alignment of
  2513.         taCenter: S := #9 + S;
  2514.         taRightJustify: S := #9#9 + S;
  2515.       end;
  2516.       SendMessage(Handle, SB_SETTEXT, Index or Flags, Integer(PChar(S)));
  2517.     end;
  2518. end;
  2519.  
  2520. procedure TStatusBar.UpdatePanels;
  2521. const
  2522.   MaxPanelCount = 128;
  2523. var
  2524.   I, Count, PanelPos: Integer;
  2525.   PanelEdges: array[0..MaxPanelCount - 1] of Integer;
  2526. begin
  2527.   if HandleAllocated then
  2528.   begin
  2529.     Count := Panels.Count;
  2530.     if Count > MaxPanelCount then Count := MaxPanelCount;
  2531.     if Count = 0 then
  2532.     begin
  2533.       PanelEdges[0] := -1;
  2534.       SendMessage(Handle, SB_SETPARTS, 1, Integer(@PanelEdges));
  2535.       SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
  2536.     end else
  2537.     begin
  2538.       PanelPos := 0;
  2539.       for I := 0 to Count - 2 do
  2540.       begin
  2541.         Inc(PanelPos, Panels[I].Width);
  2542.         PanelEdges[I] := PanelPos;
  2543.       end;
  2544.       PanelEdges[Count - 1] := -1;
  2545.       SendMessage(Handle, SB_SETPARTS, Count, Integer(@PanelEdges));
  2546.       for I := 0 to Count - 1 do UpdatePanel(I);
  2547.     end;
  2548.   end;
  2549. end;
  2550.  
  2551. procedure TStatusBar.CNDrawItem(var Message: TWMDrawItem);
  2552. var
  2553.   SaveIndex: Integer;
  2554. begin
  2555.   with Message.DrawItemStruct^ do
  2556.   begin
  2557.     SaveIndex := SaveDC(hDC);
  2558.     FCanvas.Handle := hDC;
  2559.     FCanvas.Font := Font;
  2560.     FCanvas.Brush.Color := clBtnFace;
  2561.     FCanvas.Brush.Style := bsSolid;
  2562.     DrawPanel(Panels[itemID], rcItem);
  2563.     FCanvas.Handle := 0;
  2564.     RestoreDC(hDC, SaveIndex);
  2565.   end;
  2566.   Message.Result := 1;
  2567. end;
  2568.  
  2569. procedure TStatusBar.WMSize(var Message: TWMSize);
  2570. begin
  2571.   { Eat WM_SIZE message to prevent control from doing alignment }
  2572.   if not (csLoading in ComponentState) then Resize;
  2573. end;
  2574.  
  2575. { THeaderSection }
  2576.  
  2577. constructor THeaderSection.Create(Collection: TCollection);
  2578. begin
  2579.   FWidth := 50;
  2580.   FMaxWidth := 10000;
  2581.   FAllowClick := True;
  2582.   inherited Create(Collection);
  2583. end;
  2584.  
  2585. procedure THeaderSection.Assign(Source: TPersistent);
  2586. begin
  2587.   if Source is THeaderSection then
  2588.   begin
  2589.     Text := THeaderSection(Source).Text;
  2590.     Width := THeaderSection(Source).Width;
  2591.     MinWidth := THeaderSection(Source).MinWidth;
  2592.     MaxWidth := THeaderSection(Source).MaxWidth;
  2593.     Alignment := THeaderSection(Source).Alignment;
  2594.     Style := THeaderSection(Source).Style;
  2595.     AllowClick := THeaderSection(Source).AllowClick;
  2596.     Exit;
  2597.   end;
  2598.   inherited Assign(Source);
  2599. end;
  2600.  
  2601. function THeaderSection.GetLeft: Integer;
  2602. var
  2603.   I: Integer;
  2604. begin
  2605.   Result := 0;
  2606.   for I := 0 to Index - 1 do
  2607.     Inc(Result, THeaderSections(Collection)[I].Width);
  2608. end;
  2609.  
  2610. function THeaderSection.GetRight: Integer;
  2611. begin
  2612.   Result := Left + Width;
  2613. end;
  2614.  
  2615. procedure THeaderSection.SetAlignment(Value: TAlignment);
  2616. begin
  2617.   if FAlignment <> Value then
  2618.   begin
  2619.     FAlignment := Value;
  2620.     Changed(False);
  2621.   end;
  2622. end;
  2623.  
  2624. procedure THeaderSection.SetMaxWidth(Value: Integer);
  2625. begin
  2626.   if Value < FMinWidth then Value := FMinWidth;
  2627.   if Value > 10000 then Value := 10000;
  2628.   FMaxWidth := Value;
  2629.   SetWidth(FWidth);
  2630. end;
  2631.  
  2632. procedure THeaderSection.SetMinWidth(Value: Integer);
  2633. begin
  2634.   if Value < 0 then Value := 0;
  2635.   if Value > FMaxWidth then Value := FMaxWidth;
  2636.   FMinWidth := Value;
  2637.   SetWidth(FWidth);
  2638. end;
  2639.  
  2640. procedure THeaderSection.SetStyle(Value: THeaderSectionStyle);
  2641. begin
  2642.   if FStyle <> Value then
  2643.   begin
  2644.     FStyle := Value;
  2645.     Changed(False);
  2646.   end;
  2647. end;
  2648.  
  2649. procedure THeaderSection.SetText(const Value: string);
  2650. begin
  2651.   if FText <> Value then
  2652.   begin
  2653.     FText := Value;
  2654.     Changed(False);
  2655.   end;
  2656. end;
  2657.  
  2658. procedure THeaderSection.SetWidth(Value: Integer);
  2659. begin
  2660.   if Value < FMinWidth then Value := FMinWidth;
  2661.   if Value > FMaxWidth then Value := FMaxWidth;
  2662.   if FWidth <> Value then
  2663.   begin
  2664.     FWidth := Value;
  2665.     Changed(True);
  2666.   end;
  2667. end;
  2668.  
  2669. { THeaderSections }
  2670.  
  2671. constructor THeaderSections.Create(HeaderControl: THeaderControl);
  2672. begin
  2673.   inherited Create(THeaderSection);
  2674.   FHeaderControl := HeaderControl;
  2675. end;
  2676.  
  2677. function THeaderSections.Add: THeaderSection;
  2678. begin
  2679.   Result := THeaderSection(inherited Add);
  2680. end;
  2681.  
  2682. function THeaderSections.GetItem(Index: Integer): THeaderSection;
  2683. begin
  2684.   Result := THeaderSection(inherited GetItem(Index));
  2685. end;
  2686.  
  2687. procedure THeaderSections.SetItem(Index: Integer; Value: THeaderSection);
  2688. begin
  2689.   inherited SetItem(Index, Value);
  2690. end;
  2691.  
  2692. procedure THeaderSections.Update(Item: TCollectionItem);
  2693. begin
  2694.   if Item <> nil then
  2695.     FHeaderControl.UpdateSection(Item.Index) else
  2696.     FHeaderControl.UpdateSections;
  2697. end;
  2698.  
  2699. { THeaderControl }
  2700.  
  2701. constructor THeaderControl.Create(AOwner: TComponent);
  2702. begin
  2703.   inherited Create(AOwner);
  2704.   ControlStyle := [];
  2705.   Align := alTop;
  2706.   Height := 17;
  2707.   FSections := THeaderSections.Create(Self);
  2708.   FCanvas := TControlCanvas.Create;
  2709.   TControlCanvas(FCanvas).Control := Self;
  2710. end;
  2711.  
  2712. destructor THeaderControl.Destroy;
  2713. begin
  2714.   FCanvas.Free;
  2715.   FSections.Free;
  2716.   inherited Destroy;
  2717. end;
  2718.  
  2719. procedure THeaderControl.CreateParams(var Params: TCreateParams);
  2720. begin
  2721.   InitCommonControls;
  2722.   inherited CreateParams(Params);
  2723.   CreateSubClass(Params, 'SysHeader32');
  2724.   Params.Style := Params.Style or HDS_BUTTONS;
  2725. end;
  2726.  
  2727. procedure THeaderControl.CreateWnd;
  2728. begin
  2729.   inherited CreateWnd;
  2730.   UpdateSections;
  2731. end;
  2732.  
  2733. procedure THeaderControl.DrawSection(Section: THeaderSection;
  2734.   const Rect: TRect; Pressed: Boolean);
  2735. begin
  2736.   if Assigned(FOnDrawSection) then
  2737.     FOnDrawSection(Self, Section, Rect, Pressed) else
  2738.     FCanvas.FillRect(Rect);
  2739. end;
  2740.  
  2741. procedure THeaderControl.Resize;
  2742. begin
  2743.   if Assigned(FOnResize) then FOnResize(Self);
  2744. end;
  2745.  
  2746. procedure THeaderControl.SectionClick(Section: THeaderSection);
  2747. begin
  2748.   if Assigned(FOnSectionClick) then FOnSectionClick(Self, Section);
  2749. end;
  2750.  
  2751. procedure THeaderControl.SectionResize(Section: THeaderSection);
  2752. begin
  2753.   if Assigned(FOnSectionResize) then FOnSectionResize(Self, Section);
  2754. end;
  2755.  
  2756. procedure THeaderControl.SectionTrack(Section: THeaderSection;
  2757.   Width: Integer; State: TSectionTrackState);
  2758. begin
  2759.   if Assigned(FOnSectionTrack) then FOnSectionTrack(Self, Section, Width, State);
  2760. end;
  2761.  
  2762. procedure THeaderControl.SetSections(Value: THeaderSections);
  2763. begin
  2764.   FSections.Assign(Value);
  2765. end;
  2766.  
  2767. procedure THeaderControl.UpdateItem(Message, Index: Integer);
  2768. var
  2769.   Item: THDItem;
  2770. begin
  2771.   with Sections[Index] do
  2772.   begin
  2773.     FillChar(Item, SizeOf(Item), 0);
  2774.     Item.mask := HDI_WIDTH or HDI_TEXT or HDI_FORMAT;
  2775.     Item.cxy := Width;
  2776.     Item.pszText := PChar(Text);
  2777.     Item.cchTextMax := Length(Text);
  2778.     case Alignment of
  2779.       taLeftJustify: Item.fmt := HDF_LEFT;
  2780.       taRightJustify: Item.fmt := HDF_RIGHT;
  2781.     else
  2782.       Item.fmt := HDF_CENTER;
  2783.     end;
  2784.     if Style = hsOwnerDraw then
  2785.       Item.fmt := Item.fmt or HDF_OWNERDRAW else
  2786.       Item.fmt := Item.fmt or HDF_STRING;
  2787.     SendMessage(Handle, Message, Index, Integer(@Item));
  2788.   end;
  2789. end;
  2790.  
  2791. procedure THeaderControl.UpdateSection(Index: Integer);
  2792. begin
  2793.   if HandleAllocated then UpdateItem(HDM_SETITEM, Index);
  2794. end;
  2795.  
  2796. procedure THeaderControl.UpdateSections;
  2797. var
  2798.   I: Integer;
  2799. begin
  2800.   if HandleAllocated then
  2801.   begin
  2802.     for I := 0 to SendMessage(Handle, HDM_GETITEMCOUNT, 0, 0) - 1 do
  2803.       SendMessage(Handle, HDM_DELETEITEM, 0, 0);
  2804.     for I := 0 to Sections.Count - 1 do UpdateItem(HDM_INSERTITEM, I);
  2805.   end;
  2806. end;
  2807.  
  2808. procedure THeaderControl.CNDrawItem(var Message: TWMDrawItem);
  2809. var
  2810.   SaveIndex: Integer;
  2811. begin
  2812.   with Message.DrawItemStruct^ do
  2813.   begin
  2814.     SaveIndex := SaveDC(hDC);
  2815.     FCanvas.Handle := hDC;
  2816.     FCanvas.Font := Font;
  2817.     FCanvas.Brush.Color := clBtnFace;
  2818.     FCanvas.Brush.Style := bsSolid;
  2819.     DrawSection(Sections[itemID], rcItem, itemState and ODS_SELECTED <> 0);
  2820.     FCanvas.Handle := 0;
  2821.     RestoreDC(hDC, SaveIndex);
  2822.   end;
  2823.   Message.Result := 1;
  2824. end;
  2825.  
  2826. procedure THeaderControl.CNNotify(var Message: TWMNotify);
  2827. var
  2828.   Section: THeaderSection;
  2829.   TrackState: TSectionTrackState;
  2830. begin
  2831.   with PHDNotify(Message.NMHdr)^ do
  2832.     case Hdr.code of
  2833.       HDN_ITEMCLICK:
  2834.         SectionClick(Sections[Item]);
  2835.       HDN_ITEMCHANGED:
  2836.         if PItem^.mask and HDI_WIDTH <> 0 then
  2837.         begin
  2838.           Section := Sections[Item];
  2839.           if Section.FWidth <> PItem^.cxy then
  2840.           begin
  2841.             Section.FWidth := PItem^.cxy;
  2842.             SectionResize(Section);
  2843.           end;
  2844.         end;
  2845.       HDN_BEGINTRACK, HDN_TRACK, HDN_ENDTRACK:
  2846.         begin
  2847.           Section := Sections[Item];
  2848.           case Hdr.code of
  2849.             HDN_BEGINTRACK: TrackState := tsTrackBegin;
  2850.             HDN_ENDTRACK: TrackState := tsTrackEnd;
  2851.           else
  2852.             TrackState := tsTrackMove;
  2853.           end;
  2854.           with PItem^ do
  2855.           begin
  2856.             if cxy < Section.FMinWidth then cxy := Section.FMinWidth;
  2857.             if cxy > Section.FMaxWidth then cxy := Section.FMaxWidth;
  2858.             SectionTrack(Sections[Item], cxy, TrackState);
  2859.           end;
  2860.         end;
  2861.     end;
  2862. end;
  2863.  
  2864. procedure THeaderControl.WMLButtonDown(var Message: TWMLButtonDown);
  2865. var
  2866.   Index: Integer;
  2867.   Info: THDHitTestInfo;
  2868. begin
  2869.   Info.Point.X := Message.Pos.X;
  2870.   Info.Point.Y := Message.Pos.Y;
  2871.   Index := SendMessage(Handle, HDM_HITTEST, 0, Integer(@Info));
  2872.   if (Index < 0) or (Info.Flags and HHT_ONHEADER = 0) or
  2873.     Sections[Index].AllowClick then inherited;
  2874. end;
  2875.  
  2876. procedure THeaderControl.WMSize(var Message: TWMSize);
  2877. begin
  2878.   inherited;
  2879.   if not (csLoading in ComponentState) then Resize;
  2880. end;
  2881.  
  2882. { TTreeNode }
  2883.  
  2884. function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
  2885. begin
  2886.   with Node1 do
  2887.     if Assigned(TreeView.OnCompare) then
  2888.       TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
  2889.     else Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
  2890. end;
  2891.  
  2892. procedure TreeViewError(MsgID: Integer);
  2893. begin
  2894.   raise ETreeViewError.CreateRes(MsgID);
  2895. end;
  2896.  
  2897. constructor TTreeNode.Create(AOwner: TTreeNodes);
  2898. begin
  2899.   inherited Create;
  2900.   FOverlayIndex := -1;
  2901.   FStateIndex := -1;
  2902.   FOwner := AOwner;
  2903. end;
  2904.  
  2905. destructor TTreeNode.Destroy;
  2906. var
  2907.   Node: TTreeNode;
  2908.   CheckValue: Integer;
  2909. begin
  2910.   FDeleting := True;
  2911.   Node := Parent;
  2912.   if (Node <> nil) and (not Node.Deleting) then
  2913.   begin
  2914.     if Node.IndexOf(Self) <> -1 then CheckValue := 1
  2915.     else CheckValue := 0;
  2916.     if Node.Count = CheckValue then
  2917.     begin
  2918.       Node.Expanded := False;
  2919.       Node.HasChildren := False;
  2920.     end;
  2921.   end;
  2922.   if ItemId <> nil then TreeView_DeleteItem(Handle, ItemId);
  2923.   Data := nil;
  2924.   inherited Destroy;
  2925. end;
  2926.  
  2927. function TTreeNode.GetHandle: HWND;
  2928. begin
  2929.   Result := TreeView.Handle;
  2930. end;
  2931.  
  2932. function TTreeNode.GetTreeView: TCustomTreeView;
  2933. begin
  2934.   Result := Owner.Owner;
  2935. end;
  2936.  
  2937. function TTreeNode.HasAsParent(Value: TTreeNode): Boolean;
  2938. begin
  2939.   if Self = Value then Result := True
  2940.   else if Parent <> nil then Result := Parent.HasAsParent(Value)
  2941.   else Result := False;
  2942. end;
  2943.  
  2944. procedure TTreeNode.SetText(const S: string);
  2945. var
  2946.   Item: TTVItem;
  2947. begin
  2948.   FText := S;
  2949.   with Item do
  2950.   begin
  2951.     mask := TVIF_TEXT;
  2952.     hItem := ItemId;
  2953.     pszText := LPSTR_TEXTCALLBACK;
  2954.   end;
  2955.   TreeView_SetItem(Handle, Item);
  2956.   if TreeView.SortType in [stText, stBoth] then
  2957.   begin
  2958.     if Parent <> nil then Parent.AlphaSort
  2959.     else TreeView.AlphaSort;
  2960.   end;
  2961. end;
  2962.  
  2963. procedure TTreeNode.SetData(Value: Pointer);
  2964. begin
  2965.   FData := Value;
  2966.   if (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare) then
  2967.   begin
  2968.     if Parent <> nil then Parent.AlphaSort
  2969.     else TreeView.AlphaSort;
  2970.   end;
  2971. end;
  2972.  
  2973. function TTreeNode.GetState(NodeState: TNodeState): Boolean;
  2974. var
  2975.   Item: TTVItem;
  2976. begin
  2977.   Result := False;
  2978.   with Item do
  2979.   begin
  2980.     mask := TVIF_STATE;
  2981.     hItem := ItemId;
  2982.     if TreeView_GetItem(Handle, Item) then
  2983.       case NodeState of
  2984.         nsCut: Result := (state and TVIS_CUT) <> 0;
  2985.         nsFocused: Result := (state and TVIS_FOCUSED) <> 0;
  2986.         nsSelected: Result := (state and TVIS_SELECTED) <> 0;
  2987.         nsExpanded: Result := (state and TVIS_EXPANDED) <> 0;
  2988.         nsDropHilited: Result := (state and TVIS_DROPHILITED) <> 0;
  2989.       end;
  2990.   end;
  2991. end;
  2992.  
  2993. procedure TTreeNode.SetImageIndex(Value: Integer);
  2994. var
  2995.   Item: TTVItem;
  2996. begin
  2997.   FImageIndex := Value;
  2998.   with Item do
  2999.   begin
  3000.     mask := TVIF_IMAGE;
  3001.     hItem := ItemId;
  3002.     iImage := I_IMAGECALLBACK;
  3003.   end;
  3004.   TreeView_SetItem(Handle, Item);
  3005. end;
  3006.  
  3007. procedure TTreeNode.SetSelectedIndex(Value: Integer);
  3008. var
  3009.   Item: TTVItem;
  3010. begin
  3011.   FSelectedIndex := Value;
  3012.   with Item do
  3013.   begin
  3014.     mask := TVIF_SELECTEDIMAGE;
  3015.     hItem := ItemId;
  3016.     iSelectedImage := I_IMAGECALLBACK;
  3017.   end;
  3018.   TreeView_SetItem(Handle, Item);
  3019. end;
  3020.  
  3021. procedure TTreeNode.SetOverlayIndex(Value: Integer);
  3022. var
  3023.   Item: TTVItem;
  3024. begin
  3025.   FOverlayIndex := Value;
  3026.   with Item do
  3027.   begin
  3028.     mask := TVIF_STATE;
  3029.     stateMask := TVIS_OVERLAYMASK;
  3030.     hItem := ItemId;
  3031.     state := IndexToOverlayMask(OverlayIndex + 1);
  3032.   end;
  3033.   TreeView_SetItem(Handle, Item);
  3034. end;
  3035.  
  3036. procedure TTreeNode.SetStateIndex(Value: Integer);
  3037. var
  3038.   Item: TTVItem;
  3039. begin
  3040.   FStateIndex := Value;
  3041.   if Value >= 0 then Dec(Value);
  3042.   with Item do
  3043.   begin
  3044.     mask := TVIF_STATE;
  3045.     stateMask := TVIS_STATEIMAGEMASK;
  3046.     hItem := ItemId;
  3047.     state := IndexToStateImageMask(Value + 1);
  3048.   end;
  3049.   TreeView_SetItem(Handle, Item);
  3050. end;
  3051.  
  3052. procedure TTreeNode.ExpandItem(Expand: Boolean; Recurse: Boolean);
  3053. var
  3054.   Flag: Integer;
  3055.   Node: TTreeNode;
  3056. begin
  3057.   if Recurse then
  3058.   begin
  3059.     Node := Self;
  3060.     repeat
  3061.       Node.ExpandItem(Expand, False);
  3062.       Node := Node.GetNext;
  3063.     until (Node = nil) or not Node.HasAsParent(Self);
  3064.   end
  3065.   else begin
  3066.     if Expand then Flag := TVE_EXPAND
  3067.     else Flag := TVE_COLLAPSE;
  3068.     TreeView_Expand(Handle, ItemId, Flag);
  3069.   end;
  3070. end;
  3071.  
  3072. procedure TTreeNode.Expand(Recurse: Boolean);
  3073. begin
  3074.   ExpandItem(True, Recurse);
  3075. end;
  3076.  
  3077. procedure TTreeNode.Collapse(Recurse: Boolean);
  3078. begin
  3079.   ExpandItem(False, Recurse);
  3080. end;
  3081.  
  3082. function TTreeNode.GetExpanded: Boolean;
  3083. begin
  3084.   Result := GetState(nsExpanded);
  3085. end;
  3086.  
  3087. procedure TTreeNode.SetExpanded(Value: Boolean);
  3088. begin
  3089.   if Value then Expand(False)
  3090.   else Collapse(False);
  3091. end;
  3092.  
  3093. function TTreeNode.GetSelected: Boolean;
  3094. begin
  3095.   Result := GetState(nsSelected);
  3096. end;
  3097.  
  3098. procedure TTreeNode.SetSelected(Value: Boolean);
  3099. begin
  3100.   if Value then TreeView_SelectItem(Handle, ItemId)
  3101.   else if Selected then TreeView_SelectItem(Handle, nil);
  3102. end;
  3103.  
  3104. function TTreeNode.GetCut: Boolean;
  3105. begin
  3106.   Result := GetState(nsCut);
  3107. end;
  3108.  
  3109. procedure TTreeNode.SetCut(Value: Boolean);
  3110. var
  3111.   Item: TTVItem;
  3112.   Template: Integer;
  3113. begin
  3114.   if Value then Template := -1
  3115.   else Template := 0;
  3116.   with Item do
  3117.   begin
  3118.     mask := TVIF_STATE;
  3119.     hItem := ItemId;
  3120.     stateMask := TVIS_CUT;
  3121.     state := stateMask and Template;
  3122.   end;
  3123.   TreeView_SetItem(Handle, Item);
  3124. end;
  3125.  
  3126. function TTreeNode.GetDropTarget: Boolean;
  3127. begin
  3128.   Result := GetState(nsDropHilited);
  3129. end;
  3130.  
  3131. procedure TTreeNode.SetDropTarget(Value: Boolean);
  3132. begin
  3133.   if Value then TreeView_SelectDropTarget(Handle, ItemId)
  3134.   else if DropTarget then TreeView_SelectDropTarget(Handle, nil);
  3135. end;
  3136.  
  3137. function TTreeNode.GetChildren: Boolean;
  3138. var
  3139.   Item: TTVItem;
  3140. begin
  3141.   Item.mask := TVIF_CHILDREN;
  3142.   Item.hItem := ItemId;
  3143.   if TreeView_GetItem(Handle, Item) then Result := Item.cChildren > 0
  3144.   else Result := False;
  3145. end;
  3146.  
  3147. procedure TTreeNode.SetFocused(Value: Boolean);
  3148. var
  3149.   Item: TTVItem;
  3150.   Template: Integer;
  3151. begin
  3152.   if Value then Template := -1
  3153.   else Template := 0;
  3154.   with Item do
  3155.   begin
  3156.     mask := TVIF_STATE;
  3157.     hItem := ItemId;
  3158.     stateMask := TVIS_FOCUSED;
  3159.     state := stateMask and Template;
  3160.   end;
  3161.   TreeView_SetItem(Handle, Item);
  3162. end;
  3163.  
  3164. function TTreeNode.GetFocused: Boolean;
  3165. begin
  3166.   Result := GetState(nsFocused);
  3167. end;
  3168.  
  3169. procedure TTreeNode.SetChildren(Value: Boolean);
  3170. var
  3171.   Item: TTVItem;
  3172. begin
  3173.   with Item do
  3174.   begin
  3175.     mask := TVIF_CHILDREN;
  3176.     hItem := ItemId;
  3177.     cChildren := Ord(Value);
  3178.   end;
  3179.   TreeView_SetItem(Handle, Item);
  3180. end;
  3181.  
  3182. function TTreeNode.GetParent: TTreeNode;
  3183. begin
  3184.   with FOwner do
  3185.     Result := GetNode(TreeView_GetParent(Handle, ItemId));
  3186. end;
  3187.  
  3188. function TTreeNode.GetNextSibling: TTreeNode;
  3189. begin
  3190.   with FOwner do
  3191.     Result := GetNode(TreeView_GetNextSibling(Handle, ItemId));
  3192. end;
  3193.  
  3194. function TTreeNode.GetPrevSibling: TTreeNode;
  3195. begin
  3196.   with FOwner do
  3197.     Result := GetNode(TreeView_GetPrevSibling(Handle, ItemId));
  3198. end;
  3199.  
  3200. function TTreeNode.GetNextVisible: TTreeNode;
  3201. begin
  3202.   if IsVisible then
  3203.     with FOwner do
  3204.       Result := GetNode(TreeView_GetNextVisible(Handle, ItemId))
  3205.   else Result := nil;
  3206. end;
  3207.  
  3208. function TTreeNode.GetPrevVisible: TTreeNode;
  3209. begin
  3210.   with FOwner do
  3211.     Result := GetNode(TreeView_GetPrevVisible(Handle, ItemId));
  3212. end;
  3213.  
  3214. function TTreeNode.GetNextChild(Value: TTreeNode): TTreeNode;
  3215. begin
  3216.   if Value <> nil then Result := Value.GetNextSibling
  3217.   else Result := nil;
  3218. end;
  3219.  
  3220. function TTreeNode.GetPrevChild(Value: TTreeNode): TTreeNode;
  3221. begin
  3222.   if Value <> nil then Result := Value.GetPrevSibling
  3223.   else Result := nil;
  3224. end;
  3225.  
  3226. function TTreeNode.GetFirstChild: TTreeNode;
  3227. begin
  3228.   with FOwner do
  3229.     Result := GetNode(TreeView_GetChild(Handle, ItemId));
  3230. end;
  3231.  
  3232. function TTreeNode.GetLastChild: TTreeNode;
  3233. var
  3234.   Node: TTreeNode;
  3235. begin
  3236.   Result := GetFirstChild;
  3237.   if Result <> nil then
  3238.   begin
  3239.     Node := Result;
  3240.     repeat
  3241.       Result := Node;
  3242.       Node := Result.GetNextSibling;
  3243.     until Node = nil;
  3244.   end;
  3245. end;
  3246.  
  3247. function TTreeNode.GetNext: TTreeNode;
  3248. var
  3249.   NodeID, ParentID: HTreeItem;
  3250.   Handle: HWND;
  3251. begin
  3252.   Handle := FOwner.Handle;
  3253.   NodeID := TreeView_GetChild(Handle, ItemId);
  3254.   if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId);
  3255.   ParentID := ItemId;
  3256.   while (NodeID = nil) and (ParentID <> nil) do
  3257.   begin
  3258.     ParentID := TreeView_GetParent(Handle, ParentID);
  3259.     NodeID := TreeView_GetNextSibling(Handle, ParentID);
  3260.   end;
  3261.   Result := FOwner.GetNode(NodeID);
  3262. end;
  3263.  
  3264. function TTreeNode.GetPrev: TTreeNode;
  3265. var
  3266.   Node: TTreeNode;
  3267. begin
  3268.   Result := GetPrevSibling;
  3269.   if Result <> nil then
  3270.   begin
  3271.     Node := Result;
  3272.     repeat
  3273.       Result := Node;
  3274.       Node := Result.GetLastChild;
  3275.     until Node = nil;
  3276.   end else
  3277.     Result := Parent;
  3278. end;
  3279.  
  3280. function TTreeNode.GetAbsoluteIndex: Integer;
  3281. var
  3282.   Node: TTreeNode;
  3283. begin
  3284.   Result := -1;
  3285.   Node := Self;
  3286.   while Node <> nil do
  3287.   begin
  3288.     Inc(Result);
  3289.     Node := Node.GetPrev;
  3290.   end;
  3291. end;
  3292.  
  3293. function TTreeNode.GetIndex: Integer;
  3294. var
  3295.   Node: TTreeNode;
  3296. begin
  3297.   Result := -1;
  3298.   Node := Self;
  3299.   while Node <> nil do
  3300.   begin
  3301.     Inc(Result);
  3302.     Node := Node.GetPrevSibling;
  3303.   end;
  3304. end;
  3305.  
  3306. function TTreeNode.GetItem(Index: Integer): TTreeNode;
  3307. begin
  3308.   Result := GetFirstChild;
  3309.   while (Result <> nil) and (Index > 0) do
  3310.   begin
  3311.     Result := GetNextChild(Result);
  3312.     Dec(Index);
  3313.   end;
  3314.   if Result = nil then TreeViewError(SListIndexError);
  3315. end;
  3316.  
  3317. procedure TTreeNode.SetItem(Index: Integer; Value: TTreeNode);
  3318. begin
  3319.   item[Index].Assign(Value);
  3320. end;
  3321.  
  3322. function TTreeNode.IndexOf(Value: TTreeNode): Integer;
  3323. var
  3324.   Node: TTreeNode;
  3325. begin
  3326.   Result := -1;
  3327.   Node := GetFirstChild;
  3328.   while (Node <> nil) do
  3329.   begin
  3330.     Inc(Result);
  3331.     if Node = Value then Break;
  3332.     Node := GetNextChild(Node);
  3333.   end;
  3334.   if Node = nil then Result := -1;
  3335. end;
  3336.  
  3337. function TTreeNode.GetCount: Integer;
  3338. var
  3339.   Node: TTreeNode;
  3340. begin
  3341.   Result := 0;
  3342.   Node := GetFirstChild;
  3343.   while Node <> nil do
  3344.   begin
  3345.     Inc(Result);
  3346.     Node := Node.GetNextChild(Node);
  3347.   end;
  3348. end;
  3349.  
  3350. procedure TTreeNode.EndEdit(Cancel: Boolean);
  3351. begin
  3352.   TreeView_EndEditLabelNow(Handle, Cancel);
  3353. end;
  3354.  
  3355. procedure TTreeNode.InternalMove(ParentNode, Node: TTreeNode;
  3356.   HItem: HTreeItem; AddMode: TAddMode);
  3357. var
  3358.   I: Integer;
  3359.   NodeId: HTreeItem;
  3360.   TreeViewItem: TTVItem;
  3361.   Children: Boolean;
  3362.   IsSelected: Boolean;
  3363. begin
  3364.   if (AddMode = taInsert) and (Node <> nil) then
  3365.     NodeId := Node.ItemId else
  3366.     NodeId := nil;
  3367.   Children := HasChildren;
  3368.   IsSelected := Selected;
  3369.   if (Parent <> nil) and (Parent.Count = 1) then
  3370.   begin
  3371.     Parent.Expanded := False;
  3372.     Parent.HasChildren := False;
  3373.   end;
  3374.   with TreeViewItem do
  3375.   begin
  3376.     mask := TVIF_PARAM;
  3377.     hItem := ItemId;
  3378.     lParam := 0;
  3379.   end;
  3380.   TreeView_SetItem(Handle, TreeViewItem);
  3381.   with Owner do
  3382.     HItem := AddItem(HItem, NodeId, CreateItem(Self), AddMode);
  3383.   if HItem = nil then
  3384.     raise EOutOfResources.CreateRes(sInsertError);
  3385.   for I := Count - 1 downto 0 do
  3386.     Item[I].InternalMove(Self, nil, HItem, taAddFirst);
  3387.   TreeView_DeleteItem(Handle, ItemId);
  3388.   FItemId := HItem;
  3389.   Assign(Self);
  3390.   HasChildren := Children;
  3391.   Selected := IsSelected;
  3392. end;
  3393.  
  3394. procedure TTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
  3395. var
  3396.   AddMode: TAddMode;
  3397.   Node: TTreeNode;
  3398.   HItem: HTreeItem;
  3399.   OldOnChanging: TTVChangingEvent;
  3400.   OldOnChange: TTVChangedEvent;
  3401. begin
  3402.   OldOnChanging := TreeView.OnChanging;
  3403.   OldOnChange := TreeView.OnChange;
  3404.   TreeView.OnChanging := nil;
  3405.   TreeView.OnChange := nil;
  3406.   try
  3407.     if (Destination = nil) or not Destination.HasAsParent(Self) then
  3408.     begin
  3409.       AddMode := taAdd;
  3410.       if (Destination <> nil) and not (Mode in [naAddChild, naAddChildFirst]) then
  3411.         Node := Destination.Parent else
  3412.         Node := Destination;
  3413.       case Mode of
  3414.         naAdd,
  3415.         naAddChild: AddMode := taAdd;
  3416.         naAddFirst,
  3417.         naAddChildFirst: AddMode := taAddFirst;
  3418.         naInsert:
  3419.           begin
  3420.             Destination := Destination.GetPrevSibling;
  3421.             if Destination = nil then AddMode := taAddFirst
  3422.             else AddMode := taInsert;
  3423.           end;
  3424.       end;
  3425.       if Node <> nil then
  3426.         HItem := Node.ItemId else
  3427.         HItem := nil;
  3428.       InternalMove(Node, Destination, HItem, AddMode);
  3429.       Node := Parent;
  3430.       if Node <> nil then
  3431.       begin
  3432.         Node.HasChildren := True;
  3433.         Node.Expanded := True;
  3434.       end;
  3435.     end;
  3436.   finally
  3437.     TreeView.OnChanging := OldOnChanging;
  3438.     TreeView.OnChange := OldOnChange;
  3439.   end;
  3440. end;
  3441.  
  3442. procedure TTreeNode.MakeVisible;
  3443. begin
  3444.   TreeView_EnsureVisible(Handle, ItemId);
  3445. end;
  3446.  
  3447. function TTreeNode.GetLevel: Integer;
  3448. var
  3449.   Node: TTreeNode;
  3450. begin
  3451.   Result := 0;
  3452.   Node := Parent;
  3453.   while Node <> nil do
  3454.   begin
  3455.     Inc(Result);
  3456.     Node := Node.Parent;
  3457.   end;
  3458. end;
  3459.  
  3460. function TTreeNode.IsNodeVisible: Boolean;
  3461. var
  3462.   Rect: TRect;
  3463. begin
  3464.   Result := TreeView_GetItemRect(Handle, ItemId, Rect, True);
  3465. end;
  3466.  
  3467. function TTreeNode.HasVisibleParent: Boolean;
  3468. begin
  3469.   Result := (Parent <> nil) and (Parent.Expanded);
  3470. end;
  3471.  
  3472. function TTreeNode.EditText: Boolean;
  3473. begin
  3474.   Result := TreeView_EditLabel(Handle, ItemId) <> 0;
  3475. end;
  3476.  
  3477. function TTreeNode.DisplayRect(TextOnly: Boolean): TRect;
  3478. begin
  3479.   FillChar(Result, SizeOf(Result), 0);
  3480.   TreeView_GetItemRect(Handle, ItemId, Result, TextOnly);
  3481. end;
  3482.  
  3483. function TTreeNode.AlphaSort: Boolean;
  3484. begin
  3485.   Result := CustomSort(nil, 0);
  3486. end;
  3487.  
  3488. function TTreeNode.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  3489. var
  3490.   SortCB: TTVSortCB;
  3491. begin
  3492.   with SortCB do
  3493.   begin
  3494.     if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  3495.     else lpfnCompare := SortProc;
  3496.     hParent := ItemId;
  3497.     lParam := Data;
  3498.   end;
  3499.   Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  3500. end;
  3501.  
  3502. procedure TTreeNode.Delete;
  3503. begin
  3504.   if not Deleting then Free;
  3505. end;
  3506.  
  3507. procedure TTreeNode.DeleteChildren;
  3508. var
  3509.   Node: TTreeNode;
  3510. begin
  3511.   repeat
  3512.     Node := GetFirstChild;
  3513.     if Node <> nil then Node.Delete;
  3514.   until Node = nil;
  3515. end;
  3516.  
  3517. procedure TTreeNode.Assign(Source: TPersistent);
  3518. var
  3519.   Node: TTreeNode;
  3520. begin
  3521.   if Source is TTreeNode then
  3522.   begin
  3523.     Node := TTreeNode(Source);
  3524.     Text := Node.Text;
  3525.     Data := Node.Data;
  3526.     ImageIndex := Node.ImageIndex;
  3527.     SelectedIndex := Node.SelectedIndex;
  3528.     StateIndex := Node.StateIndex;
  3529.     OverlayIndex := Node.OverlayIndex;
  3530.     Focused := Node.Focused;
  3531.     DropTarget := Node.DropTarget;
  3532.     Cut := Node.Cut;
  3533.     HasChildren := Node.HasChildren;
  3534.   end
  3535.   else inherited Assign(Source);
  3536. end;
  3537.  
  3538. function TTreeNode.IsEqual(Node: TTreeNode): Boolean;
  3539. begin
  3540.   Result := (Text = Node.Text) and (Data = Node.Data);
  3541. end;
  3542.  
  3543. procedure TTreeNode.ReadData(Stream: TStream; Info: PNodeInfo);
  3544. var
  3545.   I, Size, ItemCount: Integer;
  3546. begin
  3547.   Stream.ReadBuffer(Size, SizeOf(Size));
  3548.   Stream.ReadBuffer(Info^, Size);
  3549.   Text := Info^.Text;
  3550.   ImageIndex := Info^.ImageIndex;
  3551.   SelectedIndex := Info^.SelectedIndex;
  3552.   StateIndex := Info^.StateIndex;
  3553.   OverlayIndex := Info^.OverlayIndex;
  3554.   Data := Info^.Data;
  3555.   ItemCount := Info^.Count;
  3556.   for I := 0 to ItemCount - 1 do
  3557.     with Owner.AddChild(Self, '') do ReadData(Stream, Info);
  3558. end;
  3559.  
  3560. procedure TTreeNode.WriteData(Stream: TStream; Info: PNodeInfo);
  3561. var
  3562.   I, Size, L, ItemCount: Integer;
  3563. begin
  3564.   L := Length(Text);
  3565.   if L > 255 then L := 255;
  3566.   Size := SizeOf(TNodeInfo) + L - 255;
  3567.   Info^.Text := Text;
  3568.   Info^.ImageIndex := ImageIndex;
  3569.   Info^.SelectedIndex := SelectedIndex;
  3570.   Info^.OverlayIndex := OverlayIndex;
  3571.   Info^.StateIndex := StateIndex;
  3572.   Info^.Data := Data;
  3573.   ItemCount := Count;
  3574.   Info^.Count := ItemCount;
  3575.   Stream.WriteBuffer(Size, SizeOf(Size));
  3576.   Stream.WriteBuffer(Info^, Size);
  3577.   for I := 0 to ItemCount - 1 do Item[I].WriteData(Stream, Info);
  3578. end;
  3579.  
  3580. { TTreeNodes }
  3581.  
  3582. constructor TTreeNodes.Create(AOwner: TCustomTreeView);
  3583. begin
  3584.   inherited Create;
  3585.   FOwner := AOwner;
  3586. end;
  3587.  
  3588. destructor TTreeNodes.Destroy;
  3589. begin
  3590.   Clear;
  3591.   inherited Destroy;
  3592. end;
  3593.  
  3594. function TTreeNodes.GetCount: Integer;
  3595. begin
  3596.   if Owner.HandleAllocated then Result := TreeView_GetCount(Handle)
  3597.   else Result := 0;
  3598. end;
  3599.  
  3600. function TTreeNodes.GetHandle: HWND;
  3601. begin
  3602.   Result := Owner.Handle;
  3603. end;
  3604.  
  3605. procedure TTreeNodes.Delete(Node: TTreeNode);
  3606. begin
  3607.   if (Node.ItemId = nil) and Assigned(Owner.FOnDeletion) then
  3608.     Owner.FOnDeletion(Self, Node);
  3609.   Node.Delete;
  3610. end;
  3611.  
  3612. procedure TTreeNodes.Clear;
  3613. begin
  3614.   if Owner.HandleAllocated then
  3615.     TreeView_DeleteAllItems(Handle);
  3616. end;
  3617.  
  3618. function TTreeNodes.AddChildFirst(Node: TTreeNode; const S: string): TTreeNode;
  3619. begin
  3620.   Result := AddChildObjectFirst(Node, S, nil);
  3621. end;
  3622.  
  3623. function TTreeNodes.AddChildObjectFirst(Node: TTreeNode; const S: string;
  3624.   Ptr: Pointer): TTreeNode;
  3625. begin
  3626.   Result := InternalAddObject(Node, S, Ptr, taAddFirst);
  3627. end;
  3628.  
  3629. function TTreeNodes.AddChild(Node: TTreeNode; const S: string): TTreeNode;
  3630. begin
  3631.   Result := AddChildObject(Node, S, nil);
  3632. end;
  3633.  
  3634. function TTreeNodes.AddChildObject(Node: TTreeNode; const S: string;
  3635.   Ptr: Pointer): TTreeNode;
  3636. begin
  3637.   Result := InternalAddObject(Node, S, Ptr, taAdd);
  3638. end;
  3639.  
  3640. function TTreeNodes.AddFirst(Node: TTreeNode; const S: string): TTreeNode;
  3641. begin
  3642.   Result := AddObjectFirst(Node, S, nil);
  3643. end;
  3644.  
  3645. function TTreeNodes.AddObjectFirst(Node: TTreeNode; const S: string;
  3646.   Ptr: Pointer): TTreeNode;
  3647. begin
  3648.   if Node <> nil then Node := Node.Parent;
  3649.   Result := InternalAddObject(Node, S, Ptr, taAddFirst);
  3650. end;
  3651.  
  3652. function TTreeNodes.Add(Node: TTreeNode; const S: string): TTreeNode;
  3653. begin
  3654.   Result := AddObject(Node, S, nil);
  3655. end;
  3656.  
  3657. procedure TTreeNodes.Repaint(Node: TTreeNode);
  3658. var
  3659.   R: TRect;
  3660. begin
  3661.   while (Node <> nil) and not Node.IsVisible do Node := Node.Parent;
  3662.   if Node <> nil then
  3663.   begin
  3664.     R := Node.DisplayRect(False);
  3665.     InvalidateRect(Owner.Handle, @R, True);
  3666.   end;
  3667. end;
  3668.  
  3669. function TTreeNodes.AddObject(Node: TTreeNode; const S: string;
  3670.   Ptr: Pointer): TTreeNode;
  3671. begin
  3672.   if Node <> nil then Node := Node.Parent;
  3673.   Result := InternalAddObject(Node, S, Ptr, taAdd);
  3674. end;
  3675.  
  3676. function TTreeNodes.Insert(Node: TTreeNode; const S: string): TTreeNode;
  3677. begin
  3678.   Result := InsertObject(Node, S, nil);
  3679. end;
  3680.  
  3681. procedure TTreeNodes.AddedNode(Value: TTreeNode);
  3682. begin
  3683.   Value := Value.Parent;
  3684.   if Value <> nil then
  3685.   begin
  3686.     Value.HasChildren := True;
  3687.     Repaint(Value);
  3688.   end;
  3689. end;
  3690.  
  3691. function TTreeNodes.InsertObject(Node: TTreeNode; const S: string;
  3692.   Ptr: Pointer): TTreeNode;
  3693. var
  3694.   Item, ItemId: HTreeItem;
  3695.   Parent: TTreeNode;
  3696.   AddMode: TAddMode;
  3697. begin
  3698.   Result := Owner.CreateNode;
  3699.   try
  3700.     Item := nil;
  3701.     ItemId := nil;
  3702.     AddMode := taInsert;
  3703.     if Node <> nil then
  3704.     begin
  3705.       Parent := Node.Parent;
  3706.       if Parent <> nil then Item := Parent.ItemId;
  3707.       Node := Node.GetPrevSibling;
  3708.       if Node <> nil then ItemId := Node.ItemId
  3709.       else AddMode := taAddFirst;
  3710.     end;
  3711.     Result.Data := Ptr;
  3712.     Result.Text := S;
  3713.     Item := AddItem(Item, ItemId, CreateItem(Result), AddMode);
  3714.     if Item = nil then
  3715.       raise EOutOfResources.CreateRes(sInsertError);
  3716.     Result.FItemId := Item;
  3717.     AddedNode(Result);
  3718.   except
  3719.     Result.Free;
  3720.     raise;
  3721.   end;
  3722. end;
  3723.  
  3724. function TTreeNodes.InternalAddObject(Node: TTreeNode; const S: string;
  3725.   Ptr: Pointer; AddMode: TAddMode): TTreeNode;
  3726. var
  3727.   Item: HTreeItem;
  3728. begin
  3729.   Result := Owner.CreateNode;
  3730.   try
  3731.     if Node <> nil then Item := Node.ItemId
  3732.     else Item := nil;
  3733.     Result.Data := Ptr;
  3734.     Result.Text := S;
  3735.     Item := AddItem(Item, nil, CreateItem(Result), AddMode);
  3736.     if Item = nil then
  3737.       raise EOutOfResources.CreateRes(sInsertError);
  3738.     Result.FItemId := Item;
  3739.     AddedNode(Result);
  3740.   except
  3741.     Result.Free;
  3742.     raise;
  3743.   end;
  3744. end;
  3745.  
  3746. function TTreeNodes.CreateItem(Node: TTreeNode): TTVItem;
  3747. begin
  3748.   with Result do
  3749.   begin
  3750.     mask := TVIF_TEXT or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE;
  3751.     lParam := Longint(Node);
  3752.     pszText := LPSTR_TEXTCALLBACK;
  3753.     iImage := I_IMAGECALLBACK;
  3754.     iSelectedImage := I_IMAGECALLBACK;
  3755.   end;
  3756. end;
  3757.  
  3758. function TTreeNodes.AddItem(Parent, Target: HTreeItem;
  3759.   const Item: TTVItem; AddMode: TAddMode): HTreeItem;
  3760. var
  3761.   InsertStruct: TTVInsertStruct;
  3762. begin
  3763.   with InsertStruct do
  3764.   begin
  3765.     hParent := Parent;
  3766.     case AddMode of
  3767.       taAddFirst:
  3768.         hInsertAfter := TVI_FIRST;
  3769.       taAdd:
  3770.         hInsertAfter := TVI_LAST;
  3771.       taInsert:
  3772.         hInsertAfter := Target;
  3773.     end;
  3774.   end;
  3775.   InsertStruct.item := Item;
  3776.   Result := TreeView_InsertItem(Handle, InsertStruct);
  3777. end;
  3778.  
  3779. function TTreeNodes.GetFirstNode: TTreeNode;
  3780. begin
  3781.   Result := GetNode(TreeView_GetRoot(Handle));
  3782. end;
  3783.  
  3784. function TTreeNodes.GetNodeFromIndex(Index: Integer): TTreeNode;
  3785. begin
  3786.   Result := GetFirstNode;
  3787.   while (Index <> 0) and (Result <> nil) do
  3788.   begin
  3789.     Result := Result.GetNext;
  3790.     Dec(Index);
  3791.   end;
  3792.   if Result = nil then TreeViewError(sInvalidIndex);
  3793. end;
  3794.  
  3795. function TTreeNodes.GetNode(ItemId: HTreeItem): TTreeNode;
  3796. var
  3797.   Item: TTVItem;
  3798. begin
  3799.   with Item do
  3800.   begin
  3801.     hItem := ItemId;
  3802.     mask := TVIF_PARAM;
  3803.   end;
  3804.   if TreeView_GetItem(Handle, Item) then Result := TTreeNode(Item.lParam)
  3805.   else Result := nil;
  3806. end;
  3807.  
  3808. procedure TTreeNodes.SetItem(Index: Integer; Value: TTreeNode);
  3809. begin
  3810.   GetNodeFromIndex(Index).Assign(Value);
  3811. end;
  3812.  
  3813. procedure TTreeNodes.BeginUpdate;
  3814. begin
  3815.   if FUpdateCount = 0 then SetUpdateState(True);
  3816.   Inc(FUpdateCount);
  3817. end;
  3818.  
  3819. procedure TTreeNodes.SetUpdateState(Updating: Boolean);
  3820. begin
  3821.   SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3822.   if not Updating then Owner.Refresh;
  3823. end;
  3824.  
  3825. procedure TTreeNodes.EndUpdate;
  3826. begin
  3827.   Dec(FUpdateCount);
  3828.   if FUpdateCount = 0 then SetUpdateState(False);
  3829. end;
  3830.  
  3831. procedure TTreeNodes.Assign(Source: TPersistent);
  3832. var
  3833.   TreeNodes: TTreeNodes;
  3834.   MemStream: TMemoryStream;
  3835. begin
  3836.   if Source is TTreeNodes then
  3837.   begin
  3838.     TreeNodes := TTreeNodes(Source);
  3839.     Clear;
  3840.     MemStream := TMemoryStream.Create;
  3841.     try
  3842.       TreeNodes.WriteData(MemStream);
  3843.       MemStream.Position := 0;
  3844.       ReadData(MemStream);
  3845.     finally
  3846.       MemStream.Free;
  3847.     end;
  3848.   end
  3849.   else inherited Assign(Source);
  3850. end;
  3851.  
  3852. procedure TTreeNodes.DefineProperties(Filer: TFiler);
  3853.  
  3854.   function WriteNodes: Boolean;
  3855.   var
  3856.     I: Integer;
  3857.     Nodes: TTreeNodes;
  3858.   begin
  3859.     Nodes := TTreeNodes(Filer.Ancestor);
  3860.     if (Nodes <> nil) and (Nodes.Count = Count) then
  3861.       for I := 0 to Count - 1 do
  3862.       begin
  3863.         Result := not Item[I].IsEqual(Nodes[I]);
  3864.         if Result then Break;
  3865.       end
  3866.     else Result := Count > 0;
  3867.   end;
  3868.  
  3869. begin
  3870.   inherited DefineProperties(Filer);
  3871.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteNodes);
  3872. end;
  3873.  
  3874. procedure TTreeNodes.ReadData(Stream: TStream);
  3875. var
  3876.   I, Count: Integer;
  3877.   NodeInfo: TNodeInfo;
  3878. begin
  3879.   Clear;
  3880.   Stream.ReadBuffer(Count, SizeOf(Count));
  3881.   for I := 0 to Count - 1 do
  3882.     Add(nil, '').ReadData(Stream, @NodeInfo);
  3883. end;
  3884.  
  3885. procedure TTreeNodes.WriteData(Stream: TStream);
  3886. var
  3887.   I: Integer;
  3888.   Node: TTreeNode;
  3889.   NodeInfo: TNodeInfo;
  3890. begin
  3891.   I := 0;
  3892.   Node := GetFirstNode;
  3893.   while Node <> nil do
  3894.   begin
  3895.     Inc(I);
  3896.     Node := Node.GetNextSibling;
  3897.   end;
  3898.   Stream.WriteBuffer(I, SizeOf(I));
  3899.   Node := GetFirstNode;
  3900.   while Node <> nil do
  3901.   begin
  3902.     Node.WriteData(Stream, @NodeInfo);
  3903.     Node := Node.GetNextSibling;
  3904.   end;
  3905. end;
  3906.  
  3907. type
  3908.   TTreeStrings = class(TStrings)
  3909.   private
  3910.     FOwner: TTreeNodes;
  3911.   protected
  3912.     function Get(Index: Integer): string; override;
  3913.     function GetCount: Integer; override;
  3914.     function GetObject(Index: Integer): TObject; override;
  3915.     procedure PutObject(Index: Integer; AObject: TObject); override;
  3916.     procedure SetUpdateState(Updating: Boolean); override;
  3917.   public
  3918.     constructor Create(AOwner: TTreeNodes);
  3919.     function Add(const S: string): Integer; override;
  3920.     procedure Clear; override;
  3921.     procedure Delete(Index: Integer); override;
  3922.     procedure Insert(Index: Integer; const S: string); override;
  3923.     property Owner: TTreeNodes read FOwner;
  3924.   end;
  3925.  
  3926. constructor TTreeStrings.Create(AOwner: TTreeNodes);
  3927. begin
  3928.   inherited Create;
  3929.   FOwner := AOwner;
  3930. end;
  3931.  
  3932. function TTreeStrings.Get(Index: Integer): string;
  3933. const
  3934.   TAB = Chr(9);
  3935. var
  3936.   Level, I: Integer;
  3937.   Node: TTreeNode;
  3938. begin
  3939.   Result := '';
  3940.   Node := Owner.GetNodeFromIndex(Index);
  3941.   Level := Node.Level;
  3942.   for I := 0 to Level - 1 do Result := Result + TAB;
  3943.   Result := Result + Node.Text;
  3944. end;
  3945.  
  3946. function TTreeStrings.GetObject(Index: Integer): TObject;
  3947. begin
  3948.   Result := Owner.GetNodeFromIndex(Index).Data;
  3949. end;
  3950.  
  3951. procedure TTreeStrings.PutObject(Index: Integer; AObject: TObject);
  3952. begin
  3953.   Owner.GetNodeFromIndex(Index).Data := AObject;
  3954. end;
  3955.  
  3956. function TTreeStrings.GetCount: Integer;
  3957. begin
  3958.   Result := Owner.Count;
  3959. end;
  3960.  
  3961. procedure TTreeStrings.Clear;
  3962. begin
  3963.   Owner.Clear;
  3964. end;
  3965.  
  3966. procedure TTreeStrings.Delete(Index: Integer);
  3967. begin
  3968.   Owner.GetNodeFromIndex(Index).Delete;
  3969. end;
  3970.  
  3971. procedure TTreeStrings.SetUpdateState(Updating: Boolean);
  3972. begin
  3973.   SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3974.   if not Updating then Owner.Owner.Refresh;
  3975. end;
  3976.  
  3977. function TTreeStrings.Add(const S: string): Integer;
  3978. var
  3979.   Level, OldLevel, I: Integer;
  3980.   NewStr: string;
  3981.   Node: TTreeNode;
  3982.  
  3983.   function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
  3984.   begin
  3985.     Level := 0;
  3986.     while Buffer^ in [' ', #9] do
  3987.     begin
  3988.       Inc(Buffer);
  3989.       Inc(Level);
  3990.     end;
  3991.     Result := Buffer;
  3992.   end;
  3993.  
  3994. begin
  3995.   Result := GetCount;
  3996.   if (Length(S) = 1) and (S[1] = Chr($1A)) then Exit;
  3997.   Node := nil;
  3998.   OldLevel := 0;
  3999.   NewStr := GetBufStart(PChar(S), Level);
  4000.   if Result > 0 then
  4001.   begin
  4002.     Node := Owner.GetNodeFromIndex(Result - 1);
  4003.     OldLevel := Node.Level;
  4004.   end;
  4005.   if (Level > OldLevel) or (Node = nil) then
  4006.   begin
  4007.     if Level - OldLevel > 1 then TreeViewError(sInvalidLevel);
  4008.   end
  4009.   else begin
  4010.     for I := OldLevel downto Level do
  4011.     begin
  4012.       Node := Node.Parent;
  4013.       if (Node = nil) and (I - Level > 0) then
  4014.         TreeViewError(sInvalidLevel);
  4015.     end;
  4016.   end;
  4017.   Owner.AddChild(Node, NewStr);
  4018. end;
  4019.  
  4020. procedure TTreeStrings.Insert(Index: Integer; const S: string);
  4021. begin
  4022.   with Owner do
  4023.     Insert(GetNodeFromIndex(Index), S);
  4024. end;
  4025.  
  4026. { TCustomTreeView }
  4027.  
  4028. constructor TCustomTreeView.Create(AOwner: TComponent);
  4029. begin
  4030.   inherited Create(AOwner);
  4031.   ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage];
  4032.   Width := 121;
  4033.   Height := 97;
  4034.   TabStop := True;
  4035.   ParentColor := False;
  4036.   FTreeNodes := TTreeNodes.Create(Self);
  4037.   FBorderStyle := bsSingle;
  4038.   FShowButtons := True;
  4039.   FShowRoot := True;
  4040.   FShowLines := True;
  4041.   FHideSelection := True;
  4042.   FDragImage := TImageList.CreateSize(32, 32);
  4043.   FSaveIndent := -1;
  4044.   FEditInstance := MakeObjectInstance(EditWndProc);
  4045.   FImageChangeLink := TChangeLink.Create;
  4046.   FImageChangeLink.OnChange := ImageListChange;
  4047.   FStateChangeLink := TChangeLink.Create;
  4048.   FStateChangeLink.OnChange := ImageListChange;
  4049. end;
  4050.  
  4051. destructor TCustomTreeView.Destroy;
  4052. begin
  4053.   Items.Free;
  4054.   FSaveItems.Free;
  4055.   FDragImage.Free;
  4056.   FMemStream.Free;
  4057.   FreeObjectInstance(FEditInstance);
  4058.   FImageChangeLink.Free;
  4059.   FStateChangeLink.Free;
  4060.   inherited Destroy;
  4061. end;
  4062.  
  4063. procedure TCustomTreeView.CreateParams(var Params: TCreateParams);
  4064. const
  4065.   BorderStyles: array[TBorderStyle] of Integer = (0, WS_BORDER);
  4066.   LineStyles: array[Boolean] of Integer = (0, TVS_HASLINES);
  4067.   RootStyles: array[Boolean] of Integer = (0, TVS_LINESATROOT);
  4068.   ButtonStyles: array[Boolean] of Integer = (0, TVS_HASBUTTONS);
  4069.   EditStyles: array[Boolean] of Integer = (TVS_EDITLABELS, 0);
  4070.   HideSelections: array[Boolean] of Integer = (TVS_SHOWSELALWAYS, 0);
  4071.   DragStyles: array[TDragMode] of Integer = (TVS_DISABLEDRAGDROP, 0);
  4072. begin
  4073.   InitCommonControls;
  4074.   inherited CreateParams(Params);
  4075.   CreateSubClass(Params, WC_TREEVIEW);
  4076.   with Params do
  4077.   begin
  4078.     Style := Style or LineStyles[FShowLines] or BorderStyles[FBorderStyle] or
  4079.       RootStyles[FShowRoot] or ButtonStyles[FShowButtons] or
  4080.       EditStyles[FReadOnly] or HideSelections[FHideSelection] or
  4081.       DragStyles[DragMode];
  4082.     if Ctl3D and (FBorderStyle = bsSingle) then
  4083.       ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  4084.   end;
  4085. end;
  4086.  
  4087. procedure TCustomTreeView.CreateWnd;
  4088. begin
  4089.   inherited CreateWnd;
  4090.   if FMemStream <> nil then
  4091.   begin
  4092.     Items.ReadData(FMemStream);
  4093.     FMemStream.Destroy;
  4094.     FMemStream := nil;
  4095.     SetTopItem(Items.GetNodeFromIndex(FSaveTopIndex));
  4096.     FSaveTopIndex := 0;
  4097.     SetSelection(Items.GetNodeFromIndex(FSaveIndex));
  4098.     FSaveIndex := 0;
  4099.   end;
  4100.   if FSaveIndent <> -1 then Indent := FSaveIndent;
  4101.   if (Images <> nil) and Images.HandleAllocated then
  4102.     SetImageList(Images.Handle, TVSIL_NORMAL);
  4103.   if (StateImages <> nil) and StateImages.HandleAllocated then
  4104.     SetImageList(StateImages.Handle, TVSIL_STATE);
  4105. end;
  4106.  
  4107. procedure TCustomTreeView.DestroyWnd;
  4108. var
  4109.   Node: TTreeNode;
  4110. begin
  4111.   if Items.Count > 0 then
  4112.   begin
  4113.     FMemStream := TMemoryStream.Create;
  4114.     Items.WriteData(FMemStream);
  4115.     FMemStream.Position := 0;
  4116.     Node := GetTopItem;
  4117.     if Node <> nil then FSaveTopIndex := Node.AbsoluteIndex;
  4118.     Node := Selected;
  4119.     if Node <> nil then FSaveIndex := Node.AbsoluteIndex;
  4120.   end;
  4121.   FSaveIndent := Indent;
  4122.   inherited DestroyWnd;
  4123. end;
  4124.  
  4125. procedure TCustomTreeView.EditWndProc(var Message: TMessage);
  4126. begin
  4127.   try
  4128.     with Message do
  4129.     begin
  4130.       case Msg of
  4131.         WM_KEYDOWN,
  4132.         WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
  4133.         WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit;
  4134.         WM_KEYUP,
  4135.         WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
  4136.         CN_KEYDOWN,
  4137.         CN_CHAR, CN_SYSKEYDOWN,
  4138.         CN_SYSCHAR:
  4139.           begin
  4140.             WndProc(Message);
  4141.             Exit;
  4142.           end;
  4143.       end;
  4144.       Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam);
  4145.     end;
  4146.   except
  4147.     Application.HandleException(Self);
  4148.   end;
  4149. end;
  4150.  
  4151. procedure TCustomTreeView.CMColorChanged(var Message: TMessage);
  4152. begin
  4153.   inherited;
  4154.   RecreateWnd;
  4155. end;
  4156.  
  4157. procedure TCustomTreeView.CMCtl3DChanged(var Message: TMessage);
  4158. begin
  4159.   inherited;
  4160.   if FBorderStyle = bsSingle then RecreateWnd;
  4161. end;
  4162.  
  4163. function TCustomTreeView.AlphaSort: Boolean;
  4164. var
  4165.   I: Integer;
  4166. begin
  4167.   if HandleAllocated then
  4168.   begin
  4169.     Result := CustomSort(nil, 0);
  4170.     for I := 0 to Items.Count - 1 do
  4171.       with Items[I] do
  4172.         if HasChildren then AlphaSort;
  4173.   end
  4174.   else Result := False;
  4175. end;
  4176.  
  4177. function TCustomTreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  4178. var
  4179.   SortCB: TTVSortCB;
  4180.   I: Integer;
  4181.   Node: TTreeNode;
  4182. begin
  4183.   Result := False;
  4184.   if HandleAllocated then
  4185.   begin
  4186.     with SortCB do
  4187.     begin
  4188.       if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  4189.       else lpfnCompare := SortProc;
  4190.       hParent := TVI_ROOT;
  4191.       lParam := Data;
  4192.       Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  4193.     end;
  4194.     for I := 0 to Items.Count - 1 do
  4195.     begin
  4196.       Node := Items[I];
  4197.       if Node.HasChildren then Node.CustomSort(SortProc, Data);
  4198.     end;
  4199.   end;
  4200. end;
  4201.  
  4202. procedure TCustomTreeView.SetSortType(Value: TSortType);
  4203. begin
  4204.   if SortType <> Value then
  4205.   begin
  4206.     FSortType := Value;
  4207.     if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
  4208.       (SortType in [stText, stBoth]) then
  4209.       AlphaSort;
  4210.   end;
  4211. end;
  4212.  
  4213. procedure TCustomTreeView.SetStyle(Value: Integer; UseStyle: Boolean);
  4214. var
  4215.   Style: Integer;
  4216. begin
  4217.   if HandleAllocated then
  4218.   begin
  4219.     Style := GetWindowLong(Handle, GWL_STYLE);
  4220.     if not UseStyle then Style := Style and not Value
  4221.     else Style := Style or Value;
  4222.     SetWindowLong(Handle, GWL_STYLE, Style);
  4223.   end;
  4224. end;
  4225.  
  4226. procedure TCustomTreeView.SetBorderStyle(Value: TBorderStyle);
  4227. begin
  4228.   if BorderStyle <> Value then
  4229.   begin
  4230.     FBorderStyle := Value;
  4231.     RecreateWnd;
  4232.   end;
  4233. end;
  4234.  
  4235. procedure TCustomTreeView.SetDragMode(Value: TDragMode);
  4236. begin
  4237.   if Value <> DragMode then
  4238.     SetStyle(TVS_DISABLEDRAGDROP, Value = dmManual);
  4239.   inherited;
  4240. end;
  4241.  
  4242. procedure TCustomTreeView.SetButtonStyle(Value: Boolean);
  4243. begin
  4244.   if ShowButtons <> Value then
  4245.   begin
  4246.     FShowButtons := Value;
  4247.     SetStyle(TVS_HASBUTTONS, Value);
  4248.   end;
  4249. end;
  4250.  
  4251. procedure TCustomTreeView.SetLineStyle(Value: Boolean);
  4252. begin
  4253.   if ShowLines <> Value then
  4254.   begin
  4255.     FShowLines := Value;
  4256.     SetStyle(TVS_HASLINES, Value);
  4257.   end;
  4258. end;
  4259.  
  4260. procedure TCustomTreeView.SetRootStyle(Value: Boolean);
  4261. begin
  4262.   if ShowRoot <> Value then
  4263.   begin
  4264.     FShowRoot := Value;
  4265.     SetStyle(TVS_LINESATROOT, Value);
  4266.   end;
  4267. end;
  4268.  
  4269. procedure TCustomTreeView.SetReadOnly(Value: Boolean);
  4270. begin
  4271.   if ReadOnly <> Value then
  4272.   begin
  4273.     FReadOnly := Value;
  4274.     SetStyle(TVS_EDITLABELS, not Value);
  4275.   end;
  4276. end;
  4277.  
  4278. procedure TCustomTreeView.SetHideSelection(Value: Boolean);
  4279. begin
  4280.   if HideSelection <> Value then
  4281.   begin
  4282.     FHideSelection := Value;
  4283.     SetStyle(TVS_SHOWSELALWAYS, not Value);
  4284.   end;
  4285. end;
  4286.  
  4287. function TCustomTreeView.GetNodeAt(X, Y: Integer): TTreeNode;
  4288. var
  4289.   HitTest: TTVHitTestInfo;
  4290. begin
  4291.   with HitTest do
  4292.   begin
  4293.     pt.X := X;
  4294.     pt.Y := Y;
  4295.     if TreeView_HitTest(Handle, HitTest) <> nil then
  4296.       Result := Items.GetNode(HitTest.hItem)
  4297.     else Result := nil;
  4298.   end;
  4299. end;
  4300.  
  4301. function TCustomTreeView.GetHitTestInfoAt(X, Y: Integer): THitTests;
  4302. var
  4303.   HitTest: TTVHitTestInfo;
  4304. begin
  4305.   Result := [];
  4306.   with HitTest do
  4307.   begin
  4308.     pt.X := X;
  4309.     pt.Y := Y;
  4310.     TreeView_HitTest(Handle, HitTest);
  4311.     if (flags and TVHT_ABOVE) <> 0 then Include(Result, htAbove);
  4312.     if (flags and TVHT_BELOW) <> 0 then Include(Result, htBelow);
  4313.     if (flags and TVHT_NOWHERE) <> 0 then Include(Result, htNowhere);
  4314.     if (flags and TVHT_ONITEM) <> 0 then Include(Result, htOnItem);
  4315.     if (flags and TVHT_ONITEMBUTTON) <> 0 then Include(Result, htOnButton);
  4316.     if (flags and TVHT_ONITEMICON) <> 0 then Include(Result, htOnIcon);
  4317.     if (flags and TVHT_ONITEMINDENT) <> 0 then Include(Result, htOnIndent);
  4318.     if (flags and TVHT_ONITEMLABEL) <> 0 then Include(Result, htOnLabel);
  4319.     if (flags and TVHT_ONITEMRIGHT) <> 0 then Include(Result, htOnRight);
  4320.     if (flags and TVHT_ONITEMSTATEICON) <> 0 then Include(Result, htOnStateIcon);
  4321.     if (flags and TVHT_TOLEFT) <> 0 then Include(Result, htToLeft);
  4322.     if (flags and TVHT_TORIGHT) <> 0 then Include(Result, htToRight);
  4323.   end;
  4324. end;
  4325.  
  4326. procedure TCustomTreeView.SetTreeNodes(Value: TTreeNodes);
  4327. begin
  4328.   Items.Assign(Value);
  4329. end;
  4330.  
  4331. procedure TCustomTreeView.SetIndent(Value: Integer);
  4332. begin
  4333.   if Value <> Indent then TreeView_SetIndent(Handle, Value);
  4334. end;
  4335.  
  4336. function TCustomTreeView.GetIndent: Integer;
  4337. begin
  4338.   Result := TreeView_GetIndent(Handle)
  4339. end;
  4340.  
  4341. procedure TCustomTreeView.FullExpand;
  4342. var
  4343.   Node: TTreeNode;
  4344. begin
  4345.   Node := Items.GetFirstNode;
  4346.   while Node <> nil do
  4347.   begin
  4348.     Node.Expand(True);
  4349.     Node := Node.GetNextSibling;
  4350.   end;
  4351. end;
  4352.  
  4353. procedure TCustomTreeView.FullCollapse;
  4354. var
  4355.   Node: TTreeNode;
  4356. begin
  4357.   Node := Items.GetFirstNode;
  4358.   while Node <> nil do
  4359.   begin
  4360.     Node.Collapse(True);
  4361.     Node := Node.GetNextSibling;
  4362.   end;
  4363. end;
  4364.  
  4365. procedure TCustomTreeView.Loaded;
  4366. begin
  4367.   inherited Loaded;
  4368.   if csDesigning in ComponentState then FullExpand;
  4369. end;
  4370.  
  4371. function TCustomTreeView.GetTopItem: TTreeNode;
  4372. begin
  4373.   if HandleAllocated then
  4374.     Result := Items.GetNode(TreeView_GetFirstVisible(Handle))
  4375.   else Result := nil;
  4376. end;
  4377.  
  4378. procedure TCustomTreeView.SetTopItem(Value: TTreeNode);
  4379. begin
  4380.   if HandleAllocated and (Value <> nil) then
  4381.     TreeView_SelectSetFirstVisible(Handle, Value.ItemId);
  4382. end;
  4383.  
  4384. function TCustomTreeView.GetSelection: TTreeNode;
  4385. begin
  4386.   if HandleAllocated then
  4387.     Result := Items.GetNode(TreeView_GetSelection(Handle))
  4388.   else Result := nil;
  4389. end;
  4390.  
  4391. procedure TCustomTreeView.SetSelection(Value: TTreeNode);
  4392. begin
  4393.   if Value <> nil then Value.Selected := True
  4394.   else TreeView_SelectItem(Handle, nil);
  4395. end;
  4396.  
  4397. function TCustomTreeView.GetDropTarget: TTreeNode;
  4398. begin
  4399.   if HandleAllocated then
  4400.   begin
  4401.     Result := Items.GetNode(TreeView_GetDropHilite(Handle));
  4402.     if Result = nil then Result := FLastDropTarget;
  4403.   end
  4404.   else Result := nil;
  4405. end;
  4406.  
  4407. procedure TCustomTreeView.SetDropTarget(Value: TTreeNode);
  4408. begin
  4409.   if HandleAllocated then
  4410.     if Value <> nil then Value.DropTarget := True
  4411.     else TreeView_SelectDropTarget(Handle, nil);
  4412. end;
  4413.  
  4414. function TCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode;
  4415. begin
  4416.   with Item do
  4417.     if (state and TVIF_PARAM) <> 0 then Result := Pointer(lParam)
  4418.     else Result := Items.GetNode(hItem);
  4419. end;
  4420.  
  4421. function TCustomTreeView.IsEditing: Boolean;
  4422. begin
  4423.   Result := TreeView_GetEditControl(Handle) <> 0;
  4424. end;
  4425.  
  4426. procedure TCustomTreeView.CNNotify(var Message: TWMNotify);
  4427. var
  4428.   Node: TTreeNode;
  4429. begin
  4430.   with Message.NMHdr^ do
  4431.     case code of
  4432.       TVN_BEGINDRAG:
  4433.         begin
  4434.           FDragged := True;
  4435.           with PNMTreeView(Pointer(Message.NMHdr))^ do
  4436.             FDragNode := GetNodeFromItem(ItemNew);
  4437.         end;
  4438.       TVN_BEGINLABELEDIT:
  4439.         begin
  4440.           with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4441.             if Dragging or not CanEdit(GetNodeFromItem(item)) then
  4442.               Message.Result := 1;
  4443.           if Message.Result = 0 then
  4444.           begin
  4445.             FEditHandle := TreeView_GetEditControl(Handle);
  4446.             FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  4447.             SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
  4448.           end;
  4449.         end;
  4450.       TVN_ENDLABELEDIT:
  4451.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4452.           Edit(item);
  4453.       TVN_ITEMEXPANDING:
  4454.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4455.         begin
  4456.           Node := GetNodeFromItem(ItemNew);
  4457.           if (action = TVE_EXPAND) and not CanExpand(Node) then
  4458.             Message.Result := 1
  4459.           else if (action = TVE_COLLAPSE) and
  4460.             not CanCollapse(Node) then Message.Result := 1;
  4461.         end;
  4462.       TVN_ITEMEXPANDED:
  4463.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4464.         begin
  4465.           Node := GetNodeFromItem(itemNew);
  4466.           if (action = TVE_EXPAND) then Expand(Node)
  4467.           else if (action = TVE_COLLAPSE) then Collapse(Node);
  4468.         end;
  4469.       TVN_SELCHANGING:
  4470.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4471.           if not CanChange(GetNodeFromItem(itemNew)) then
  4472.             Message.Result := 1;
  4473.       TVN_SELCHANGED:
  4474.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4475.           Change(GetNodeFromItem(itemNew));
  4476.       TVN_DELETEITEM:
  4477.         begin
  4478.           with PNMTreeView(Pointer(Message.NMHdr))^ do
  4479.             Node := GetNodeFromItem(itemOld);
  4480.           if Node <> nil then
  4481.           begin
  4482.             Node.FItemId := nil;
  4483.             Items.Delete(Node);
  4484.           end;
  4485.         end;
  4486.       TVN_SETDISPINFO:
  4487.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4488.         begin
  4489.           Node := GetNodeFromItem(item);
  4490.           if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
  4491.             Node.Text := item.pszText;
  4492.         end;
  4493.       TVN_GETDISPINFO:
  4494.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4495.         begin
  4496.           Node := GetNodeFromItem(item);
  4497.           if Node <> nil then
  4498.           begin
  4499.             if (item.mask and TVIF_TEXT) <> 0 then
  4500.               StrLCopy(item.pszText, PChar(Node.Text), item.cchTextMax);
  4501.             if (item.mask and TVIF_IMAGE) <> 0 then
  4502.             begin
  4503.               GetImageIndex(Node);
  4504.               item.iImage := Node.ImageIndex;
  4505.             end;
  4506.             if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
  4507.             begin
  4508.               GetSelectedIndex(Node);
  4509.               item.iSelectedImage := Node.SelectedIndex;
  4510.             end;
  4511.           end;
  4512.         end;
  4513.       NM_RCLICK: FRClicked := True;
  4514.     end;
  4515. end;
  4516.  
  4517. function TCustomTreeView.GetDragImages: TCustomImageList;
  4518. begin
  4519.   if FDragImage.Count > 0 then
  4520.     Result := FDragImage else
  4521.     Result := nil;
  4522. end;
  4523.  
  4524. procedure TCustomTreeView.WndProc(var Message: TMessage);
  4525. begin
  4526.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  4527.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and (DragMode = dmAutomatic) then
  4528.   begin
  4529.     if not IsControlMouseMsg(TWMMouse(Message)) then
  4530.     begin
  4531.       ControlState := ControlState + [csLButtonDown];
  4532.       Dispatch(Message);
  4533.     end;
  4534.   end
  4535.   else inherited WndProc(Message);
  4536. end;
  4537.  
  4538. procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject);
  4539. var
  4540.   ImageHandle: HImageList;
  4541.   DragNode: TTreeNode;
  4542.   P: TPoint;
  4543. begin
  4544.   inherited DoStartDrag(DragObject);
  4545.   DragNode := FDragNode;
  4546.   FLastDropTarget := nil;
  4547.   FDragNode := nil;
  4548.   if DragNode = nil then
  4549.   begin
  4550.     GetCursorPos(P);
  4551.     with ScreenToClient(P) do DragNode := GetNodeAt(X, Y);
  4552.   end;
  4553.   if DragNode <> nil then
  4554.   begin
  4555.     ImageHandle := TreeView_CreateDragImage(Handle, DragNode.ItemId);
  4556.     if ImageHandle <> 0 then
  4557.       with FDragImage do
  4558.       begin
  4559.         Handle := ImageHandle;
  4560.         SetDragImage(0, 2, 2);
  4561.       end;
  4562.   end;
  4563. end;
  4564.  
  4565. procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer);
  4566. begin
  4567.   inherited DoEndDrag(Target, X, Y);
  4568.   FLastDropTarget := nil;
  4569. end;
  4570.  
  4571. procedure TCustomTreeView.CMDrag(var Message: TCMDrag);
  4572. begin
  4573.   inherited;
  4574.   if Message.Result <> 0 then
  4575.     with Message, DragRec^ do
  4576.       case DragMessage of
  4577.         dmDragMove: with ScreenToClient(Pos) do DoDragOver(Source, X, Y);
  4578.         dmDragLeave:
  4579.           begin
  4580.             TDragObject(Source).HideDragImage;
  4581.             FLastDropTarget := DropTarget;
  4582.             DropTarget := nil;
  4583.             TDragObject(Source).ShowDragImage;
  4584.           end;
  4585.         dmDragDrop: FLastDropTarget := nil;
  4586.       end;
  4587. end;
  4588.  
  4589. procedure TCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer);
  4590. var
  4591.   Node: TTreeNode;
  4592. begin
  4593.   Node := GetNodeAt(X, Y);
  4594.   if (Node <> nil) and
  4595.     ((Node <> DropTarget) or (Node = FLastDropTarget)) then
  4596.   begin
  4597.     FLastDropTarget := nil;
  4598.     TDragObject(Source).HideDragImage;
  4599.     Node.DropTarget := True;
  4600.     TDragObject(Source).ShowDragImage;
  4601.   end;
  4602. end;
  4603.  
  4604. procedure TCustomTreeView.GetImageIndex(Node: TTreeNode);
  4605. begin
  4606.   if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node);
  4607. end;
  4608.  
  4609. procedure TCustomTreeView.GetSelectedIndex(Node: TTreeNode);
  4610. begin
  4611.   if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node);
  4612. end;
  4613.  
  4614. function TCustomTreeView.CanChange(Node: TTreeNode): Boolean;
  4615. begin
  4616.   Result := True;
  4617.   if Assigned(FOnChanging) then FOnChanging(Self, Node, Result);
  4618. end;
  4619.  
  4620. procedure TCustomTreeView.Change(Node: TTreeNode);
  4621. begin
  4622.   if Assigned(FOnChange) then FOnChange(Self, Node);
  4623. end;
  4624.  
  4625. procedure TCustomTreeView.Expand(Node: TTreeNode);
  4626. begin
  4627.   if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
  4628. end;
  4629.  
  4630. function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean;
  4631. begin
  4632.   Result := True;
  4633.   if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result);
  4634. end;
  4635.  
  4636. procedure TCustomTreeView.Collapse(Node: TTreeNode);
  4637. begin
  4638.   if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node);
  4639. end;
  4640.  
  4641. function TCustomTreeView.CanCollapse(Node: TTreeNode): Boolean;
  4642. begin
  4643.   Result := True;
  4644.   if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result);
  4645. end;
  4646.  
  4647. function TCustomTreeView.CanEdit(Node: TTreeNode): Boolean;
  4648. begin
  4649.   Result := True;
  4650.   if Assigned(FOnEditing) then FOnEditing(Self, Node, Result);
  4651. end;
  4652.  
  4653. procedure TCustomTreeView.Edit(const Item: TTVItem);
  4654. var
  4655.   S: string;
  4656.   Node: TTreeNode;
  4657. begin
  4658.   with Item do
  4659.     if pszText <> nil then
  4660.     begin
  4661.       S := pszText;
  4662.       Node := GetNodeFromItem(Item);
  4663.       if Assigned(FOnEdited) then FOnEdited(Self, Node, S);
  4664.       if Node <> nil then Node.Text := S;
  4665.     end;
  4666. end;
  4667.  
  4668. function TCustomTreeView.CreateNode: TTreeNode;
  4669. begin
  4670.   Result := TTreeNode.Create(Items);
  4671. end;
  4672.  
  4673. procedure TCustomTreeView.SetImageList(Value: HImageList; Flags: Integer);
  4674. begin
  4675.   if HandleAllocated then TreeView_SetImageList(Handle, Value, Flags);
  4676. end;
  4677.  
  4678. procedure TCustomTreeView.ImageListChange(Sender: TObject);
  4679. var
  4680.   ImageHandle: HImageList;
  4681. begin
  4682.   if HandleAllocated then
  4683.   begin
  4684.     ImageHandle := TImageList(Sender).Handle;
  4685.     if Sender = Images then
  4686.       SetImageList(ImageHandle, TVSIL_NORMAL)
  4687.     else if Sender = StateImages then
  4688.       SetImageList(ImageHandle, TVSIL_STATE);
  4689.   end;
  4690. end;
  4691.  
  4692. procedure TCustomTreeView.Notification(AComponent: TComponent;
  4693.   Operation: TOperation);
  4694. begin
  4695.   inherited Notification(AComponent, Operation);
  4696.   if Operation = opRemove then
  4697.   begin
  4698.     if AComponent = Images then Images := nil;
  4699.     if AComponent = StateImages then StateImages := nil;
  4700.   end;
  4701. end;
  4702.  
  4703. procedure TCustomTreeView.SetImages(Value: TImageList);
  4704. begin
  4705.   if Images <> nil then
  4706.     Images.UnRegisterChanges(FImageChangeLink);
  4707.   FImages := Value;
  4708.   if Images <> nil then
  4709.   begin
  4710.     Images.RegisterChanges(FImageChangeLink);
  4711.     SetImageList(Images.Handle, TVSIL_NORMAL)
  4712.   end
  4713.   else SetImageList(0, TVSIL_NORMAL);
  4714. end;
  4715.  
  4716. procedure TCustomTreeView.SetStateImages(Value: TImageList);
  4717. begin
  4718.   if StateImages <> nil then
  4719.     StateImages.UnRegisterChanges(FStateChangeLink);
  4720.   FStateImages := Value;
  4721.   if StateImages <> nil then
  4722.   begin
  4723.     StateImages.RegisterChanges(FStateChangeLink);
  4724.     SetImageList(StateImages.Handle, TVSIL_STATE)
  4725.   end
  4726.   else SetImageList(0, TVSIL_STATE);
  4727. end;
  4728.  
  4729. procedure TCustomTreeView.LoadFromFile(const FileName: string);
  4730. var
  4731.   Stream: TStream;
  4732. begin
  4733.   Stream := TFileStream.Create(FileName, fmOpenRead);
  4734.   try
  4735.     LoadFromStream(Stream);
  4736.   finally
  4737.     Stream.Free;
  4738.   end;
  4739. end;
  4740.  
  4741. procedure TCustomTreeView.LoadFromStream(Stream: TStream);
  4742. begin
  4743.   with TTreeStrings.Create(Items) do
  4744.     try
  4745.       LoadFromStream(Stream);
  4746.     finally
  4747.       Free;
  4748.   end;
  4749. end;
  4750.  
  4751. procedure TCustomTreeView.SaveToFile(const FileName: string);
  4752. var
  4753.   Stream: TStream;
  4754. begin
  4755.   Stream := TFileStream.Create(FileName, fmCreate);
  4756.   try
  4757.     SaveToStream(Stream);
  4758.   finally
  4759.     Stream.Free;
  4760.   end;
  4761. end;
  4762.  
  4763. procedure TCustomTreeView.SaveToStream(Stream: TStream);
  4764. begin
  4765.   with TTreeStrings.Create(Items) do
  4766.     try
  4767.       SaveToStream(Stream);
  4768.     finally
  4769.       Free;
  4770.   end;
  4771. end;
  4772.  
  4773. procedure TCustomTreeView.WMRButtonDown(var Message: TWMRButtonDown);
  4774. var
  4775.   MousePos: TPoint;
  4776. begin
  4777.   FRClicked := False;
  4778.   inherited;
  4779.   if FRClicked then
  4780.   begin
  4781.     GetCursorPos(MousePos);
  4782.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  4783.       Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
  4784.   end;
  4785. end;
  4786.  
  4787. procedure TCustomTreeView.WMLButtonDown(var Message: TWMLButtonDown);
  4788. var
  4789.   Node: TTreeNode;
  4790.   MousePos: TPoint;
  4791. begin
  4792.   FDragged := False;
  4793.   FDragNode := nil;
  4794.   try
  4795.     inherited;
  4796.     if DragMode = dmAutomatic then
  4797.     begin
  4798.       SetFocus;
  4799.       if not FDragged then
  4800.       begin
  4801.         GetCursorPos(MousePos);
  4802.         with PointToSmallPoint(ScreenToClient(MousePos)) do
  4803.           Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
  4804.       end
  4805.       else begin
  4806.         Node := GetNodeAt(Message.XPos, Message.YPos);
  4807.         if Node <> nil then
  4808.         begin
  4809.           Node.Focused := True;
  4810.           Node.Selected := True;
  4811.           BeginDrag(False);
  4812.         end;
  4813.       end;
  4814.     end;
  4815.   finally
  4816.     FDragNode := nil;
  4817.   end;
  4818. end;
  4819.  
  4820. { TTrackBar }
  4821. constructor TTrackBar.Create(AOwner: TComponent);
  4822. begin
  4823.   inherited Create(AOwner);
  4824.   Width := 150;
  4825.   Height := 45;
  4826.   TabStop := True;
  4827.   FMin := 0;
  4828.   FMax := 10;
  4829.   FLineSize := 1;
  4830.   FPageSize := 2;
  4831.   FFrequency := 1;
  4832.  
  4833.   FTickMarks := tmBottomRight;
  4834.   FTickStyle := tsAuto;
  4835.   FOrientation := trHorizontal;
  4836.   ControlStyle := ControlStyle - [csDoubleClicks];
  4837. end;
  4838.  
  4839. procedure TTrackBar.CreateParams(var Params: TCreateParams);
  4840. const
  4841.   OrientationStyle: array[TTrackbarOrientation] of Longint = (TBS_HORZ, TBS_VERT);
  4842.   TickStyles: array[TTickStyle] of Longint = (TBS_NOTICKS, TBS_AUTOTICKS, 0);
  4843.   ATickMarks: array[TTickMark] of Longint = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
  4844. begin
  4845.   InitCommonControls;
  4846.   inherited CreateParams(Params);
  4847.   CreateSubClass(Params, TRACKBAR_CLASS);
  4848.   Params.Style := Params.Style or OrientationStyle[FOrientation] or
  4849.     TickStyles[FTickStyle] or ATickMarks[FTickMarks] or TBS_ENABLESELRANGE;
  4850.   Params.WindowClass.style := Params.WindowClass.style or CS_DBLCLKS;
  4851. end;
  4852.  
  4853. procedure TTrackBar.CreateWnd;
  4854. begin
  4855.   inherited CreateWnd;
  4856.   if HandleAllocated then
  4857.   begin
  4858.     SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
  4859.     SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
  4860.     SendMessage(Handle, TBM_SETRANGEMIN, 0, FMin);
  4861.     SendMessage(Handle, TBM_SETRANGEMAX, 0, FMax);
  4862.     UpdateSelection;
  4863.     SendMessage(Handle, TBM_SETPOS, 1, FPosition);
  4864.     SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  4865.   end;
  4866. end;
  4867.  
  4868. procedure TTrackBar.DestroyWnd;
  4869. begin
  4870.   inherited DestroyWnd;
  4871. end;
  4872.  
  4873. procedure TTrackBar.CNHScroll(var Message: TWMHScroll);
  4874. begin
  4875.   inherited;
  4876.   FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  4877.  
  4878.   if Assigned(FOnChange) then
  4879.     FOnChange(Self);
  4880.   Message.Result := 0;
  4881. end;
  4882.  
  4883. procedure TTrackBar.CNVScroll(var Message: TWMVScroll);
  4884. begin
  4885.   inherited;
  4886.   FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  4887.  
  4888.   if Assigned(FOnChange) then
  4889.     FOnChange(Self);
  4890.   Message.Result := 0;
  4891. end;
  4892.  
  4893. procedure TTrackBar.SetOrientation(Value: TTrackBarOrientation);
  4894. begin
  4895.   if Value <> FOrientation then
  4896.   begin
  4897.     FOrientation := Value;
  4898.     if ComponentState * [csLoading, csUpdating] = [] then
  4899.       SetBounds(Left, Top, Height, Width);
  4900.     RecreateWnd;
  4901.   end;
  4902. end;
  4903.  
  4904. procedure TTrackBar.SetParams(APosition, AMin, AMax: Integer);
  4905. begin
  4906.   if AMax < AMin then
  4907.     raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  4908.   if APosition < AMin then APosition := AMin;
  4909.   if APosition > AMax then APosition := AMax;
  4910.   if (FMin <> AMin) then
  4911.   begin
  4912.     FMin := AMin;
  4913.     if HandleAllocated then
  4914.       SendMessage(Handle, TBM_SETRANGEMIN, 1, AMin);
  4915.   end;
  4916.   if (FMax <> AMax) then
  4917.   begin
  4918.     FMax := AMax;
  4919.     if HandleAllocated then
  4920.       SendMessage(Handle, TBM_SETRANGEMAX, 1, AMax);
  4921.   end;
  4922.   if FPosition <> APosition then
  4923.   begin
  4924.     FPosition := APosition;
  4925.     if HandleAllocated then
  4926.       SendMessage(Handle, TBM_SETPOS, 1, APosition);
  4927.   end;
  4928. end;
  4929.  
  4930. procedure TTrackBar.SetPosition(Value: Integer);
  4931. begin
  4932.   SetParams(Value, FMin, FMax);
  4933. end;
  4934.  
  4935. procedure TTrackBar.SetMin(Value: Integer);
  4936. begin
  4937.   SetParams(FPosition, Value, FMax);
  4938. end;
  4939.  
  4940. procedure TTrackBar.SetMax(Value: Integer);
  4941. begin
  4942.   SetParams(FPosition, FMin, Value);
  4943. end;
  4944.  
  4945. procedure TTrackBar.SetFrequency(Value: Integer);
  4946. begin
  4947.   if Value <> FFrequency then
  4948.   begin
  4949.     FFrequency := Value;
  4950.     if HandleAllocated then
  4951.       SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  4952.   end;
  4953. end;
  4954.  
  4955. procedure TTrackBar.SetTick(Value: Integer);
  4956. begin
  4957.   if HandleAllocated then
  4958.     SendMessage(Handle, TBM_SETTIC, 0, Value);
  4959. end;
  4960.  
  4961. procedure TTrackBar.SetTickStyle(Value: TTickStyle);
  4962. begin
  4963.   if Value <> FTickStyle then
  4964.   begin
  4965.     FTickStyle := Value;
  4966.     RecreateWnd;
  4967.   end;
  4968. end;
  4969.  
  4970. procedure TTrackBar.SetTickMarks(Value: TTickMark);
  4971. begin
  4972.   if Value <> FTickMarks then
  4973.   begin
  4974.     FTickMarks := Value;
  4975.     RecreateWnd;
  4976.   end;
  4977. end;
  4978.  
  4979. procedure TTrackBar.SetLineSize(Value: Integer);
  4980. begin
  4981.   if Value <> FLineSize then
  4982.   begin
  4983.     FLineSize := Value;
  4984.     if HandleAllocated then
  4985.       SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
  4986.   end;
  4987. end;
  4988.  
  4989. procedure TTrackBar.SetPageSize(Value: Integer);
  4990. begin
  4991.   if Value <> FPageSize then
  4992.   begin
  4993.     FPageSize := Value;
  4994.     if HandleAllocated then
  4995.       SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
  4996.   end;
  4997. end;
  4998.  
  4999. procedure TTrackBar.UpdateSelection;
  5000. begin
  5001.   if HandleAllocated then
  5002.   begin
  5003.     if (FSelStart = 0) and (FSelEnd = 0) then
  5004.       SendMessage(Handle, TBM_CLEARSEL, 1, 0)
  5005.     else
  5006.       SendMessage(Handle, TBM_SETSEL, Integer(True), MakeLong(FSelStart, FSelEnd));
  5007.   end;
  5008. end;
  5009.  
  5010. procedure TTrackBar.SetSelStart(Value: Integer);
  5011. begin
  5012.   if Value <> FSelStart then
  5013.   begin
  5014.     FSelStart := Value;
  5015.     UpdateSelection;
  5016.   end;
  5017. end;
  5018.  
  5019. procedure TTrackBar.SetSelEnd(Value: Integer);
  5020. begin
  5021.   if Value <> FSelEnd then
  5022.   begin
  5023.     FSelEnd := Value;
  5024.     UpdateSelection;
  5025.   end;
  5026. end;
  5027.  
  5028. { TProgressBar }
  5029. constructor TProgressBar.Create(AOwner: TComponent);
  5030. begin
  5031.   inherited Create(AOwner);
  5032.   Width := 150;
  5033.   Height := GetSystemMetrics(SM_CYVSCROLL);
  5034.   FMin := 0;
  5035.   FMax := 100;
  5036.   FStep := 10;
  5037. end;
  5038.  
  5039. procedure TProgressBar.CreateParams(var Params: TCreateParams);
  5040. begin
  5041.   InitCommonControls;
  5042.   inherited CreateParams(Params);
  5043.   CreateSubClass(Params, PROGRESS_CLASS);
  5044. end;
  5045.  
  5046. procedure TProgressBar.CreateWnd;
  5047. begin
  5048.   inherited CreateWnd;
  5049.   SendMessage(Handle, PBM_SETRANGE, 0, MakeLong(FMin, FMax));
  5050.   SendMessage(Handle, PBM_SETSTEP, FStep, 0);
  5051.   Position := FPosition;
  5052. end;
  5053.  
  5054. function TProgressBar.GetPosition: TProgressRange;
  5055. begin
  5056.   if HandleAllocated then
  5057.     Result := SendMessage(Handle, PBM_DELTAPOS, 0, 0) else
  5058.     Result := FPosition;
  5059. end;
  5060.  
  5061. procedure TProgressBar.SetParams(AMin, AMax: TProgressRange);
  5062. begin
  5063.   if AMax < AMin then
  5064.     raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  5065.   if (FMin <> AMin) or (FMax <> AMax) then
  5066.   begin
  5067.     if HandleAllocated then
  5068.     begin
  5069.       SendMessage(Handle, PBM_SETRANGE, 0, MakeLong(AMin, AMax));
  5070.       if FMin > AMin then // since Windows sets Position when increase Min..
  5071.         SendMessage(Handle, PBM_SETPOS, AMin, 0); // set it back if decrease
  5072.     end;
  5073.     FMin := AMin;
  5074.     FMax := AMax;
  5075.   end;
  5076. end;
  5077.  
  5078. procedure TProgressBar.SetMin(Value: TProgressRange);
  5079. begin
  5080.   SetParams(Value, FMax);
  5081. end;
  5082.  
  5083. procedure TProgressBar.SetMax(Value: TProgressRange);
  5084. begin
  5085.   SetParams(FMin, Value);
  5086. end;
  5087.  
  5088. procedure TProgressBar.SetPosition(Value: TProgressRange);
  5089. begin
  5090.   if HandleAllocated then
  5091.     SendMessage(Handle, PBM_SETPOS, Value, 0) else
  5092.     FPosition := Value;
  5093. end;
  5094.  
  5095. procedure TProgressBar.SetStep(Value: TProgressRange);
  5096. begin
  5097.   if Value <> FStep then
  5098.   begin
  5099.     FStep := Value;
  5100.     if HandleAllocated then
  5101.       SendMessage(Handle, PBM_SETSTEP, FStep, 0);
  5102.   end;
  5103. end;
  5104.  
  5105. procedure TProgressBar.StepIt;
  5106. begin
  5107.   if HandleAllocated then
  5108.     SendMessage(Handle, PBM_STEPIT, 0, 0);
  5109. end;
  5110.  
  5111. procedure TProgressBar.StepBy(Delta: TProgressRange);
  5112. begin
  5113.   if HandleAllocated then
  5114.     SendMessage(Handle, PBM_DELTAPOS, Delta, 0);
  5115. end;
  5116.  
  5117. { TTextAttributes }
  5118.  
  5119. constructor TTextAttributes.Create(AOwner: TCustomRichEdit;
  5120.   AttributeType: TAttributeType);
  5121. begin
  5122.   inherited Create;
  5123.   RichEdit := AOwner;
  5124.   FType := AttributeType;
  5125. end;
  5126.  
  5127. procedure TTextAttributes.InitFormat(var Format: TCharFormat);
  5128. begin
  5129.   FillChar(Format, SizeOf(TCharFormat), 0);
  5130.   Format.cbSize := SizeOf(TCharFormat);
  5131. end;
  5132.  
  5133. function TTextAttributes.GetConsistentAttributes: TConsistentAttributes;
  5134. var
  5135.   Format: TCharFormat;
  5136. begin
  5137.   Result := [];
  5138.   if RichEdit.HandleAllocated and (FType = atSelected) then
  5139.   begin
  5140.     InitFormat(Format);
  5141.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  5142.       WPARAM(FType = atSelected), LPARAM(@Format));
  5143.     with Format do
  5144.     begin
  5145.       if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
  5146.       if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
  5147.       if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
  5148.       if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
  5149.       if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
  5150.       if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
  5151.       if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
  5152.       if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
  5153.     end;
  5154.   end;
  5155. end;
  5156.  
  5157. procedure TTextAttributes.GetAttributes(var Format: TCharFormat);
  5158. begin
  5159.   InitFormat(Format);
  5160.   if RichEdit.HandleAllocated then
  5161.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  5162.       WPARAM(FType = atSelected), LPARAM(@Format));
  5163. end;
  5164.  
  5165. procedure TTextAttributes.SetAttributes(var Format: TCharFormat);
  5166. var
  5167.   Flag: Longint;
  5168. begin
  5169.   if FType = atSelected then Flag := SCF_SELECTION
  5170.   else Flag := 0;
  5171.   if RichEdit.HandleAllocated then
  5172.     SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, Flag, LPARAM(@Format))
  5173. end;
  5174.  
  5175. function TTextAttributes.GetProtected: Boolean;
  5176. var
  5177.   Format: TCharFormat;
  5178. begin
  5179.   GetAttributes(Format);
  5180.   with Format do
  5181.     if (dwEffects and CFE_PROTECTED) <> 0 then
  5182.       Result := True else
  5183.       Result := False;
  5184. end;
  5185.  
  5186. procedure TTextAttributes.SetProtected(Value: Boolean);
  5187. var
  5188.   Format: TCharFormat;
  5189. begin
  5190.   InitFormat(Format);
  5191.   with Format do
  5192.   begin
  5193.     dwMask := CFM_PROTECTED;
  5194.     if Value then dwEffects := CFE_PROTECTED;
  5195.   end;
  5196.   SetAttributes(Format);
  5197. end;
  5198.  
  5199. function TTextAttributes.GetColor: TColor;
  5200. var
  5201.   Format: TCharFormat;
  5202. begin
  5203.   GetAttributes(Format);
  5204.   with Format do
  5205.     if (dwEffects and CFE_AUTOCOLOR) <> 0 then
  5206.       Result := clWindowText else
  5207.       Result := crTextColor;
  5208. end;
  5209.  
  5210. procedure TTextAttributes.SetColor(Value: TColor);
  5211. var
  5212.   Format: TCharFormat;
  5213. begin
  5214.   InitFormat(Format);
  5215.   with Format do
  5216.   begin
  5217.     dwMask := CFM_COLOR;
  5218.     if Value = clWindowText then
  5219.       dwEffects := CFE_AUTOCOLOR else
  5220.       crTextColor := ColorToRGB(Value);
  5221.   end;
  5222.   SetAttributes(Format);
  5223. end;
  5224.  
  5225. function TTextAttributes.GetName: TFontName;
  5226. var
  5227.   Format: TCharFormat;
  5228. begin
  5229.   GetAttributes(Format);
  5230.   Result := Format.szFaceName;
  5231. end;
  5232.  
  5233. procedure TTextAttributes.SetName(Value: TFontName);
  5234. var
  5235.   Format: TCharFormat;
  5236. begin
  5237.   InitFormat(Format);
  5238.   with Format do
  5239.   begin
  5240.     dwMask := CFM_FACE;
  5241.     StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
  5242.   end;
  5243.   SetAttributes(Format);
  5244. end;
  5245.  
  5246. function TTextAttributes.GetStyle: TFontStyles;
  5247. var
  5248.   Format: TCharFormat;
  5249. begin
  5250.   Result := [];
  5251.   GetAttributes(Format);
  5252.   with Format do
  5253.   begin
  5254.     if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
  5255.     if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
  5256.     if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
  5257.     if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  5258.   end;
  5259. end;
  5260.  
  5261. procedure TTextAttributes.SetStyle(Value: TFontStyles);
  5262. var
  5263.   Format: TCharFormat;
  5264. begin
  5265.   InitFormat(Format);
  5266.   with Format do
  5267.   begin
  5268.     dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
  5269.     if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
  5270.     if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
  5271.     if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
  5272.     if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  5273.   end;
  5274.   SetAttributes(Format);
  5275. end;
  5276.  
  5277. function TTextAttributes.GetSize: Integer;
  5278. var
  5279.   Format: TCharFormat;
  5280. begin
  5281.   GetAttributes(Format);
  5282.   Result := Format.yHeight div 20;
  5283. end;
  5284.  
  5285. procedure TTextAttributes.SetSize(Value: Integer);
  5286. var
  5287.   Format: TCharFormat;
  5288. begin
  5289.   InitFormat(Format);
  5290.   with Format do
  5291.   begin
  5292.     dwMask := CFM_SIZE;
  5293.     yHeight := Value * 20;
  5294.   end;
  5295.   SetAttributes(Format);
  5296. end;
  5297.  
  5298. function TTextAttributes.GetHeight: Integer;
  5299. begin
  5300.   Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72);
  5301. end;
  5302.  
  5303. procedure TTextAttributes.SetHeight(Value: Integer);
  5304. begin
  5305.   Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels);
  5306. end;
  5307.  
  5308. function TTextAttributes.GetPitch: TFontPitch;
  5309. var
  5310.   Format: TCharFormat;
  5311. begin
  5312.   GetAttributes(Format);
  5313.   case (Format.bPitchAndFamily and $03) of
  5314.     DEFAULT_PITCH: Result := fpDefault;
  5315.     VARIABLE_PITCH: Result := fpVariable;
  5316.     FIXED_PITCH: Result := fpFixed;
  5317.   else
  5318.     Result := fpDefault;
  5319.   end;
  5320. end;
  5321.  
  5322. procedure TTextAttributes.SetPitch(Value: TFontPitch);
  5323. var
  5324.   Format: TCharFormat;
  5325. begin
  5326.   InitFormat(Format);
  5327.   with Format do
  5328.   begin
  5329.     case Value of
  5330.       fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
  5331.       fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
  5332.     else
  5333.       Format.bPitchAndFamily := DEFAULT_PITCH;
  5334.     end;
  5335.   end;
  5336.   SetAttributes(Format);
  5337. end;
  5338.  
  5339. procedure TTextAttributes.Assign(Source: TPersistent);
  5340. begin
  5341.   if Source is TFont then
  5342.   begin
  5343.     Color := TFont(Source).Color;
  5344.     Name := TFont(Source).Name;
  5345.     Style := TFont(Source).Style;
  5346.     Size := TFont(Source).Size;
  5347.     Pitch := TFont(Source).Pitch;
  5348.   end
  5349.   else if Source is TTextAttributes then
  5350.   begin
  5351.     Color := TTextAttributes(Source).Color;
  5352.     Name := TTextAttributes(Source).Name;
  5353.     Style := TTextAttributes(Source).Style;
  5354.     Pitch := TTextAttributes(Source).Pitch;
  5355.   end
  5356.   else inherited Assign(Source);
  5357. end;
  5358.  
  5359. procedure TTextAttributes.AssignTo(Dest: TPersistent);
  5360. begin
  5361.   if Dest is TFont then
  5362.   begin
  5363.     TFont(Dest).Color := Color;
  5364.     TFont(Dest).Name := Name;
  5365.     TFont(Dest).Style := Style;
  5366.     TFont(Dest).Size := Size;
  5367.     TFont(Dest).Pitch := Pitch;
  5368.   end
  5369.   else if Dest is TTextAttributes then
  5370.   begin
  5371.     TTextAttributes(Dest).Color := Color;
  5372.     TTextAttributes(Dest).Name := Name;
  5373.     TTextAttributes(Dest).Style := Style;
  5374.     TTextAttributes(Dest).Pitch := Pitch;
  5375.   end
  5376.   else inherited AssignTo(Dest);
  5377. end;
  5378.  
  5379. { TParaAttributes }
  5380.  
  5381. constructor TParaAttributes.Create(AOwner: TCustomRichEdit);
  5382. begin
  5383.   inherited Create;
  5384.   RichEdit := AOwner;
  5385. end;
  5386.  
  5387. procedure TParaAttributes.InitPara(var Paragraph: TParaFormat);
  5388. begin
  5389.   FillChar(Paragraph, SizeOf(TParaFormat), 0);
  5390.   Paragraph.cbSize := SizeOf(TParaFormat);
  5391. end;
  5392.  
  5393. procedure TParaAttributes.GetAttributes(var Paragraph: TParaFormat);
  5394. begin
  5395.   InitPara(Paragraph);
  5396.   if RichEdit.HandleAllocated then
  5397.     SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
  5398. end;
  5399.  
  5400. procedure TParaAttributes.SetAttributes(var Paragraph: TParaFormat);
  5401. begin
  5402.   if RichEdit.HandleAllocated then
  5403.     SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph))
  5404. end;
  5405.  
  5406. function TParaAttributes.GetAlignment: TAlignment;
  5407. var
  5408.   Paragraph: TParaFormat;
  5409. begin
  5410.   GetAttributes(Paragraph);
  5411.   Result := TAlignment(Paragraph.wAlignment - 1);
  5412. end;
  5413.  
  5414. procedure TParaAttributes.SetAlignment(Value: TAlignment);
  5415. var
  5416.   Paragraph: TParaFormat;
  5417. begin
  5418.   InitPara(Paragraph);
  5419.   with Paragraph do
  5420.   begin
  5421.     dwMask := PFM_ALIGNMENT;
  5422.     wAlignment := Ord(Value) + 1;
  5423.   end;
  5424.   SetAttributes(Paragraph);
  5425. end;
  5426.  
  5427. function TParaAttributes.GetNumbering: TNumberingStyle;
  5428. var
  5429.   Paragraph: TParaFormat;
  5430. begin
  5431.   GetAttributes(Paragraph);
  5432.   Result := TNumberingStyle(Paragraph.wNumbering);
  5433. end;
  5434.  
  5435. procedure TParaAttributes.SetNumbering(Value: TNumberingStyle);
  5436. var
  5437.   Paragraph: TParaFormat;
  5438. begin
  5439.   case Value of
  5440.     nsBullet: if LeftIndent < 10 then LeftIndent := 10;
  5441.     nsNone: LeftIndent := 0;
  5442.   end;
  5443.   InitPara(Paragraph);
  5444.   with Paragraph do
  5445.   begin
  5446.     dwMask := PFM_NUMBERING;
  5447.     wNumbering := Ord(Value);
  5448.   end;
  5449.   SetAttributes(Paragraph);
  5450. end;
  5451.  
  5452. function TParaAttributes.GetFirstIndent: Longint;
  5453. var
  5454.   Paragraph: TParaFormat;
  5455. begin
  5456.   GetAttributes(Paragraph);
  5457.   Result := Paragraph.dxStartIndent div 20
  5458. end;
  5459.  
  5460. procedure TParaAttributes.SetFirstIndent(Value: Longint);
  5461. var
  5462.   Paragraph: TParaFormat;
  5463. begin
  5464.   InitPara(Paragraph);
  5465.   with Paragraph do
  5466.   begin
  5467.     dwMask := PFM_STARTINDENT;
  5468.     dxStartIndent := Value * 20;
  5469.   end;
  5470.   SetAttributes(Paragraph);
  5471. end;
  5472.  
  5473. function TParaAttributes.GetLeftIndent: Longint;
  5474. var
  5475.   Paragraph: TParaFormat;
  5476. begin
  5477.   GetAttributes(Paragraph);
  5478.   Result := Paragraph.dxOffset div 20;
  5479. end;
  5480.  
  5481. procedure TParaAttributes.SetLeftIndent(Value: Longint);
  5482. var
  5483.   Paragraph: TParaFormat;
  5484. begin
  5485.   InitPara(Paragraph);
  5486.   with Paragraph do
  5487.   begin
  5488.     dwMask := PFM_OFFSET;
  5489.     dxOffset := Value * 20;
  5490.   end;
  5491.   SetAttributes(Paragraph);
  5492. end;
  5493.  
  5494. function TParaAttributes.GetRightIndent: Longint;
  5495. var
  5496.   Paragraph: TParaFormat;
  5497. begin
  5498.   GetAttributes(Paragraph);
  5499.   Result := Paragraph.dxRightIndent div 20;
  5500. end;
  5501.  
  5502. procedure TParaAttributes.SetRightIndent(Value: Longint);
  5503. var
  5504.   Paragraph: TParaFormat;
  5505. begin
  5506.   InitPara(Paragraph);
  5507.   with Paragraph do
  5508.   begin
  5509.     dwMask := PFM_RIGHTINDENT;
  5510.     dxRightIndent := Value * 20;
  5511.   end;
  5512.   SetAttributes(Paragraph);
  5513. end;
  5514.  
  5515. function TParaAttributes.GetTab(Index: Byte): Longint;
  5516. var
  5517.   Paragraph: TParaFormat;
  5518. begin
  5519.   GetAttributes(Paragraph);
  5520.   Result := Paragraph.rgxTabs[Index] div 20;
  5521. end;
  5522.  
  5523. procedure TParaAttributes.SetTab(Index: Byte; Value: Longint);
  5524. var
  5525.   Paragraph: TParaFormat;
  5526. begin
  5527.   GetAttributes(Paragraph);
  5528.   with Paragraph do
  5529.   begin
  5530.     rgxTabs[Index] := Value * 20;
  5531.     dwMask := PFM_TABSTOPS;
  5532.     if cTabCount < Index then cTabCount := Index;
  5533.     SetAttributes(Paragraph);
  5534.   end;
  5535. end;
  5536.  
  5537. function TParaAttributes.GetTabCount: Integer;
  5538. var
  5539.   Paragraph: TParaFormat;
  5540. begin
  5541.   GetAttributes(Paragraph);
  5542.   Result := Paragraph.cTabCount;
  5543. end;
  5544.  
  5545. procedure TParaAttributes.SetTabCount(Value: Integer);
  5546. var
  5547.   Paragraph: TParaFormat;
  5548. begin
  5549.   GetAttributes(Paragraph);
  5550.   with Paragraph do
  5551.   begin
  5552.     dwMask := PFM_TABSTOPS;
  5553.     cTabCount := Value;
  5554.     SetAttributes(Paragraph);
  5555.   end;
  5556. end;
  5557.  
  5558. procedure TParaAttributes.Assign(Source: TPersistent);
  5559. var
  5560.   I: Integer;
  5561. begin
  5562.   if Source is TParaAttributes then
  5563.   begin
  5564.     Alignment := TParaAttributes(Source).Alignment;
  5565.     FirstIndent := TParaAttributes(Source).FirstIndent;
  5566.     LeftIndent := TParaAttributes(Source).LeftIndent;
  5567.     RightIndent := TParaAttributes(Source).RightIndent;
  5568.     Numbering := TParaAttributes(Source).Numbering;
  5569.     for I := 0 to MAX_TAB_STOPS - 1 do
  5570.       Tab[I] := TParaAttributes(Source).Tab[I];
  5571.   end
  5572.   else inherited Assign(Source);
  5573. end;
  5574.  
  5575. { TConversion }
  5576.  
  5577. function TConversion.ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
  5578. begin
  5579.   Result := Stream.Read(Buffer^, BufSize);
  5580. end;
  5581.  
  5582. function TConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
  5583. begin
  5584.   Result := Stream.Write(Buffer^, BufSize);
  5585. end;
  5586.  
  5587. { TRichEditStrings }
  5588.  
  5589. const
  5590.   ReadError = $0001;
  5591.   WriteError = $0002;
  5592.   NoError = $0000;
  5593.  
  5594. type
  5595.   TSelection = record
  5596.     StartPos, EndPos: Integer;
  5597.   end;
  5598.  
  5599.   TRichEditStrings = class(TStrings)
  5600.   private
  5601.     RichEdit: TCustomRichEdit;
  5602.     FPlainText: Boolean;
  5603.     FConverter: TConversion;
  5604.   protected
  5605.     function Get(Index: Integer): string; override;
  5606.     function GetCount: Integer; override;
  5607.     procedure Put(Index: Integer; const S: string); override;
  5608.     procedure SetUpdateState(Updating: Boolean); override;
  5609.   public
  5610.     procedure Clear; override;
  5611.     procedure AddStrings(Strings: TStrings); override;
  5612.     procedure Delete(Index: Integer); override;
  5613.     procedure Insert(Index: Integer; const S: string); override;
  5614.     procedure LoadFromFile(const FileName: string); override;
  5615.     procedure LoadFromStream(Stream: TStream); override;
  5616.     procedure SaveToFile(const FileName: string); override;
  5617.     procedure SaveToStream(Stream: TStream); override;
  5618.     property PlainText: Boolean read FPlainText write FPlainText;
  5619.   end;
  5620.  
  5621. procedure TRichEditStrings.AddStrings(Strings: TStrings);
  5622. var
  5623.   SelChange: TNotifyEvent;
  5624. begin
  5625.   SelChange := RichEdit.OnSelectionChange;
  5626.   RichEdit.OnSelectionChange := nil;
  5627.   try
  5628.     inherited AddStrings(Strings);
  5629.   finally
  5630.     RichEdit.OnSelectionChange := SelChange;
  5631.   end;
  5632. end;
  5633.  
  5634. function TRichEditStrings.GetCount: Integer;
  5635. begin
  5636.   Result := SendMessage(RichEdit.Handle, EM_GETLINECOUNT, 0, 0);
  5637.   if SendMessage(RichEdit.Handle, EM_LINELENGTH, SendMessage(RichEdit.Handle,
  5638.     EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  5639. end;
  5640.  
  5641. function TRichEditStrings.Get(Index: Integer): string;
  5642. var
  5643.   Text: array[0..4095] of Char;
  5644.   L: Integer;
  5645. begin
  5646.   Word((@Text)^) := SizeOf(Text);
  5647.   L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  5648.   if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2);
  5649.   SetString(Result, Text, L);
  5650. end;
  5651.  
  5652. procedure TRichEditStrings.Put(Index: Integer; const S: string);
  5653. var
  5654.   Selection: TSelection;
  5655. begin
  5656.   if Index >= 0 then
  5657.   begin
  5658.     Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5659.     if Selection.StartPos <> -1 then
  5660.     begin
  5661.       Selection.EndPos := Selection.StartPos +
  5662.         SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5663.       SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5664.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  5665.     end;
  5666.   end;
  5667. end;
  5668.  
  5669. procedure TRichEditStrings.Insert(Index: Integer; const S: string);
  5670. var
  5671.   L: Integer;
  5672.   Selection: TSelection;
  5673.   Fmt: PChar;
  5674.   Str: string;
  5675. begin
  5676.   if Index >= 0 then
  5677.   begin
  5678.     Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5679.     if Selection.StartPos >= 0 then Fmt := '%s'#13#10
  5680.     else begin
  5681.       Selection.StartPos :=
  5682.         SendMessage(RichEdit.Handle, EM_LINEINDEX, Index - 1, 0);
  5683.       if Selection.StartPos < 0 then Exit;
  5684.       L := SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5685.       if L = 0 then Exit;
  5686.       Inc(Selection.StartPos, L);
  5687.       Fmt := #13#10'%s';
  5688.     end;
  5689.     Selection.EndPos := Selection.StartPos;
  5690.     SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5691.     Str := Format(Fmt, [S]);
  5692.     SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, LongInt(PChar(Str)));
  5693.     if RichEdit.SelStart <> (Selection.EndPos + Length(Str)) then
  5694.       raise EOutOfResources.CreateRes(sRichEditInsertError);
  5695.   end;
  5696. end;
  5697.  
  5698. procedure TRichEditStrings.Delete(Index: Integer);
  5699. const
  5700.   Empty: PChar = '';
  5701. var
  5702.   Selection: TSelection;
  5703. begin
  5704.   if Index < 0 then Exit;
  5705.   Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5706.   if Selection.StartPos <> -1 then
  5707.   begin
  5708.     Selection.EndPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index + 1, 0);
  5709.     if Selection.EndPos = -1 then
  5710.       Selection.EndPos := Selection.StartPos +
  5711.         SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5712.     SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5713.     SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  5714.   end;
  5715. end;
  5716.  
  5717. procedure TRichEditStrings.Clear;
  5718. begin
  5719.   RichEdit.Clear;
  5720. end;
  5721.  
  5722. procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
  5723. begin
  5724.   SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  5725.   if not Updating then RichEdit.Refresh;
  5726. end;
  5727.  
  5728. function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
  5729. asm
  5730.         PUSH    ESI
  5731.         PUSH    EDI
  5732.         MOV     EDI,EAX
  5733.         MOV     ESI,EDX
  5734.         MOV     EDX,EAX
  5735.         CLD
  5736. @@1:    LODSB
  5737. @@2:    OR      AL,AL
  5738.         JE      @@4
  5739.         CMP     AL,0AH
  5740.         JE      @@3
  5741.         STOSB
  5742.         CMP     AL,0DH
  5743.         JNE     @@1
  5744.         MOV     AL,0AH
  5745.         STOSB
  5746.         LODSB
  5747.         CMP     AL,0AH
  5748.         JE      @@1
  5749.         JMP     @@2
  5750. @@3:    MOV     EAX,0A0DH
  5751.         STOSW
  5752.         JMP     @@1
  5753. @@4:    STOSB
  5754.         LEA     EAX,[EDI-1]
  5755.         SUB     EAX,EDX
  5756.         POP     EDI
  5757.         POP     ESI
  5758. end;
  5759.  
  5760. function StreamSave(dwCookie: Longint; pbBuff: PByte;
  5761.   cb: Longint; var pcb: Longint): Longint; stdcall;
  5762. var
  5763.   StreamInfo: PRichEditStreamInfo;
  5764. begin
  5765.   Result := NoError;
  5766.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  5767.   try
  5768.     pcb := 0;
  5769.     if StreamInfo^.Converter <> nil then
  5770.       pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
  5771.   except
  5772.     Result := WriteError;
  5773.   end;
  5774. end;
  5775.  
  5776. function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  5777.   cb: Longint; var pcb: Longint): Longint; stdcall;
  5778. var
  5779.   Buffer, pBuff: PChar;
  5780.   StreamInfo: PRichEditStreamInfo;
  5781. begin
  5782.   Result := NoError;
  5783.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  5784.   Buffer := StrAlloc(cb + 1);
  5785.   try
  5786.     cb := cb div 2;
  5787.     pcb := 0;
  5788.     pBuff := Buffer + cb;
  5789.     try
  5790.       if StreamInfo^.Converter <> nil then
  5791.         pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
  5792.       if pcb > 0 then
  5793.       begin
  5794.         pBuff[pcb] := #0;
  5795.         if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
  5796.         pcb := AdjustLineBreaks(Buffer, pBuff);
  5797.         Move(Buffer^, pbBuff^, pcb);
  5798.       end;
  5799.     except
  5800.       Result := ReadError;
  5801.     end;
  5802.   finally
  5803.     StrDispose(Buffer);
  5804.   end;
  5805. end;
  5806.  
  5807. procedure TRichEditStrings.LoadFromStream(Stream: TStream);
  5808. var
  5809.   EditStream: TEditStream;
  5810.   Position: Longint;
  5811.   TextType: Longint;
  5812.   StreamInfo: TRichEditStreamInfo;
  5813.   Converter: TConversion;
  5814. begin
  5815.   StreamInfo.Stream := Stream;
  5816.   if FConverter <> nil then
  5817.     Converter := FConverter else
  5818.     Converter := RichEdit.DefaultConverter.Create;
  5819.   StreamInfo.Converter := Converter;
  5820.   try
  5821.     with EditStream do
  5822.     begin
  5823.       dwCookie := LongInt(Pointer(@StreamInfo));
  5824.       pfnCallBack := @StreamLoad;
  5825.       dwError := 0;
  5826.     end;
  5827.     Position := Stream.Position;
  5828.     if PlainText then TextType := SF_TEXT
  5829.     else TextType := SF_RTF;
  5830.     SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  5831.     if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
  5832.     begin
  5833.       Stream.Position := Position;
  5834.       if PlainText then TextType := SF_RTF
  5835.       else TextType := SF_TEXT;
  5836.       SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  5837.       if EditStream.dwError <> 0 then
  5838.         raise EOutOfResources.CreateRes(sRichEditLoadFail);
  5839.     end;
  5840.   finally
  5841.     if FConverter = nil then Converter.Free;
  5842.   end;
  5843. end;
  5844.  
  5845. procedure TRichEditStrings.SaveToStream(Stream: TStream);
  5846. var
  5847.   EditStream: TEditStream;
  5848.   TextType: Longint;
  5849.   StreamInfo: TRichEditStreamInfo;
  5850.   Converter: TConversion;
  5851. begin
  5852.   if FConverter <> nil then
  5853.     Converter := FConverter else
  5854.     Converter := RichEdit.DefaultConverter.Create;
  5855.   StreamInfo.Stream := Stream;
  5856.   StreamInfo.Converter := Converter;
  5857.   try
  5858.     with EditStream do
  5859.     begin
  5860.       dwCookie := LongInt(Pointer(@StreamInfo));
  5861.       pfnCallBack := @StreamSave;
  5862.       dwError := 0;
  5863.     end;
  5864.     if PlainText then TextType := SF_TEXT
  5865.     else TextType := SF_RTF;
  5866.     SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
  5867.     if EditStream.dwError <> 0 then
  5868.       raise EOutOfResources.CreateRes(sRichEditSaveFail);
  5869.   finally
  5870.     if FConverter = nil then Converter.Free;
  5871.   end;
  5872. end;
  5873.  
  5874. procedure TRichEditStrings.LoadFromFile(const FileName: string);
  5875. var
  5876.   Ext: string;
  5877.   Convert: PConversionFormat;
  5878. begin
  5879.   Ext := LowerCase(Copy(ExtractFileExt(Filename), 2, Maxint));
  5880.   Convert := ConversionFormatList;
  5881.   while Convert <> nil do
  5882.     with Convert^ do
  5883.       if Extension <> Ext then Convert := Next
  5884.       else Break;
  5885.   if Convert = nil then
  5886.     Convert := @TextConversionFormat;
  5887.   FConverter := Convert^.ConversionClass.Create;
  5888.   try
  5889.     inherited LoadFromFile(FileName);
  5890.   except
  5891.     FConverter.Free;
  5892.     FConverter := nil;
  5893.     raise;
  5894.   end;
  5895. end;
  5896.  
  5897. procedure TRichEditStrings.SaveToFile(const FileName: string);
  5898. var
  5899.   Ext: string;
  5900.   Convert: PConversionFormat;
  5901. begin
  5902.   Ext := LowerCase(Copy(ExtractFileExt(Filename), 2, Maxint));
  5903.   Convert := ConversionFormatList;
  5904.   while Convert <> nil do
  5905.     with Convert^ do
  5906.       if Extension <> Ext then Convert := Next
  5907.       else Break;
  5908.   if Convert = nil then
  5909.     Convert := @TextConversionFormat;
  5910.   FConverter := Convert^.ConversionClass.Create;
  5911.   try
  5912.     inherited SaveToFile(FileName);
  5913.   except
  5914.     FConverter.Free;
  5915.     FConverter := nil;
  5916.     raise;
  5917.   end;
  5918. end;
  5919.  
  5920. { TRichEdit }
  5921.  
  5922. constructor TCustomRichEdit.Create(AOwner: TComponent);
  5923. var
  5924.   DC: HDC;
  5925. begin
  5926.   inherited Create(AOwner);
  5927.   FSelAttributes := TTextAttributes.Create(Self, atSelected);
  5928.   FDefAttributes := TTextAttributes.Create(Self, atDefaultText);
  5929.   FParagraph := TParaAttributes.Create(Self);
  5930.   FRichEditStrings := TRichEditStrings.Create;
  5931.   TRichEditStrings(FRichEditStrings).RichEdit := Self;
  5932.   TabStop := True;
  5933.   Width := 185;
  5934.   Height := 89;
  5935.   AutoSize := False;
  5936.   FHideSelection := True;
  5937.   HideScrollBars := True;
  5938.   DC := GetDC(0);
  5939.   FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  5940.   DefaultConverter := TConversion;
  5941.   ReleaseDC(0, DC);
  5942. end;
  5943.  
  5944. destructor TCustomRichEdit.Destroy;
  5945. begin
  5946.   FSelAttributes.Free;
  5947.   FDefAttributes.Free;
  5948.   FParagraph.Free;
  5949.   FRichEditStrings.Free;
  5950.   FMemStream.Free;
  5951.   inherited Destroy;
  5952. end;
  5953.  
  5954. procedure TCustomRichEdit.CreateParams(var Params: TCreateParams);
  5955. const
  5956.   RichEditModuleName = 'RICHED32.DLL';
  5957.   HideScrollBars: array[Boolean] of Longint = (ES_DISABLENOSCROLL, 0);
  5958.   HideSelections: array[Boolean] of Longint = (ES_NOHIDESEL, 0);
  5959. var
  5960.   OldError: Longint;
  5961. begin
  5962.   OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  5963.   FLibHandle := LoadLibrary(RichEditModuleName);
  5964.   if FLibHandle < HINSTANCE_ERROR then FLibHandle := 0;
  5965.   SetErrorMode(OldError);
  5966.   inherited CreateParams(Params);
  5967.   CreateSubClass(Params, 'RICHEDIT');
  5968.   with Params do
  5969.     Style := Style or HideScrollBars[FHideScrollBars] or
  5970.       HideSelections[HideSelection];
  5971. end;
  5972.  
  5973. procedure TCustomRichEdit.CreateWnd;
  5974. var
  5975.   Plain: Boolean;
  5976. begin
  5977.   inherited CreateWnd;
  5978.   SendMessage(Handle, EM_SETEVENTMASK, 0,
  5979.     ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
  5980.     ENM_PROTECTED);
  5981.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
  5982.   if FMemStream <> nil then
  5983.   begin
  5984.     Plain := PlainText;
  5985.     PlainText := False;
  5986.     try
  5987.       Lines.LoadFromStream(FMemStream);
  5988.       FMemStream.Free;
  5989.       FMemStream := nil;
  5990.     finally
  5991.       PlainText := Plain;
  5992.     end;
  5993.   end;
  5994.   Modified := FModified;
  5995. end;
  5996.  
  5997. procedure TCustomRichEdit.DestroyWnd;
  5998. var
  5999.   Plain: Boolean;
  6000. begin
  6001.   FModified := Modified;
  6002.   FMemStream := TMemoryStream.Create;
  6003.   Plain := PlainText;
  6004.   PlainText := False;
  6005.   try
  6006.     Lines.SaveToStream(FMemStream);
  6007.     FMemStream.Position := 0;
  6008.   finally
  6009.     PlainText := Plain;
  6010.   end;
  6011.   inherited DestroyWnd;
  6012. end;
  6013.  
  6014. procedure TCustomRichEdit.WMNCDestroy(var Message: TWMNCDestroy);
  6015. begin
  6016.   inherited;
  6017.   if FLibHandle <> 0 then FreeLibrary(FLibHandle);
  6018. end;
  6019.  
  6020. procedure TCustomRichEdit.WMSetFont(var Message: TWMSetFont);
  6021. begin
  6022.   FDefAttributes.Assign(Font);
  6023. end;
  6024.  
  6025. procedure TCustomRichEdit.CMFontChanged(var Message: TMessage);
  6026. begin
  6027.   FDefAttributes.Assign(Font);
  6028. end;
  6029.  
  6030. procedure TCustomRichEdit.SetHideScrollBars(Value: Boolean);
  6031. begin
  6032.   if HideScrollBars <> Value then
  6033.   begin
  6034.     FHideScrollBars := value;
  6035.     RecreateWnd;
  6036.   end;
  6037. end;
  6038.  
  6039. procedure TCustomRichEdit.SetHideSelection(Value: Boolean);
  6040. begin
  6041.   if HideSelection <> Value then
  6042.   begin
  6043.     FHideSelection := Value;
  6044.     SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LongInt(True));
  6045.   end;
  6046. end;
  6047.  
  6048. procedure TCustomRichEdit.SetSelAttributes(Value: TTextAttributes);
  6049. begin
  6050.   SelAttributes.Assign(Value);
  6051. end;
  6052.  
  6053. procedure TCustomRichEdit.SetDefAttributes(Value: TTextAttributes);
  6054. begin
  6055.   DefAttributes.Assign(Value);
  6056. end;
  6057.  
  6058. function TCustomRichEdit.GetPlainText: Boolean;
  6059. begin
  6060.   Result := TRichEditStrings(Lines).PlainText;
  6061. end;
  6062.  
  6063. procedure TCustomRichEdit.SetPlainText(Value: Boolean);
  6064. begin
  6065.   TRichEditStrings(Lines).PlainText := Value;
  6066. end;
  6067.  
  6068. procedure TCustomRichEdit.CMColorChanged(var Message: TMessage);
  6069. begin
  6070.   inherited;
  6071.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
  6072. end;
  6073.  
  6074. procedure TCustomRichEdit.SetRichEditStrings(Value: TStrings);
  6075. begin
  6076.   FRichEditStrings.Assign(Value);
  6077. end;
  6078.  
  6079. procedure TCustomRichEdit.Print(const Caption: string);
  6080. var
  6081.   Range: TFormatRange;
  6082.   LastChar, MaxLen, LogX, LogY: Integer;
  6083. begin
  6084.   FillChar(Range, SizeOf(TFormatRange), 0);
  6085.   with Printer, Range do
  6086.   begin
  6087.     LogX := GetDeviceCaps(Handle, LOGPIXELSX);
  6088.     LogY := GetDeviceCaps(Handle, LOGPIXELSY);
  6089.     hdc := Handle;
  6090.     hdcTarget := hdc;
  6091.     if IsRectEmpty(PageRect) then
  6092.     begin
  6093.       rc.right := PageWidth * 1440 div LogX;
  6094.       rc.bottom := PageHeight * 1440 div LogY;
  6095.     end
  6096.     else begin
  6097.       rc.left := PageRect.Left * 1440 div LogX;
  6098.       rc.top := PageRect.Top * 1440 div LogY;
  6099.       rc.right := PageRect.Right * 1440 div LogX;
  6100.       rc.bottom := PageRect.Bottom * 1440 div LogY;
  6101.     end;
  6102.     rcPage := rc;
  6103.     Title := Caption;
  6104.     BeginDoc;
  6105.     LastChar := 0;
  6106.     MaxLen := GetTextLen;
  6107.     chrg.cpMax := -1;
  6108.     repeat
  6109.       chrg.cpMin := LastChar;
  6110.       LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  6111.       if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
  6112.     until (LastChar >= MaxLen) or (LastChar = -1);
  6113.     EndDoc;
  6114.   end;
  6115.   SendMessage(Handle, EM_FORMATRANGE, 0, 0);
  6116. end;
  6117.  
  6118. var
  6119.   Painting: Boolean = False;
  6120.  
  6121. procedure TCustomRichEdit.WMPaint(var Message: TWMPaint);
  6122. var
  6123.   R, R1: TRect;
  6124. begin
  6125.   if GetUpdateRect(Handle, R, True) then
  6126.   begin
  6127.     with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
  6128.     if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
  6129.   end;
  6130.   if Painting then
  6131.     Invalidate
  6132.   else begin
  6133.     Painting := True;
  6134.     try
  6135.       inherited;
  6136.     finally
  6137.       Painting := False;
  6138.     end;
  6139.   end;
  6140. end;
  6141.  
  6142. procedure TCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
  6143. var
  6144.   P: TPoint;
  6145. begin
  6146.   inherited;
  6147.   if Message.Result = 0 then
  6148.   begin
  6149.     Message.Result := 1;
  6150.     GetCursorPos(P);
  6151.     with PointToSmallPoint(P) do
  6152.       case Perform(WM_NCHITTEST, 0, MakeLong(X, Y)) of
  6153.         HTVSCROLL,
  6154.         HTHSCROLL:
  6155.           Windows.SetCursor(Screen.Cursors[crArrow]);
  6156.         HTCLIENT:
  6157.           Windows.SetCursor(Screen.Cursors[crIBeam]);
  6158.       end;
  6159.   end;
  6160. end;
  6161.  
  6162. procedure TCustomRichEdit.CNNotify(var Message: TWMNotify);
  6163. begin
  6164.   with Message.NMHdr^ do
  6165.     case code of
  6166.       EN_SELCHANGE: SelectionChange;
  6167.       EN_REQUESTRESIZE: RequestSize(PReqSize(Pointer(Message.NMHdr))^.rc);
  6168.       EN_SAVECLIPBOARD:
  6169.         with PENSaveClipboard(Pointer(Message.NMHdr))^ do
  6170.           if not SaveClipboard(cObjectCount, cch) then Message.Result := 1;
  6171.       EN_PROTECTED:
  6172.         with PENProtected(Pointer(Message.NMHdr))^.chrg do
  6173.           if not ProtectChange(cpMin, cpMax) then Message.Result := 1;
  6174.     end;
  6175. end;
  6176.  
  6177. function TCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
  6178. begin
  6179.   Result := True;
  6180.   if Assigned(OnSaveClipboard) then OnSaveClipboard(Self, NumObj, NumChars, Result);
  6181. end;
  6182.  
  6183. function TCustomRichEdit.ProtectChange(StartPos, EndPos: Integer): Boolean;
  6184. begin
  6185.   Result := False;
  6186.   if Assigned(OnProtectChange) then OnProtectChange(Self, StartPos, EndPos, Result);
  6187. end;
  6188.  
  6189. procedure TCustomRichEdit.SelectionChange;
  6190. begin
  6191.   if Assigned(OnSelectionChange) then OnSelectionChange(Self);
  6192. end;
  6193.  
  6194. procedure TCustomRichEdit.RequestSize(const Rect: TRect);
  6195. begin
  6196.   if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
  6197. end;
  6198.  
  6199. function TCustomRichEdit.FindText(const SearchStr: string;
  6200.   StartPos, Length: Integer; Options: TSearchTypes): Integer;
  6201. var
  6202.   Find: TFindText;
  6203.   Flags: Integer;
  6204. begin
  6205.   with Find.chrg do
  6206.   begin
  6207.     cpMin := StartPos;
  6208.     cpMax := cpMin + Length;
  6209.   end;
  6210.   Flags := 0;
  6211.   if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
  6212.   if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
  6213.   Find.lpstrText := PChar(SearchStr);
  6214.   Result := SendMessage(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
  6215. end;
  6216.  
  6217. procedure AppendConversionFormat(const Ext: string; AClass: TConversionClass);
  6218. var
  6219.   NewRec: PConversionFormat;
  6220. begin
  6221.   New(NewRec);
  6222.   with NewRec^ do
  6223.   begin
  6224.     Extension := LowerCase(Ext);
  6225.     ConversionClass := AClass;
  6226.     Next := ConversionFormatList;
  6227.   end;
  6228.   ConversionFormatList := NewRec;
  6229. end;
  6230.  
  6231. class procedure TCustomRichEdit.RegisterConversionFormat(const AExtension: string;
  6232.   AConversionClass: TConversionClass);
  6233. begin
  6234.   AppendConversionFormat(AExtension, AConversionClass);
  6235. end;
  6236.  
  6237. { TUpDown }
  6238.  
  6239. constructor TCustomUpDown.Create(AOwner: TComponent);
  6240. begin
  6241.   inherited Create(AOwner);
  6242.   Width := GetSystemMetrics(SM_CXVSCROLL);
  6243.   Height := GetSystemMetrics(SM_CYVSCROLL);
  6244.   Height := Height + (Height div 2);
  6245.   FArrowKeys := True;
  6246.   FMax := 100;
  6247.   FIncrement := 1;
  6248.   FAlignButton := udRight;
  6249.   FOrientation := udVertical;
  6250.   FThousands := True;
  6251.   ControlStyle := ControlStyle - [csDoubleClicks];
  6252. end;
  6253.  
  6254. procedure TCustomUpDown.CreateParams(var Params: TCreateParams);
  6255. begin
  6256.   InitCommonControls;
  6257.   inherited CreateParams(Params);
  6258.   with Params do
  6259.   begin
  6260.     Style := Style or UDS_SETBUDDYINT;
  6261.     if FAlignButton = udRight then Style := Style or UDS_ALIGNRIGHT
  6262.     else Style := Style or UDS_ALIGNLEFT;
  6263.     if FOrientation = udHorizontal then Style := Style or UDS_HORZ;
  6264.     if FArrowKeys then Style := Style or UDS_ARROWKEYS;
  6265.     if not FThousands then Style := Style or UDS_NOTHOUSANDS;
  6266.     if FWrap then Style := Style or UDS_WRAP;
  6267.   end;
  6268.   CreateSubClass(Params, UPDOWN_CLASS);
  6269.   Params.WindowClass.style := Params.WindowClass.style or CS_DBLCLKS;
  6270. end;
  6271.  
  6272. procedure TCustomUpDown.CreateWnd;
  6273. var
  6274.   OrigWidth: Integer;
  6275.   AccelArray: array [0..0] of TUDAccel;
  6276. begin
  6277.   OrigWidth := Width;  { control resizes width - disallowing user to set width }
  6278.   inherited CreateWnd;
  6279.   Width := OrigWidth;
  6280.   SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6281.   SendMessage(Handle, UDM_SETPOS, 0, MakeLong(FPosition, 0));
  6282.   SendMessage(Handle, UDM_GETACCEL, 1, Longint(@AccelArray));
  6283.   AccelArray[0].nInc := FIncrement;
  6284.   SendMessage(Handle, UDM_SETACCEL, 1, Longint(@AccelArray));
  6285.  
  6286.   if FAssociate <> nil then
  6287.   begin
  6288.     UndoAutoResizing(FAssociate);
  6289.     SendMessage(Handle, UDM_SETBUDDY, FAssociate.Handle, 0);
  6290.   end;
  6291. end;
  6292.  
  6293. procedure TCustomUpDown.WMVScroll(var Message: TWMVScroll);
  6294. begin
  6295.   inherited;
  6296.   if Message.ScrollCode = SB_THUMBPOSITION then
  6297.   begin
  6298.     if Message.Pos > FPosition then Click(btNext)
  6299.     else if Message.Pos < FPosition then Click(btPrev);
  6300.     FPosition := Message.Pos;
  6301.   end;
  6302. end;
  6303.  
  6304. procedure TCustomUpDown.WMHScroll(var Message: TWMHScroll);
  6305. begin
  6306.   inherited;
  6307.   if Message.ScrollCode = SB_THUMBPOSITION then
  6308.   begin
  6309.     if Message.Pos > FPosition then Click(btNext)
  6310.     else if Message.Pos < FPosition then Click(btPrev);
  6311.     FPosition := Message.Pos;
  6312.   end;
  6313. end;
  6314.  
  6315. function TCustomUpDown.CanChange: Boolean;
  6316. begin
  6317.   Result := True;
  6318.   if Assigned(FOnChanging) then
  6319.     FOnChanging(Self, Result);
  6320. end;
  6321.  
  6322. procedure TCustomUpDown.CNNotify(var Message: TWMNotify);
  6323. begin
  6324.   with Message.NMHdr^ do
  6325.   begin
  6326.     case code of
  6327.       UDN_DELTAPOS: LongBool(Message.Result) := not CanChange;
  6328.     end;
  6329.   end;
  6330. end;
  6331.  
  6332. procedure TCustomUpDown.Click(Button: TUDBtnType);
  6333. begin
  6334.   if Assigned(FOnClick) then FOnClick(Self, Button);
  6335. end;
  6336.  
  6337. procedure TCustomUpDown.SetAssociate(Value: TWinControl);
  6338. var
  6339.   I: Integer;
  6340.  
  6341.   function IsClass(ClassType: TClass; const Name: string): Boolean;
  6342.   begin
  6343.     Result := True;
  6344.     while ClassType <> nil do
  6345.     begin
  6346.       if ClassType.ClassNameIs(Name) then Exit;
  6347.       ClassType := ClassType.ClassParent;
  6348.     end;
  6349.     Result := False;
  6350.   end;
  6351.  
  6352. begin
  6353.   for I := 0 to Parent.ControlCount - 1 do
  6354.     if (Parent.Controls[I] is TCustomUpDown) and (Parent.Controls[I] <> Self) then
  6355.       if TCustomUpDown(Parent.Controls[I]).Associate = Value then
  6356.         raise Exception.CreateResFmt(sUDAssociated,
  6357.           [Value.Name, Parent.Controls[I].Name]);
  6358.  
  6359.   if FAssociate <> nil then { undo the current associate control }
  6360.   begin
  6361.     if HandleAllocated then
  6362.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6363.     FAssociate := nil;
  6364.   end;
  6365.  
  6366.   if (Value <> nil) and (Value.Parent = Self.Parent) and
  6367.     not (Value is TCustomUpDown) and
  6368.     not (Value is TCustomTreeView) and not (Value is TCustomListView) and
  6369.     not IsClass(Value.ClassType, 'TDBEdit') and
  6370.     not IsClass(Value.ClassType, 'TDBMemo') then
  6371.   begin
  6372.     if HandleAllocated then
  6373.     begin
  6374.       UndoAutoResizing(Value);
  6375.       SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
  6376.     end;
  6377.     FAssociate := Value;
  6378.     if Value is TCustomEdit then
  6379.       TCustomEdit(Value).Text := IntToStr(FPosition);
  6380.   end;
  6381. end;
  6382.  
  6383. procedure TCustomUpDown.UndoAutoResizing(Value: TWinControl);
  6384. var
  6385.   OrigWidth, NewWidth, DeltaWidth: Integer;
  6386.   OrigLeft, NewLeft, DeltaLeft: Integer;
  6387. begin
  6388.   { undo Window's auto-resizing }
  6389.   OrigWidth := Value.Width;
  6390.   OrigLeft := Value.Left;
  6391.   SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
  6392.   NewWidth := Value.Width;
  6393.   NewLeft := Value.Left;
  6394.   DeltaWidth := OrigWidth - NewWidth;
  6395.   DeltaLeft := NewLeft - OrigLeft;
  6396.   Value.Width := OrigWidth + DeltaWidth;
  6397.   Value.Left := OrigLeft - DeltaLeft;
  6398. end;
  6399.  
  6400. procedure TCustomUpDown.Notification(AComponent: TComponent;
  6401.   Operation: TOperation);
  6402. begin
  6403.   inherited Notification(AComponent, Operation);
  6404.   if (Operation = opRemove) and (AComponent = FAssociate) then
  6405.     if HandleAllocated then
  6406.     begin
  6407.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6408.       FAssociate := nil;
  6409.     end;
  6410. end;
  6411.  
  6412. function TCustomUpDown.GetPosition: SmallInt;
  6413. begin
  6414.   if HandleAllocated then
  6415.   begin
  6416.     Result := LoWord(SendMessage(Handle, UDM_GETPOS, 0, 0));
  6417.     FPosition := Result;
  6418.   end
  6419.   else Result := FPosition;
  6420. end;
  6421.  
  6422. procedure TCustomUpDown.SetMin(Value: SmallInt);
  6423. begin
  6424.   if Value <> FMin then
  6425.   begin
  6426.     FMin := Value;
  6427.     if HandleAllocated then
  6428.       SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6429.   end;
  6430. end;
  6431.  
  6432. procedure TCustomUpDown.SetMax(Value: SmallInt);
  6433. begin
  6434.   if Value <> FMax then
  6435.   begin
  6436.     FMax := Value;
  6437.     if HandleAllocated then
  6438.       SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6439.   end;
  6440. end;
  6441.  
  6442. procedure TCustomUpDown.SetIncrement(Value: Integer);
  6443. var
  6444.   AccelArray: array [0..0] of TUDAccel;
  6445. begin
  6446.   if Value <> FIncrement then
  6447.   begin
  6448.     FIncrement := Value;
  6449.     if HandleAllocated then
  6450.     begin
  6451.       SendMessage(Handle, UDM_GETACCEL, 1, Longint(@AccelArray));
  6452.       AccelArray[0].nInc := Value;
  6453.       SendMessage(Handle, UDM_SETACCEL, 1, Longint(@AccelArray));
  6454.     end;
  6455.   end;
  6456. end;
  6457.  
  6458. procedure TCustomUpDown.SetPosition(Value: SmallInt);
  6459. begin
  6460.   if Value <> FPosition then
  6461.   begin
  6462.     FPosition := Value;
  6463.     if (csDesigning in ComponentState) and (FAssociate <> nil) then
  6464.       if FAssociate is TCustomEdit then
  6465.         TCustomEdit(FAssociate).Text := IntToStr(FPosition);
  6466.     if HandleAllocated then
  6467.       SendMessage(Handle, UDM_SETPOS, 0, MakeLong(FPosition, 0));
  6468.   end;
  6469. end;
  6470.  
  6471. procedure TCustomUpDown.SetOrientation(Value: TUDOrientation);
  6472. begin
  6473.   if Value <> FOrientation then
  6474.   begin
  6475.     FOrientation := Value;
  6476.     if ComponentState * [csLoading, csUpdating] = [] then
  6477.       SetBounds(Left, Top, Height, Width);
  6478.     if HandleAllocated then
  6479.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6480.     RecreateWnd;
  6481.   end;
  6482. end;
  6483.  
  6484. procedure TCustomUpDown.SetAlignButton(Value: TUDAlignButton);
  6485. begin
  6486.   if Value <> FAlignButton then
  6487.   begin
  6488.     FAlignButton := Value;
  6489.     if HandleAllocated then
  6490.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6491.     RecreateWnd;
  6492.   end;
  6493. end;
  6494.  
  6495. procedure TCustomUpDown.SetArrowKeys(Value: Boolean);
  6496. begin
  6497.   if Value <> FArrowKeys then
  6498.   begin
  6499.     FArrowKeys := Value;
  6500.     if HandleAllocated then
  6501.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6502.     RecreateWnd;
  6503.   end;
  6504. end;
  6505.  
  6506. procedure TCustomUpDown.SetThousands(Value: Boolean);
  6507. begin
  6508.   if Value <> FThousands then
  6509.   begin
  6510.     FThousands := Value;
  6511.     if HandleAllocated then
  6512.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6513.     RecreateWnd;
  6514.   end;
  6515. end;
  6516.  
  6517. procedure TCustomUpDown.SetWrap(Value: Boolean);
  6518. begin
  6519.   if Value <> FWrap then
  6520.   begin
  6521.     FWrap := Value;
  6522.     if HandleAllocated then
  6523.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6524.     RecreateWnd;
  6525.   end;
  6526. end;
  6527.  
  6528. { THotKey }
  6529.  
  6530. constructor TCustomHotKey.Create(AOwner: TComponent);
  6531. begin
  6532.   inherited Create(AOwner);
  6533.   Width := 121;
  6534.   Height := 25;
  6535.   TabStop := True;
  6536.   ParentColor := False;
  6537.   FAutoSize := True;
  6538.   FInvalidKeys := [hcNone, hcShift];
  6539.   FModifiers := [hkAlt];
  6540.   FHotKey := $0041;     // default - 'Alt+A'
  6541.   AdjustHeight;
  6542. end;
  6543.  
  6544. procedure TCustomHotKey.CreateParams(var Params: TCreateParams);
  6545. begin
  6546.   InitCommonControls;
  6547.   inherited CreateParams(Params);
  6548.   CreateSubClass(Params, HOTKEYCLASS);
  6549. end;
  6550.  
  6551. procedure TCustomHotKey.CreateWnd;
  6552. begin
  6553.   inherited CreateWnd;
  6554.   SendMessage(Handle, HKM_SETRULES, Byte(FInvalidKeys), MakeLong(Byte(FModifiers), 0));
  6555.   SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6556. end;
  6557.  
  6558. procedure TCustomHotKey.SetAutoSize(Value: Boolean);
  6559. begin
  6560.   if FAutoSize <> Value then
  6561.   begin
  6562.     FAutoSize := Value;
  6563.     UpdateHeight;
  6564.   end;
  6565. end;
  6566.  
  6567. procedure TCustomHotKey.SetModifiers(Value: THKModifiers);
  6568. begin
  6569.   if Value <> FModifiers then
  6570.   begin
  6571.     FModifiers := Value;
  6572.     SendMessage(Handle, HKM_SETRULES, Byte(FInvalidKeys), MakeLong(Byte(Value), 0));
  6573.     SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6574.   end;
  6575. end;
  6576.  
  6577. procedure TCustomHotKey.SetInvalidKeys(Value: THKInvalidKeys);
  6578. begin
  6579.   if Value <> FInvalidKeys then
  6580.   begin
  6581.     FInvalidKeys := Value;
  6582.     SendMessage(Handle, HKM_SETRULES, Byte(Value), MakeLong(Byte(FModifiers), 0));
  6583.     SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6584.   end;
  6585. end;
  6586.  
  6587. function TCustomHotKey.GetHotKey: TShortCut;
  6588. var
  6589.   HK: Longint;
  6590. begin
  6591.   HK := SendMessage(Handle, HKM_GETHOTKEY, 0, 0);
  6592.   Result := HotKeyToShortCut(HK);
  6593. end;
  6594.  
  6595. procedure TCustomHotKey.SetHotKey(Value: TShortCut);
  6596. begin
  6597.   ShortCutToHotKey(Value);
  6598.   SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6599. end;
  6600.  
  6601. procedure TCustomHotKey.UpdateHeight;
  6602. begin
  6603.   if FAutoSize then
  6604.   begin
  6605.     ControlStyle := ControlStyle + [csFixedHeight];
  6606.     AdjustHeight;
  6607.   end else
  6608.     ControlStyle := ControlStyle - [csFixedHeight];
  6609. end;
  6610.  
  6611. procedure TCustomHotKey.AdjustHeight;
  6612. var
  6613.   DC: HDC;
  6614.   SaveFont: HFont;
  6615.   I: Integer;
  6616.   SysMetrics, Metrics: TTextMetric;
  6617. begin
  6618.   DC := GetDC(0);
  6619.   GetTextMetrics(DC, SysMetrics);
  6620.   SaveFont := SelectObject(DC, Font.Handle);
  6621.   GetTextMetrics(DC, Metrics);
  6622.   SelectObject(DC, SaveFont);
  6623.   ReleaseDC(0, DC);
  6624.   if NewStyleControls then
  6625.   begin
  6626.     if Ctl3D then I := 8 else I := 6;
  6627.     I := GetSystemMetrics(SM_CYBORDER) * I;
  6628.   end else
  6629.   begin
  6630.     I := SysMetrics.tmHeight;
  6631.     if I > Metrics.tmHeight then I := Metrics.tmHeight;
  6632.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  6633.   end;
  6634.   Height := Metrics.tmHeight + I;
  6635. end;
  6636.  
  6637. procedure TCustomHotKey.ShortCutToHotKey(Value: TShortCut);
  6638. begin
  6639.   FHotKey := Value and not (scShift + scCtrl + scAlt);
  6640.   FModifiers := [];
  6641.   if Value and scShift <> 0 then Include(FModifiers, hkShift);
  6642.   if Value and scCtrl <> 0 then Include(FModifiers, hkCtrl);
  6643.   if Value and scAlt <> 0 then Include(FModifiers, hkAlt);
  6644. end;
  6645.  
  6646. function TCustomHotKey.HotKeyToShortCut(Value: Longint): TShortCut;
  6647. begin
  6648.   Byte(FModifiers) := LoWord(HiByte(Value));
  6649.   FHotKey := LoWord(LoByte(Value));
  6650.   Result := FHotKey;
  6651.   if hkShift in FModifiers then Inc(Result, scShift);
  6652.   if hkCtrl in FModifiers then Inc(Result, scCtrl);
  6653.   if hkAlt in FModifiers then Inc(Result, scAlt);
  6654. end;
  6655.  
  6656. { TListColumn }
  6657.  
  6658. constructor TListColumn.Create(Collection: TCollection);
  6659. var
  6660.   Column: TLVColumn;
  6661. begin
  6662.   inherited Create(Collection);
  6663.   FWidth := 50;
  6664.   FAlignment := taLeftJustify;
  6665.   with Column do
  6666.   begin
  6667.     mask := LVCF_FMT or LVCF_WIDTH;
  6668.     fmt := LVCFMT_LEFT;
  6669.     cx := FWidth;
  6670.   end;
  6671.   ListView_InsertColumn(TListColumns(Collection).Owner.Handle, Index, Column);
  6672. end;
  6673.  
  6674. destructor TListColumn.Destroy;
  6675. begin
  6676.   if TListColumns(Collection).Owner.HandleAllocated then
  6677.     ListView_DeleteColumn(TListColumns(Collection).Owner.Handle, Index);
  6678.   inherited Destroy;
  6679. end;
  6680.  
  6681. procedure TListColumn.DefineProperties(Filer: TFiler);
  6682. begin
  6683.   inherited DefineProperties(Filer);
  6684.   Filer.DefineProperty('WidthType', ReadData, WriteData,
  6685.     WidthType <= ColumnTextWidth);
  6686. end;
  6687.  
  6688. procedure TListColumn.ReadData(Reader: TReader);
  6689. begin
  6690.   with Reader do
  6691.   begin
  6692.     ReadListBegin;
  6693.     Width := TWidth(ReadInteger);
  6694.     ReadListEnd;
  6695.   end;
  6696. end;
  6697.  
  6698. procedure TListColumn.WriteData(Writer: TWriter);
  6699. begin
  6700.   with Writer do
  6701.   begin
  6702.     WriteListBegin;
  6703.     WriteInteger(Ord(WidthType));
  6704.     WriteListEnd;
  6705.   end;
  6706. end;
  6707.  
  6708. procedure TListColumn.DoChange;
  6709. var
  6710.   I: Integer;
  6711. begin
  6712.   for I := 0 to Collection.Count - 1 do
  6713.     if TListColumn(Collection.Items[I]).WidthType <= ColumnTextWidth then Break;
  6714.   Changed(I <> Collection.Count);
  6715. end;
  6716.  
  6717. procedure TListColumn.SetCaption(const Value: string);
  6718. begin
  6719.   if FCaption <> Value then
  6720.   begin
  6721.     FCaption := Value;
  6722.     DoChange;
  6723.   end;
  6724. end;
  6725.  
  6726. function TListColumn.GetWidth: TWidth;
  6727. var
  6728.   Column: TLVColumn;
  6729.   ListView: TCustomListView;
  6730. begin
  6731.   ListView := TListColumns(Collection).Owner;
  6732.   if ListView.HandleAllocated then
  6733.   begin
  6734.     Column.mask := LVCF_WIDTH;
  6735.     ListView_GetColumn(ListView.Handle, Index, Column);
  6736.     Result := Column.cx;
  6737.     if WidthType > ColumnTextWidth then FWidth := Result;
  6738.   end
  6739.   else Result := 0;
  6740. end;
  6741.  
  6742. procedure TListColumn.SetWidth(Value: TWidth);
  6743. begin
  6744.   if Width <> Value then
  6745.   begin
  6746.     FWidth := Value;
  6747.     DoChange;
  6748.   end;
  6749. end;
  6750.  
  6751. procedure TListColumn.SetAlignment(Value: TAlignment);
  6752. begin
  6753.   if (Alignment <> Value) and (Index <> 0) then
  6754.   begin
  6755.     FAlignment := Value;
  6756.     Changed(False);
  6757.     TListColumns(Collection).Owner.Repaint;
  6758.   end;
  6759. end;
  6760.  
  6761. procedure TListColumn.Assign(Source: TPersistent);
  6762. var
  6763.   Column: TListColumn;
  6764. begin
  6765.   if Source is TListColumn then
  6766.   begin
  6767.     Column := TListColumn(Source);
  6768.     Alignment := Column.Alignment;
  6769.     Width := Column.Width;
  6770.     Caption := Column.Caption;
  6771.   end
  6772.   else inherited Assign(Source);
  6773. end;
  6774.  
  6775. { TListColumns }
  6776.  
  6777. constructor TListColumns.Create(AOwner: TCustomListView);
  6778. begin
  6779.   inherited Create(TListColumn);
  6780.   FOwner := AOwner;
  6781. end;
  6782.  
  6783. function TListColumns.GetItem(Index: Integer): TListColumn;
  6784. begin
  6785.   Result := TListColumn(inherited GetItem(Index));
  6786. end;
  6787.  
  6788. procedure TListColumns.SetItem(Index: Integer; Value: TListColumn);
  6789. begin
  6790.   inherited SetItem(Index, Value);
  6791. end;
  6792.  
  6793. function TListColumns.Add: TListColumn;
  6794. begin
  6795.   Result := TListColumn(inherited Add);
  6796. end;
  6797.  
  6798. procedure TListColumns.Update(Item: TCollectionItem);
  6799. begin
  6800.   if Item <> nil then Owner.UpdateColumn(Item.Index)
  6801.   else Owner.UpdateColumns;
  6802. end;
  6803.  
  6804. { TSubItems }
  6805.  
  6806. type
  6807.   TSubItems = class(TStringList)
  6808.   private
  6809.     FOwner: TListItem;
  6810.     procedure SetColumnWidth(Index: Integer);
  6811.   protected
  6812.     function GetHandle: HWND;
  6813.     procedure SetUpdateState(Updating: Boolean); override;
  6814.   public
  6815.     constructor Create(AOwner: TListItem);
  6816.     function Add(const S: string): Integer; override;
  6817.     procedure Insert(Index: Integer; const S: string); override;
  6818.     property Handle: HWND read GetHandle;
  6819.     property Owner: TListItem read FOwner;
  6820.   end;
  6821.  
  6822. constructor TSubItems.Create(AOwner: TListItem);
  6823. begin
  6824.   inherited Create;
  6825.   FOwner := AOwner;
  6826. end;
  6827.  
  6828. function TSubItems.GetHandle: HWND;
  6829. begin
  6830.   Result := Owner.Owner.Handle;
  6831. end;
  6832.  
  6833. procedure TSubItems.SetColumnWidth(Index: Integer);
  6834. var
  6835.   ListView: TCustomListView;
  6836. begin
  6837.   ListView := Owner.ListView;
  6838.   if ListView.ColumnsShowing and
  6839.     (ListView.Columns.Count > Index) and
  6840.     (ListView.Column[Index].WidthType = ColumnTextWidth) then
  6841.     ListView.UpdateColumn(Index);
  6842. end;
  6843.  
  6844. function TSubItems.Add(const S: string): Integer;
  6845. begin
  6846.   Result := inherited Add(S);
  6847.   ListView_SetItemText(Handle, Owner.Index, Count, LPSTR_TEXTCALLBACK);
  6848.   SetColumnWidth(Count);
  6849. end;
  6850.  
  6851. procedure TSubItems.Insert(Index: Integer; const S: string);
  6852. begin
  6853.   inherited Insert(Index, S);
  6854.   ListView_SetItemText(Handle, Owner.Index, Index + 1, LPSTR_TEXTCALLBACK);
  6855.   SetColumnWidth(Index + 1);
  6856. end;
  6857.  
  6858. procedure TSubItems.SetUpdateState(Updating: Boolean);
  6859. begin
  6860.   Owner.Owner.SetUpdateState(Updating);
  6861. end;
  6862.  
  6863. { TListItem }
  6864.  
  6865. constructor TListItem.Create(AOwner: TListItems);
  6866. begin
  6867.   FOwner := AOwner;
  6868.   FSubItems := TSubItems.Create(Self);
  6869.   FOverlayIndex := -1;
  6870.   FStateIndex := -1;
  6871. end;
  6872.  
  6873. destructor TListItem.Destroy;
  6874. begin
  6875.   FDeleting := True;
  6876.   if ListView.HandleAllocated then ListView_DeleteItem(Handle, Index);
  6877.   FSubItems.Free;
  6878.   inherited Destroy;
  6879. end;
  6880.  
  6881. function TListItem.GetListView: TCustomListView;
  6882. begin
  6883.   Result := Owner.Owner;
  6884. end;
  6885.  
  6886. procedure TListItem.Delete;
  6887. begin
  6888.   if not FDeleting then Free;
  6889. end;
  6890.  
  6891. function TListItem.GetHandle: HWND;
  6892. begin
  6893.   Result := ListView.Handle;
  6894. end;
  6895.  
  6896. procedure TListItem.MakeVisible(PartialOK: Boolean);
  6897. begin
  6898.   ListView_EnsureVisible(Handle, Index, PartialOK);
  6899. end;
  6900.  
  6901. function TListItem.GetLeft: Integer;
  6902. begin
  6903.   Result := GetPosition.X;
  6904. end;
  6905.  
  6906. procedure TListItem.SetLeft(Value: Integer);
  6907. begin
  6908.   SetPosition(Point(Value, 0));
  6909. end;
  6910.  
  6911. function TListItem.GetTop: Integer;
  6912. begin
  6913.   Result := GetPosition.Y;
  6914. end;
  6915.  
  6916. procedure TListItem.SetTop(Value: Integer);
  6917. begin
  6918.   SetPosition(Point(0, Value));
  6919. end;
  6920.  
  6921. procedure TListItem.Update;
  6922. begin
  6923.   ListView_Update(Handle, Index);
  6924. end;
  6925.  
  6926. procedure TListItem.SetCaption(const Value: string);
  6927. begin
  6928.   FCaption := Value;
  6929.   ListView_SetItemText(Handle, Index, 0, LPSTR_TEXTCALLBACK);
  6930.   if ListView.ColumnsShowing and
  6931.     (ListView.Columns.Count > 0) and
  6932.     (ListView.Column[0].WidthType <= ColumnTextWidth) then
  6933.     ListView.UpdateColumns;
  6934.   if ListView.SortType in [stBoth, stText] then ListView.AlphaSort;
  6935. end;
  6936.  
  6937. procedure TListItem.SetData(Value: Pointer);
  6938. begin
  6939.   FData := Value;
  6940.   if ListView.SortType in [stBoth, stData] then ListView.AlphaSort;
  6941. end;
  6942.  
  6943. function TListItem.EditCaption: Boolean;
  6944. begin
  6945.   Result := ListView_EditLabel(Handle, Index) <> 0;
  6946. end;
  6947.  
  6948. procedure TListItem.CancelEdit;
  6949. begin
  6950.   ListView_EditLabel(Handle, -1);
  6951. end;
  6952.  
  6953. function TListItem.GetState(Index: Integer): Boolean;
  6954. var
  6955.   Mask: Integer;
  6956. begin
  6957.   case Index of
  6958.     0: Mask := LVIS_CUT;
  6959.     1: Mask := LVIS_DROPHILITED;
  6960.     2: Mask := LVIS_FOCUSED;
  6961.     3: Mask := LVIS_SELECTED;
  6962.   end;
  6963.   Result := ListView_GetItemState(Handle, Self.Index, Mask) and Mask <> 0;
  6964. end;
  6965.  
  6966. procedure TListItem.SetState(Index: Integer; State: Boolean);
  6967. var
  6968.   Mask: Integer;
  6969.   Data: Integer;
  6970. begin
  6971.   case Index of
  6972.     0: Mask := LVIS_CUT;
  6973.     1: Mask := LVIS_DROPHILITED;
  6974.     2: Mask := LVIS_FOCUSED;
  6975.     3: Mask := LVIS_SELECTED;
  6976.   end;
  6977.   if State then Data := Mask
  6978.   else Data := 0;
  6979.   ListView_SetItemState(Handle, Self.Index, Data, Mask);
  6980. end;
  6981.  
  6982. procedure TListItem.SetImage(Index: Integer; Value: Integer);
  6983. var
  6984.   Item: TLVItem;
  6985. begin
  6986.   case Index of
  6987.     0:
  6988.       begin
  6989.         FImageIndex := Value;
  6990.         with Item do
  6991.         begin
  6992.           mask := LVIF_IMAGE;
  6993.           iImage := I_IMAGECALLBACK;
  6994.           iItem := Self.Index;
  6995.           iSubItem := 0;
  6996.         end;
  6997.         ListView_SetItem(Handle, Item);
  6998.       end;
  6999.     1:
  7000.       begin
  7001.         FOverlayIndex := Value;
  7002.         ListView_SetItemState(Handle, Self.Index,
  7003.           IndexToOverlayMask(OverlayIndex + 1), LVIS_OVERLAYMASK);
  7004.       end;
  7005.     2:
  7006.       begin
  7007.         FStateIndex := Value;
  7008.         ListView_SetItemState(Handle, Self.Index,
  7009.           IndexToStateImageMask(StateIndex + 1), LVIS_STATEIMAGEMASK);
  7010.       end;
  7011.   end;
  7012.   ListView.UpdateItems(Self.Index, Self.Index);
  7013. end;
  7014.  
  7015. procedure TListItem.Assign(Source: TPersistent);
  7016. begin
  7017.   if Source is TListItem then
  7018.     with Source as TListItem do
  7019.     begin
  7020.       Self.Caption := Caption;
  7021.       Self.Data := Data;
  7022.       Self.ImageIndex := ImageIndex;
  7023.       Self.OverlayIndex := OverlayIndex;
  7024.       Self.StateIndex := StateIndex;
  7025.       Self.SubItems := SubItems;
  7026.     end
  7027.   else inherited Assign(Source);
  7028. end;
  7029.  
  7030. function TListItem.IsEqual(Item: TListItem): Boolean;
  7031. begin
  7032.   Result := (Caption = Item.Caption) and (Data = Item.Data);
  7033. end;
  7034.  
  7035. procedure TListItem.SetSubItems(Value: TStrings);
  7036. begin
  7037.   if Value <> nil then FSubItems.Assign(Value);
  7038. end;
  7039.  
  7040. function TListItem.GetIndex: Integer;
  7041. begin
  7042.   Result := Owner.IndexOf(Self);
  7043. end;
  7044.  
  7045. function TListItem.GetPosition: TPoint;
  7046. begin
  7047.   ListView_GetItemPosition(Handle, Index, Result);
  7048. end;
  7049.  
  7050. procedure TListItem.SetPosition(const Value: TPoint);
  7051. begin
  7052.   if ListView.ViewStyle in [vsSmallIcon, vsIcon] then
  7053.     ListView_SetItemPosition32(Handle, Index, Value.X, Value.Y);
  7054. end;
  7055.  
  7056. function TListItem.DisplayRect(Code: TDisplayCode): TRect;
  7057. const
  7058.   Codes: array[TDisplayCode] of Longint = (LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL,
  7059.     LVIR_SELECTBOUNDS);
  7060. begin
  7061.   ListView_GetItemRect(Handle, Index, Result, Codes[Code]);
  7062. end;
  7063.  
  7064. { TListItems }
  7065.  
  7066. type
  7067.   PItemHeader = ^TItemHeader;
  7068.   TItemHeader = packed record
  7069.     Size, Count: Integer;
  7070.     Items: record end;
  7071.   end;
  7072.   PItemInfo = ^TItemInfo;
  7073.   TItemInfo = packed record
  7074.     ImageIndex: Integer;
  7075.     StateIndex: Integer;
  7076.     OverlayIndex: Integer;
  7077.     SubItemCount: Integer;
  7078.     Data: Pointer;
  7079.     Caption: string[255];
  7080.   end;
  7081.   ShortStr = string[255];
  7082.   PShortStr = ^ShortStr;
  7083.  
  7084. constructor TListItems.Create(AOwner: TCustomListView);
  7085. begin
  7086.   inherited Create;
  7087.   FOwner := AOwner;
  7088. end;
  7089.  
  7090. destructor TListItems.Destroy;
  7091. begin
  7092.   Clear;
  7093.   inherited Destroy;
  7094. end;
  7095.  
  7096. function TListItems.Add: TListItem;
  7097. begin
  7098.   Result := Owner.CreateListItem;
  7099.   ListView_InsertItem(Handle, CreateItem(Count, Result));
  7100. end;
  7101.  
  7102. function TListItems.Insert(Index: Integer): TListItem;
  7103. begin
  7104.   Result := Owner.CreateListItem;
  7105.   ListView_InsertItem(Handle, CreateItem(Index, Result));
  7106. end;
  7107.  
  7108. function TListItems.GetCount: Integer;
  7109. begin
  7110.   if Owner.HandleAllocated then Result := ListView_GetItemCount(Handle)
  7111.   else Result := 0;
  7112. end;
  7113.  
  7114. function TListItems.GetHandle: HWND;
  7115. begin
  7116.   Result := Owner.Handle;
  7117. end;
  7118.  
  7119. function TListItems.GetItem(Index: Integer): TListItem;
  7120. var
  7121.   Item: TLVItem;
  7122. begin
  7123.   Result := nil;
  7124.   if Owner.HandleAllocated then
  7125.   begin
  7126.     with Item do
  7127.     begin
  7128.       mask := LVIF_PARAM;
  7129.       iItem := Index;
  7130.       iSubItem := 0;
  7131.     end;
  7132.     if ListView_GetItem(Handle, Item) then Result := TListItem(Item.lParam);
  7133.   end;
  7134. end;
  7135.  
  7136. function TListItems.IndexOf(Value: TListItem): Integer;
  7137. var
  7138.   Info: TLVFindInfo;
  7139. begin
  7140.   with Info do
  7141.   begin
  7142.     flags := LVFI_PARAM;
  7143.     lParam := Integer(Value);
  7144.   end;
  7145.   Result := ListView_FindItem(Handle, -1, Info);
  7146. end;
  7147.  
  7148. procedure TListItems.SetItem(Index: Integer; Value: TListItem);
  7149. begin
  7150.   Item[Index].Assign(Value);
  7151. end;
  7152.  
  7153. procedure TListItems.Clear;
  7154. begin
  7155.   if Owner.HandleAllocated then ListView_DeleteAllItems(Handle);
  7156. end;
  7157.  
  7158. procedure TListItems.BeginUpdate;
  7159. begin
  7160.   if FUpdateCount = 0 then SetUpdateState(True);
  7161.   Inc(FUpdateCount);
  7162. end;
  7163.  
  7164. procedure TListItems.SetUpdateState(Updating: Boolean);
  7165. begin
  7166.   if Updating then
  7167.   begin
  7168.     SendMessage(Handle, WM_SETREDRAW, 0, 0);
  7169.     if Owner.ColumnsShowing and Owner.ValidHeaderHandle then
  7170.       SendMessage(Owner.FHeaderHandle, WM_SETREDRAW, 0, 0);
  7171.   end
  7172.   else if FUpdateCount = 0 then
  7173.   begin
  7174.     FNoRedraw := True;
  7175.     try
  7176.       SendMessage(Handle, WM_SETREDRAW, 1, 0);
  7177.       Owner.Invalidate;
  7178.     finally
  7179.       FNoRedraw := False;
  7180.     end;
  7181.     if Owner.ColumnsShowing and Owner.ValidHeaderHandle then
  7182.       SendMessage(Owner.FHeaderHandle, WM_SETREDRAW, 1, 0);
  7183.   end;
  7184. end;
  7185.  
  7186. procedure TListItems.EndUpdate;
  7187. begin
  7188.   Dec(FUpdateCount);
  7189.   if FUpdateCount = 0 then SetUpdateState(False);
  7190. end;
  7191.  
  7192. procedure TListItems.Assign(Source: TPersistent);
  7193. var
  7194.   Items: TListItems;
  7195.   I: Integer;
  7196. begin
  7197.   if Source is TListItems then
  7198.   begin
  7199.     Clear;
  7200.     Items := TListItems(Source);
  7201.     for I := 0 to Items.Count - 1 do Add.Assign(Items[I]);
  7202.   end
  7203.   else inherited Assign(Source);
  7204. end;
  7205.  
  7206. procedure TListItems.DefineProperties(Filer: TFiler);
  7207.  
  7208.   function WriteItems: Boolean;
  7209.   var
  7210.     I: Integer;
  7211.     Items: TListItems;
  7212.   begin
  7213.     Items := TListItems(Filer.Ancestor);
  7214.     if (Items <> nil) and (Items.Count = Count) then
  7215.       for I := 0 to Count - 1 do
  7216.       begin
  7217.         Result := not Item[I].IsEqual(Items[I]);
  7218.         if Result then Break;
  7219.       end
  7220.     else Result := Count > 0;
  7221.   end;
  7222.  
  7223. begin
  7224.   inherited DefineProperties(Filer);
  7225.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteItems);
  7226. end;
  7227.  
  7228. procedure TListItems.ReadData(Stream: TStream);
  7229. var
  7230.   I, J, Size, L, Len: Integer;
  7231.   ItemHeader: PItemHeader;
  7232.   ItemInfo: PItemInfo;
  7233.   PStr: PShortStr;
  7234. begin
  7235.   Clear;
  7236.   Stream.ReadBuffer(Size, SizeOf(Integer));
  7237.   ItemHeader := AllocMem(Size);
  7238.   try
  7239.     Stream.ReadBuffer(ItemHeader^.Count, Size - SizeOf(Integer));
  7240.     ItemInfo := @ItemHeader^.Items;
  7241.     for I := 0 to ItemHeader^.Count - 1 do
  7242.     begin
  7243.       with Add do
  7244.       begin
  7245.         Caption := ItemInfo^.Caption;
  7246.         ImageIndex := ItemInfo^.ImageIndex;
  7247.         OverlayIndex := ItemInfo^.OverlayIndex;
  7248.         StateIndex := ItemInfo^.StateIndex;
  7249.         Data := ItemInfo^.Data;
  7250.         PStr := @ItemInfo^.Caption;
  7251.         Inc(Integer(PStr), Length(PStr^) + 1);
  7252.         Len := 0;
  7253.         for J := 0 to ItemInfo^.SubItemCount - 1 do
  7254.         begin
  7255.           SubItems.Add(PStr^);
  7256.           L := Length(PStr^);
  7257.           Inc(Len, L + 1);
  7258.           Inc(Integer(PStr), L + 1);
  7259.         end;
  7260.       end;
  7261.       Inc(Integer(ItemInfo), SizeOf(TItemInfo) - 255 +
  7262.         Length(ItemInfo.Caption) + Len);
  7263.     end;
  7264.   finally
  7265.     FreeMem(ItemHeader, Size);
  7266.   end;
  7267. end;
  7268.  
  7269. procedure TListItems.WriteData(Stream: TStream);
  7270. var
  7271.   I, J, Size, L, Len: Integer;
  7272.   ItemHeader: PItemHeader;
  7273.   ItemInfo: PItemInfo;
  7274.   PStr: PShortStr;
  7275.  
  7276.   function GetLength(const S: string): Integer;
  7277.   begin
  7278.     Result := Length(S);
  7279.     if Result > 255 then Result := 255;
  7280.   end;
  7281.  
  7282. begin
  7283.   Size := SizeOf(TItemHeader);
  7284.   for I := 0 to Count - 1 do
  7285.   begin
  7286.     L := GetLength(Item[I].Caption);
  7287.     for J := 0 to Item[I].SubItems.Count - 1 do
  7288.       Inc(L, GetLength(Item[I].SubItems[J]) + 1);
  7289.     Inc(Size, SizeOf(TItemInfo) - 255 + L);
  7290.   end;
  7291.   ItemHeader := AllocMem(Size);
  7292.   try
  7293.     ItemHeader^.Size := Size;
  7294.     ItemHeader^.Count := Count;
  7295.     ItemInfo := @ItemHeader^.Items;
  7296.     for I := 0 to Count - 1 do
  7297.     begin
  7298.       with Item[I] do
  7299.       begin
  7300.         ItemInfo^.Caption := Caption;
  7301.         ItemInfo^.ImageIndex := ImageIndex;
  7302.         ItemInfo^.OverlayIndex := OverlayIndex;
  7303.         ItemInfo^.StateIndex := StateIndex;
  7304.         ItemInfo^.Data := Data;
  7305.         ItemInfo^.SubItemCount := SubItems.Count;
  7306.         PStr := @ItemInfo^.Caption;
  7307.         Inc(Integer(PStr), Length(ItemInfo^.Caption) + 1);
  7308.         Len := 0;
  7309.         for J := 0 to SubItems.Count - 1 do
  7310.         begin
  7311.           PStr^ := SubItems[J];
  7312.           L := Length(PStr^);
  7313.           Inc(Len, L + 1);
  7314.           Inc(Integer(PStr), L + 1);
  7315.         end;
  7316.       end;
  7317.       Inc(Integer(ItemInfo), SizeOf(TItemInfo) - 255 +
  7318.         Length(ItemInfo^.Caption) + Len);
  7319.     end;
  7320.     Stream.WriteBuffer(ItemHeader^, Size);
  7321.   finally
  7322.     FreeMem(ItemHeader, Size);
  7323.   end;
  7324. end;
  7325.  
  7326. procedure TListItems.Delete(Index: Integer);
  7327. begin
  7328.   Item[Index].Delete;
  7329. end;
  7330.  
  7331. function TListItems.CreateItem(Index: Integer;
  7332.   ListItem: TListItem): TLVItem;
  7333. begin
  7334.   with Result do
  7335.   begin
  7336.     mask := LVIF_PARAM or LVIF_IMAGE;
  7337.     iItem := Index;
  7338.     iSubItem := 0;
  7339.     iImage := I_IMAGECALLBACK;
  7340.     lParam := Longint(ListItem);
  7341.   end;
  7342. end;
  7343.  
  7344. { TIconOptions }
  7345.  
  7346. constructor TIconOptions.Create(AOwner: TCustomListView);
  7347. begin
  7348.   inherited Create;
  7349.   if AOwner = nil then raise Exception.CreateRes(sInvalidOwner);
  7350.   FListView := AOwner;
  7351.   Arrangement := iaTop;
  7352.   AutoArrange := False;
  7353.   WrapText := True;
  7354. end;
  7355.  
  7356. procedure TIconOptions.SetArrangement(Value: TIconArrangement);
  7357. begin
  7358.   if Value <> Arrangement then
  7359.   begin;
  7360.     FArrangement := Value;
  7361.     FListView.RecreateWnd;
  7362.     {FListView.SetIconArrangement(Value);}
  7363.   end;
  7364. end;
  7365.  
  7366. procedure TIconOptions.SetAutoArrange(Value: Boolean);
  7367. begin
  7368.   if Value <> AutoArrange then
  7369.   begin
  7370.     FAutoArrange := Value;
  7371.     FListView.RecreateWnd;
  7372.   end;
  7373. end;
  7374.  
  7375. procedure TIconOptions.SetWrapText(Value: Boolean);
  7376. begin
  7377.   if Value <> WrapText then
  7378.   begin
  7379.     FWrapText := Value;
  7380.     FListView.RecreateWnd;
  7381.   end;
  7382. end;
  7383.  
  7384. { TCustomListView }
  7385.  
  7386. function DefaultListViewSort(Item1, Item2: TListItem;
  7387.   lParam: Integer): Integer; stdcall;
  7388. begin
  7389.   with Item1 do
  7390.     if Assigned(ListView.OnCompare) then
  7391.       ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
  7392.     else Result := lstrcmp(PChar(Item1.Caption), PChar(Item2.Caption));
  7393. end;
  7394.  
  7395. constructor TCustomListView.Create(AOwner: TComponent);
  7396. begin
  7397.   inherited Create(AOwner);
  7398.   ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage];
  7399.   Width := 250;
  7400.   Height := 150;
  7401.   BorderStyle := bsSingle;
  7402.   ViewStyle := vsIcon;
  7403.   ParentColor := False;
  7404.   TabStop := True;
  7405.   HideSelection := True;
  7406.   ShowColumnHeaders := True;
  7407.   ColumnClick := True;
  7408.   FDragIndex := -1;
  7409.   FListColumns := TListColumns.Create(Self);
  7410.   FListItems := TListItems.Create(Self);
  7411.   FIconOptions := TIconOptions.Create(Self);
  7412.   FDragImage := TImageList.CreateSize(32, 32);
  7413.   FEditInstance := MakeObjectInstance(EditWndProc);
  7414.   FHeaderInstance := MakeObjectInstance(HeaderWndProc);
  7415.   FLargeChangeLink := TChangeLink.Create;
  7416.   FLargeChangeLink.OnChange := ImageListChange;
  7417.   FSmallChangeLink := TChangeLink.Create;
  7418.   FSmallChangeLink.OnChange := ImageListChange;
  7419.   FStateChangeLink := TChangeLink.Create;
  7420.   FStateChangeLink.OnChange := ImageListChange;
  7421. end;
  7422.  
  7423. destructor TCustomListView.Destroy;
  7424. begin
  7425.   FDragImage.Free;
  7426.   FListColumns.Free;
  7427.   FListItems.Free;
  7428.   FIconOptions.Free;
  7429.   FMemStream.Free;
  7430.   FreeObjectInstance(FEditInstance);
  7431.   if FHeaderHandle <> 0 then
  7432.     SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
  7433.   FreeObjectInstance(FHeaderInstance);
  7434.   FLargeChangeLink.Free;
  7435.   FSmallChangeLink.Free;
  7436.   FStateChangeLink.Free;
  7437.   inherited Destroy;
  7438. end;
  7439.  
  7440. procedure TCustomListView.CreateParams(var Params: TCreateParams);
  7441. const
  7442.   BorderStyles: array[TBorderStyle] of Integer = (0, WS_BORDER);
  7443.   EditStyles: array[Boolean] of Integer = (LVS_EDITLABELS, 0);
  7444.   MultiSelections: array[Boolean] of Integer = (LVS_SINGLESEL, 0);
  7445.   HideSelections: array[Boolean] of Integer = (LVS_SHOWSELALWAYS, 0);
  7446.   Arrangements: array[TIconArrangement] of Integer = (LVS_ALIGNTOP,
  7447.     LVS_ALIGNLEFT);
  7448.   AutoArrange: array[Boolean] of Integer = (0, LVS_AUTOARRANGE);
  7449.   WrapText: array[Boolean] of Integer = (LVS_NOLABELWRAP, 0);
  7450.   ViewStyles: array[TViewStyle] of Integer = (LVS_ICON, LVS_SMALLICON,
  7451.     LVS_LIST, LVS_REPORT);
  7452.   ShowColumns: array[Boolean] of Integer = (LVS_NOCOLUMNHEADER, 0);
  7453.   ColumnClicks: array[Boolean] of Integer = (LVS_NOSORTHEADER, 0);
  7454. begin
  7455.   InitCommonControls;
  7456.   inherited CreateParams(Params);
  7457.   CreateSubClass(Params, WC_LISTVIEW);
  7458.   with Params do
  7459.   begin
  7460.     Style := Style or WS_CLIPCHILDREN or ViewStyles[ViewStyle] or
  7461.       BorderStyles[BorderStyle] or Arrangements[IconOptions.Arrangement] or
  7462.       EditStyles[ReadOnly] or MultiSelections[MultiSelect] or
  7463.       HideSelections[HideSelection] or
  7464.       AutoArrange[IconOptions.AutoArrange] or
  7465.       WrapText[IconOptions.WrapText] or
  7466.       ShowColumns[ShowColumnHeaders] or
  7467.       ColumnClicks[ColumnClick] or
  7468.       LVS_SHAREIMAGELISTS;
  7469.     if Ctl3D and (FBorderStyle = bsSingle) then
  7470.       ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  7471.   end;
  7472. end;
  7473.  
  7474. procedure TCustomListView.CreateWnd;
  7475. begin
  7476.   inherited CreateWnd;
  7477.   SetTextBKColor(Color);
  7478.   SetTextColor(Font.Color);
  7479.   SetAllocBy(AllocBy);
  7480.   if FMemStream <> nil then
  7481.   begin
  7482.     Items.BeginUpdate;
  7483.     try
  7484.       Columns.Clear;
  7485.       FMemStream.ReadComponentRes(Self);
  7486.       FMemStream.Destroy;
  7487.       FMemStream := nil;
  7488.       Font := Font;
  7489.     finally
  7490.       Items.EndUpdate;
  7491.     end;
  7492.   end;
  7493.   if (LargeImages <> nil) and LargeImages.HandleAllocated then
  7494.     SetImageList(LargeImages.Handle, LVSIL_NORMAL);
  7495.   if (SmallImages <> nil) and SmallImages.HandleAllocated then
  7496.     SetImageList(SmallImages.Handle, LVSIL_SMALL);
  7497.   if (StateImages <> nil) and StateImages.HandleAllocated then
  7498.     SetImageList(StateImages.Handle, TVSIL_STATE);
  7499. end;
  7500.  
  7501. procedure TCustomListView.DestroyWnd;
  7502. begin
  7503.   FMemStream := TMemoryStream.Create;
  7504.   FMemStream.WriteComponentRes(ClassName, Self);
  7505.   FMemStream.Position := 0;
  7506.   inherited DestroyWnd;
  7507. end;
  7508.  
  7509. procedure TCustomListView.SetImageList(Value: HImageList; Flags: Integer);
  7510. begin
  7511.   if HandleAllocated then ListView_SetImageList(Handle, Value, Flags);
  7512. end;
  7513.  
  7514. procedure TCustomListView.ImageListChange(Sender: TObject);
  7515. var
  7516.   ImageHandle: HImageList;
  7517. begin
  7518.   if HandleAllocated then
  7519.   begin
  7520.     ImageHandle := TImageList(Sender).Handle;
  7521.     if Sender = LargeImages then SetImageList(ImageHandle, LVSIL_NORMAL)
  7522.     else if Sender = SmallImages then SetImageList(ImageHandle, LVSIL_SMALL)
  7523.     else if Sender = StateImages then SetImageList(ImageHandle, LVSIL_STATE);
  7524.   end;
  7525. end;
  7526.  
  7527. procedure TCustomListView.Notification(AComponent: TComponent;
  7528.   Operation: TOperation);
  7529. begin
  7530.   inherited Notification(AComponent, Operation);
  7531.   if Operation = opRemove then
  7532.   begin
  7533.     if AComponent = LargeImages then LargeImages := nil;
  7534.     if AComponent = SmallImages then SmallImages := nil;
  7535.     if AComponent = StateImages then StateImages := nil;
  7536.   end;
  7537. end;
  7538.  
  7539. procedure TCustomListView.HeaderWndProc(var Message: TMessage);
  7540. begin
  7541.   try
  7542.     with Message do
  7543.     begin
  7544.       case Msg of
  7545.         WM_NCHITTEST:
  7546.           with TWMNCHitTest(Message) do
  7547.             if csDesigning in ComponentState then
  7548.             begin
  7549.               Result := Windows.HTTRANSPARENT;
  7550.               Exit;
  7551.             end;
  7552.         WM_NCDESTROY:
  7553.           begin
  7554.             Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg, WParam, LParam);
  7555.             FHeaderHandle := 0;
  7556.             FDefHeaderProc := nil;
  7557.             Exit;
  7558.           end;
  7559.       end;
  7560.       Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg, WParam, LParam);
  7561.     end;
  7562.   except
  7563.     Application.HandleException(Self);
  7564.   end;
  7565. end;
  7566.  
  7567. procedure TCustomListView.EditWndProc(var Message: TMessage);
  7568. begin
  7569.   try
  7570.     with Message do
  7571.     begin
  7572.       case Msg of
  7573.         WM_KEYDOWN,
  7574.         WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
  7575.         WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit;
  7576.         WM_KEYUP,
  7577.         WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
  7578.         CN_KEYDOWN,
  7579.         CN_CHAR, CN_SYSKEYDOWN,
  7580.         CN_SYSCHAR:
  7581.           begin
  7582.             WndProc(Message);
  7583.             Exit;
  7584.           end;
  7585.       end;
  7586.       Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam);
  7587.     end;
  7588.   except
  7589.     Application.HandleException(Self);
  7590.   end;
  7591. end;
  7592.  
  7593. procedure TCustomListView.UpdateItems(FirstIndex, LastIndex: Integer);
  7594. begin
  7595.   ListView_RedrawItems(Handle, FirstIndex, LastIndex);
  7596. end;
  7597.  
  7598. procedure TCustomListView.SetBorderStyle(Value: TBorderStyle);
  7599. begin
  7600.   if BorderStyle <> Value then
  7601.   begin
  7602.     FBorderStyle := Value;
  7603.     RecreateWnd;
  7604.   end;
  7605. end;
  7606.  
  7607. procedure TCustomListView.SetColumnClick(Value: Boolean);
  7608. begin
  7609.   if ColumnClick <> Value then
  7610.   begin
  7611.     FColumnClick := Value;
  7612.     RecreateWnd;
  7613.   end;
  7614. end;
  7615.  
  7616. procedure TCustomListView.SetMultiSelect(Value: Boolean);
  7617. begin
  7618.   if Value <> MultiSelect then
  7619.   begin
  7620.     FMultiSelect := Value;
  7621.     RecreateWnd;
  7622.   end;
  7623. end;
  7624.  
  7625. procedure TCustomListView.SetColumnHeaders(Value: Boolean);
  7626. begin
  7627.   if Value <> ShowColumnHeaders then
  7628.   begin
  7629.     FShowColumnHeaders := Value;
  7630.     RecreateWnd;
  7631.   end;
  7632. end;
  7633.  
  7634. procedure TCustomListView.SetTextColor(Value: TColor);
  7635. begin
  7636.   ListView_SetTextColor(Handle, ColorToRGB(Font.Color));
  7637. end;
  7638.  
  7639. procedure TCustomListView.SetTextBkColor(Value: TColor);
  7640. begin
  7641.   ListView_SetTextBkColor(Handle, ColorToRGB(Color));
  7642. end;
  7643.  
  7644. procedure TCustomListView.SetAllocBy(Value: Integer);
  7645. begin
  7646.   if AllocBy <> Value then
  7647.   begin
  7648.     FAllocBy := Value;
  7649.     if HandleAllocated then ListView_SetItemCount(Handle, Value);
  7650.   end;
  7651. end;
  7652.  
  7653. procedure TCustomListView.CMColorChanged(var Message: TMessage);
  7654. begin
  7655.   inherited;
  7656.   SetTextBkColor(Color);
  7657. end;
  7658.  
  7659. procedure TCustomListView.CMCtl3DChanged(var Message: TMessage);
  7660. begin
  7661.   if FBorderStyle = bsSingle then RecreateWnd;
  7662.   inherited;
  7663. end;
  7664.  
  7665. procedure TCustomListView.WMNotify(var Message: TWMNotify);
  7666. begin
  7667.   inherited;
  7668.   if ValidHeaderHandle then
  7669.     with Message.NMHdr^ do
  7670.       if (hWndFrom = FHeaderHandle) and (code = HDN_BEGINTRACK) then
  7671.         with PHDNotify(Pointer(Message.NMHdr))^, PItem^ do
  7672.           if (Mask and HDI_WIDTH) <> 0 then
  7673.             Column[Item].Width := cxy;
  7674. end;
  7675.  
  7676. function TCustomListView.ColumnsShowing: Boolean;
  7677. begin
  7678.   Result := (ViewStyle = vsReport);
  7679. end;
  7680.  
  7681. function TCustomListView.ValidHeaderHandle: Boolean;
  7682. begin
  7683.   Result := FHeaderHandle <> 0;
  7684. end;
  7685.  
  7686. procedure TCustomListView.CMFontChanged(var Message: TMessage);
  7687. begin
  7688.   inherited;
  7689.   if HandleAllocated then
  7690.   begin
  7691.     SetTextColor(Font.Color);
  7692.     if ValidHeaderHandle then
  7693.       InvalidateRect(FHeaderHandle, nil, True);
  7694.   end;
  7695. end;
  7696.  
  7697. procedure TCustomListView.SetHideSelection(Value: Boolean);
  7698. begin
  7699.   if Value <> HideSelection then
  7700.   begin
  7701.     FHideSelection := Value;
  7702.     RecreateWnd;
  7703.   end;
  7704. end;
  7705.  
  7706. procedure TCustomListView.SetReadOnly(Value: Boolean);
  7707. begin
  7708.   if Value <> ReadOnly then
  7709.   begin
  7710.     FReadOnly := Value;
  7711.     RecreateWnd;
  7712.   end;
  7713. end;
  7714.  
  7715. procedure TCustomListView.SetIconOptions(Value: TIconOptions);
  7716. begin
  7717.   with FIconOptions do
  7718.   begin
  7719.     Arrangement := Value.Arrangement;
  7720.     AutoArrange := Value.AutoArrange;
  7721.     WrapText := Value.WrapText;
  7722.   end;
  7723. end;
  7724.  
  7725. procedure TCustomListView.SetIconArrangement(Value: TIconArrangement);
  7726. const
  7727.   Arrangements: array[TIconArrangement] of Integer = (LVS_ALIGNTOP,
  7728.     LVS_ALIGNLEFT);
  7729. var
  7730.   Style: Longint;
  7731. begin
  7732.   if HandleAllocated then
  7733.   begin
  7734.     Style := GetWindowLong(Handle, GWL_STYLE);
  7735.     Style := Style and (not LVS_ALIGNMASK);
  7736.     Style := Style or Arrangements[Value];
  7737.     SetWindowLong(Handle, GWL_STYLE, Style);
  7738.   end;
  7739. end;
  7740.  
  7741. procedure TCustomListView.SetViewStyle(Value: TViewStyle);
  7742. const
  7743.   ViewStyles: array[TViewStyle] of Integer = (LVS_ICON, LVS_SMALLICON,
  7744.     LVS_LIST, LVS_REPORT);
  7745. var
  7746.   Style: Longint;
  7747. begin
  7748.   if Value <> FViewStyle then
  7749.   begin
  7750.     FViewStyle := Value;
  7751.     if HandleAllocated then
  7752.     begin
  7753.       Style := GetWindowLong(Handle, GWL_STYLE);
  7754.       Style := Style and (not LVS_TYPEMASK);
  7755.       Style := Style or ViewStyles[FViewStyle];
  7756.       SetWindowLong(Handle, GWL_STYLE, Style);
  7757.       UpdateColumns;
  7758.       case ViewStyle of
  7759.         vsIcon,
  7760.         vsSmallIcon:
  7761.           if IconOptions.Arrangement = iaTop then
  7762.             Arrange(arAlignTop) else
  7763.             Arrange(arAlignLeft);
  7764.       end;
  7765.     end;
  7766.   end;
  7767. end;
  7768.  
  7769. procedure TCustomListView.WMParentNotify(var Message: TWMParentNotify);
  7770. begin
  7771.   with Message do
  7772.     if (Event = WM_CREATE) and (FHeaderHandle = 0) then
  7773.     begin
  7774.       FHeaderHandle := ChildWnd;
  7775.       FDefHeaderProc := Pointer(GetWindowLong(FHeaderHandle, GWL_WNDPROC));
  7776.       SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));
  7777.     end;
  7778.   inherited;
  7779. end;
  7780.  
  7781. function TCustomListView.GetItemIndex(Value: TListItem): Integer;
  7782. var
  7783.   I: Integer;
  7784. begin
  7785.   Result := -1;
  7786.   for I := 0 to Items.Count - 1 do if Items[I] = Value then Break;
  7787.   if I < Items.Count then Result := I;
  7788. end;
  7789.  
  7790. function TCustomListView.CreateListItem: TListItem;
  7791. begin
  7792.   Result := TListItem.Create(Items);
  7793. end;
  7794.  
  7795. function TCustomListView.GetItem(Value: TLVItem): TListItem;
  7796. begin
  7797.   with Value do
  7798.     if (mask and LVIF_PARAM) <> 0 then Result := TListItem(lParam)
  7799.     else Result := Items[IItem];
  7800. end;
  7801.  
  7802. function TCustomListView.GetSelCount: Integer;
  7803. begin
  7804.   Result := ListView_GetSelectedCount(Handle);
  7805. end;
  7806.  
  7807. procedure TCustomListView.CNNotify(var Message: TWMNotify);
  7808. var
  7809.   Item: TListItem;
  7810.   I: Integer;
  7811. begin
  7812.   with Message.NMHdr^ do
  7813.     case code of
  7814.       LVN_BEGINDRAG:
  7815.         with PNMListView(Pointer(Message.NMHdr))^ do
  7816.           FDragIndex := iItem;
  7817.       LVN_DELETEITEM:
  7818.         with PNMListView(Pointer(Message.NMHdr))^ do
  7819.           Delete(TListItem(lParam));
  7820.       LVN_DELETEALLITEMS:
  7821.         for I := Items.Count - 1 downto 0 do Delete(Items[I]);
  7822.       LVN_GETDISPINFO:
  7823.         begin
  7824.           Item := GetItem(PLVDispInfo(Pointer(Message.NMHdr))^.item);
  7825.           with PLVDispInfo(Pointer(Message.NMHdr))^.item do
  7826.           begin
  7827.             if (mask and LVIF_TEXT) <> 0 then
  7828.               if iSubItem = 0 then
  7829.                 StrPLCopy(pszText, Item.Caption, cchTextMax)
  7830.               else
  7831.                 with Item.SubItems do
  7832.                   if iSubItem <= Count then
  7833.                     StrPLCopy(pszText, Strings[iSubItem - 1], cchTextMax)
  7834.                   else pszText[0] := #0;
  7835.             if (mask and LVIF_IMAGE) <> 0 then iImage := Item.ImageIndex;
  7836.           end;
  7837.         end;
  7838.       LVN_BEGINLABELEDIT:
  7839.         begin
  7840.           Item := GetItem(PLVDispInfo(Pointer(Message.NMHdr))^.item);
  7841.           if not CanEdit(Item) then Message.Result := 1;
  7842.           if Message.Result = 0 then
  7843.           begin
  7844.             FEditHandle := ListView_GetEditControl(Handle);
  7845.             FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  7846.             SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
  7847.           end;
  7848.         end;
  7849.       LVN_ENDLABELEDIT:
  7850.         with PLVDispInfo(Pointer(Message.NMHdr))^ do
  7851.           if (item.pszText <> nil) and (item.IItem <> -1) then
  7852.             Edit(item);
  7853.       LVN_COLUMNCLICK:
  7854.         with PNMListView(Pointer(Message.NMHdr))^ do
  7855.           ColClick(Column[iSubItem]);
  7856.       LVN_INSERTITEM:
  7857.         with PNMListView(Pointer(Message.NMHdr))^ do
  7858.           InsertItem(Items[iItem]);
  7859.       LVN_ITEMCHANGING:
  7860.         with PNMListView(Pointer(Message.NMHdr))^ do
  7861.           if not CanChange(Items[iItem], uChanged) then Message.Result := 1;
  7862.       LVN_ITEMCHANGED:
  7863.         with PNMListView(Pointer(Message.NMHdr))^ do
  7864.           Change(Items[iItem], uChanged);
  7865.       NM_CLICK: FClicked := True;
  7866.       NM_RCLICK: FRClicked := True;
  7867.     end;
  7868. end;
  7869.  
  7870. procedure TCustomListView.ColClick(Column: TListColumn);
  7871. begin
  7872.   if Assigned(FOnColumnClick) then FOnColumnClick(Self, Column);
  7873. end;
  7874.  
  7875. procedure TCustomListView.InsertItem(Item: TListItem);
  7876. begin
  7877.   if Assigned(FOnInsert) then FOnInsert(Self, Item);
  7878. end;
  7879.  
  7880. function TCustomListView.CanChange(Item: TListItem; Change: Integer): Boolean;
  7881. var
  7882.   ItemChange: TItemChange;
  7883. begin
  7884.   Result := True;
  7885.   case Change of
  7886.     LVIF_TEXT: ItemChange := ctText;
  7887.     LVIF_IMAGE: ItemChange := ctImage;
  7888.     LVIF_STATE: ItemChange := ctState;
  7889.   end;
  7890.   if Assigned(FOnChanging) then FOnChanging(Self, Item, ItemChange, Result);
  7891. end;
  7892.  
  7893. procedure TCustomListView.Change(Item: TListItem; Change: Integer);
  7894. var
  7895.   ItemChange: TItemChange;
  7896. begin
  7897.   case Change of
  7898.     LVIF_TEXT: ItemChange := ctText;
  7899.     LVIF_IMAGE: ItemChange := ctImage;
  7900.     LVIF_STATE: ItemChange := ctState;
  7901.   end;
  7902.   if Assigned(FOnChange) then FOnChange(Self, Item, ItemChange);
  7903. end;
  7904.  
  7905. procedure TCustomListView.Delete(Item: TListItem);
  7906. begin
  7907.   if (Item <> nil) and not Item.FProcessedDeleting then
  7908.   begin
  7909.     if Assigned(FOnDeletion) then FOnDeletion(Self, Item);
  7910.     Item.FProcessedDeleting := True;
  7911.     Item.Delete;
  7912.   end;
  7913. end;
  7914.  
  7915. function TCustomListView.CanEdit(Item: TListItem): Boolean;
  7916. begin
  7917.   Result := True;
  7918.   if Assigned(FOnEditing) then FOnEditing(Self, Item, Result);
  7919. end;
  7920.  
  7921. procedure TCustomListView.Edit(const Item: TLVItem);
  7922. var
  7923.   S: string;
  7924.   EditItem: TListItem;
  7925. begin
  7926.   with Item do
  7927.   begin
  7928.     S := pszText;
  7929.     EditItem := GetItem(Item);
  7930.     if Assigned(FOnEdited) then FOnEdited(Self, EditItem, S);
  7931.     if EditItem <> nil then EditItem.Caption := S;
  7932.   end;
  7933. end;
  7934.  
  7935. function TCustomListView.IsEditing: Boolean;
  7936. begin
  7937.   Result := ListView_GetEditControl(Handle) <> 0;
  7938. end;
  7939.  
  7940. function TCustomListView.GetDragImages: TCustomImageList;
  7941. begin
  7942.   if SelCount = 1 then
  7943.     Result := FDragImage else
  7944.     Result := nil;
  7945. end;
  7946.  
  7947. procedure TCustomListView.WndProc(var Message: TMessage);
  7948. begin
  7949.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  7950.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and (DragMode = dmAutomatic) then
  7951.   begin
  7952.     if not IsControlMouseMsg(TWMMouse(Message)) then
  7953.     begin
  7954.       ControlState := ControlState + [csLButtonDown];
  7955.       Dispatch(Message);
  7956.     end;
  7957.   end
  7958.   else if not (((Message.Msg = WM_PAINT) or (Message.Msg = WM_ERASEBKGND)) and
  7959.     Items.FNoRedraw) then
  7960.     inherited WndProc(Message);
  7961. end;
  7962.  
  7963. procedure TCustomListView.DoStartDrag(var DragObject: TDragObject);
  7964. var
  7965.   P, P1: TPoint;
  7966.   ImageHandle: HImageList;
  7967.   DragItem: TListItem;
  7968. begin
  7969.   inherited DoStartDrag(DragObject);
  7970.   FLastDropTarget := nil;
  7971.   GetCursorPos(P);
  7972.   P := ScreenToClient(P);
  7973.   if FDragIndex <> -1 then
  7974.     DragItem := Items[FDragIndex]
  7975.     else DragItem := nil;
  7976.   FDragIndex := -1;
  7977.   if DragItem = nil then
  7978.     with P do DragItem := GetItemAt(X, Y);
  7979.   if DragItem <> nil then
  7980.   begin
  7981.     ImageHandle := ListView_CreateDragImage(Handle, DragItem.Index, P1);
  7982.     if ImageHandle <> 0 then
  7983.       with FDragImage do
  7984.       begin
  7985.         Handle := ImageHandle;
  7986.         with P, DragItem.DisplayRect(drBounds) do
  7987.           SetDragImage(0, X - Left , Y - Top);
  7988.       end;
  7989.   end;
  7990. end;
  7991.  
  7992. procedure TCustomListView.DoEndDrag(Target: TObject; X, Y: Integer);
  7993. begin
  7994.   inherited DoEndDrag(Target, X, Y);
  7995.   FLastDropTarget := nil;
  7996. end;
  7997.  
  7998. procedure TCustomListView.CMDrag(var Message: TCMDrag);
  7999. begin
  8000.   inherited;
  8001.   if Message.Result <> 0 then
  8002.     with Message, DragRec^ do
  8003.       case DragMessage of
  8004.         dmDragMove: with ScreenToClient(Pos) do DoDragOver(Source, X, Y);
  8005.         dmDragLeave:
  8006.           begin
  8007.             TDragObject(Source).HideDragImage;
  8008.             FLastDropTarget := DropTarget;
  8009.             DropTarget := nil;
  8010.             Update;
  8011.             TDragObject(Source).ShowDragImage;
  8012.           end;
  8013.         dmDragDrop: FLastDropTarget := nil;
  8014.       end;
  8015. end;
  8016.  
  8017. procedure TCustomListView.DoDragOver(Source: TDragObject; X, Y: Integer);
  8018. var
  8019.   Item: TListItem;
  8020.   Target: TListItem;
  8021. begin
  8022.   Item := GetItemAt(X, Y);
  8023.   if Item <> nil then
  8024.   begin
  8025.     Target := DropTarget;
  8026.     if (Item <> Target) or (Item = FLastDropTarget) then
  8027.     begin
  8028.       FLastDropTarget := nil;
  8029.       TDragObject(Source).HideDragImage;
  8030.       if Target <> nil then
  8031.         Target.DropTarget := False;
  8032.       Item.DropTarget := True;
  8033.       Update;
  8034.       TDragObject(Source).ShowDragImage;
  8035.     end;
  8036.   end;
  8037. end;
  8038.  
  8039. procedure TCustomListView.SetItems(Value: TListItems);
  8040. begin
  8041.   FListItems.Assign(Value);
  8042. end;
  8043.  
  8044. procedure TCustomListView.SetListColumns(Value: TListColumns);
  8045. begin
  8046.   FListColumns.Assign(Value);
  8047. end;
  8048.  
  8049. function TCustomListView.CustomSort(SortProc: TLVCompare; lParam: Longint): Boolean;
  8050. begin
  8051.   Result := False;
  8052.   if HandleAllocated then
  8053.   begin
  8054.     if not Assigned(SortProc) then SortProc := @DefaultListViewSort;
  8055.     Result := ListView_SortItems(Handle, SortProc, lParam);
  8056.   end;
  8057. end;
  8058.  
  8059. function TCustomListView.AlphaSort: Boolean;
  8060. begin
  8061.   if HandleAllocated then
  8062.     Result := ListView_SortItems(Handle, @DefaultListViewSort, 0)
  8063.   else Result := False;
  8064. end;
  8065.  
  8066. procedure TCustomListView.SetSortType(Value: TSortType);
  8067. begin
  8068.   if SortType <> Value then
  8069.   begin
  8070.     FSortType := Value;
  8071.     if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
  8072.       (SortType in [stText, stBoth]) then
  8073.       AlphaSort;
  8074.   end;
  8075. end;
  8076.  
  8077. function TCustomListView.GetVisibleRowCount: Integer;
  8078. begin
  8079.   if ViewStyle in [vsReport, vsList] then
  8080.     Result := ListView_GetCountPerPage(Handle)
  8081.   else Result := 0;
  8082. end;
  8083.  
  8084. function TCustomListView.GetViewOrigin: TPoint;
  8085. begin
  8086.   ListView_GetOrigin(Handle, Result);
  8087. end;
  8088.  
  8089. function TCustomListView.GetTopItem: TListItem;
  8090. var
  8091.   Index: Integer;
  8092. begin
  8093.   Result := nil;
  8094.   if not (ViewStyle in [vsSmallIcon, vsIcon]) then
  8095.   begin
  8096.     Index := ListView_GetTopIndex(Handle);
  8097.     if Index <> -1 then Result := Items[Index];
  8098.   end;
  8099. end;
  8100.  
  8101. function TCustomListView.GetBoundingRect: TRect;
  8102. begin
  8103.   ListView_GetViewRect(Handle, Result);
  8104. end;
  8105.  
  8106. procedure TCustomListView.Scroll(DX, DY: Integer);
  8107. begin
  8108.   ListView_Scroll(Handle, DX, DY);
  8109. end;
  8110.  
  8111. procedure TCustomListView.SetLargeImages(Value: TImageList);
  8112. begin
  8113.   if LargeImages <> nil then
  8114.     LargeImages.UnRegisterChanges(FLargeChangeLink);
  8115.   FLargeImages := Value;
  8116.   if LargeImages <> nil then
  8117.   begin
  8118.     LargeImages.RegisterChanges(FLargeChangeLink);
  8119.     SetImageList(LargeImages.Handle, LVSIL_NORMAL)
  8120.   end
  8121.   else SetImageList(0, LVSIL_NORMAL);
  8122. end;
  8123.  
  8124. procedure TCustomListView.SetSmallImages(Value: TImageList);
  8125. begin
  8126.   if SmallImages <> nil then
  8127.     SmallImages.UnRegisterChanges(FSmallChangeLink);
  8128.   FSmallImages := Value;
  8129.   if SmallImages <> nil then
  8130.   begin
  8131.     SmallImages.RegisterChanges(FSmallChangeLink);
  8132.     SetImageList(SmallImages.Handle, LVSIL_SMALL)
  8133.   end
  8134.   else SetImageList(0, LVSIL_SMALL);
  8135. end;
  8136.  
  8137. procedure TCustomListView.SetStateImages(Value: TImageList);
  8138. begin
  8139.   if StateImages <> nil then
  8140.     StateImages.UnRegisterChanges(FStateChangeLink);
  8141.   FStateImages := Value;
  8142.   if StateImages <> nil then
  8143.   begin
  8144.     StateImages.RegisterChanges(FStateChangeLink);
  8145.     SetImageList(StateImages.Handle, LVSIL_STATE)
  8146.   end
  8147.   else SetImageList(0, LVSIL_STATE);
  8148. end;
  8149.  
  8150. function TCustomListView.GetColumnFromIndex(Index: Integer): TListColumn;
  8151. begin
  8152.   Result := FListColumns[Index];
  8153. end;
  8154.  
  8155. function TCustomListView.FindCaption(StartIndex: Integer; Value: string;
  8156.   Partial, Inclusive, Wrap: Boolean): TListItem;
  8157. const
  8158.   FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
  8159.   Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
  8160. var
  8161.   Info: TLVFindInfo;
  8162.   Index: Integer;
  8163. begin
  8164.   with Info do
  8165.   begin
  8166.     flags := LVFI_STRING or FullString[Partial] or Wraps[Wrap];
  8167.     psz := PChar(Value);
  8168.   end;
  8169.   if Inclusive then Dec(StartIndex);
  8170.   Index := ListView_FindItem(Handle, StartIndex, Info);
  8171.   if Index <> -1 then Result := Items[Index]
  8172.   else Result := nil;
  8173. end;
  8174.  
  8175. function TCustomListView.FindData(StartIndex: Integer; Value: Pointer;
  8176.   Inclusive, Wrap: Boolean): TListItem;
  8177. var
  8178.   I: Integer;
  8179. begin
  8180.   Result := nil;
  8181.   if Inclusive then Dec(StartIndex);
  8182.   for I := StartIndex + 1 to Items.Count - 1 do
  8183.     if Items[I].Data = Value then Break;
  8184.   if I <= Items.Count - 1 then Result := Items[I]
  8185.   else if Wrap then
  8186.   begin
  8187.     if Inclusive then Inc(StartIndex);
  8188.     for I := 0 to StartIndex - 1 do
  8189.       if Items[I].Data = Value then Break;
  8190.     if I <= StartIndex then Result := Items[I];
  8191.   end;
  8192. end;
  8193.  
  8194. function TCustomListView.GetSelection: TListItem;
  8195. begin
  8196.   Result := GetNextItem(nil, sdAll, [isSelected]);
  8197. end;
  8198.  
  8199. procedure TCustomListView.SetSelection(Value: TListItem);
  8200. var
  8201.   I: Integer;
  8202. begin
  8203.   if Value <> nil then Value.Selected := True
  8204.   else begin
  8205.     Value := Selected;
  8206.     for I := 0 to SelCount - 1 do
  8207.       if Value <> nil then
  8208.       begin
  8209.         Value.Selected := False;
  8210.         Value := GetNextItem(Value, sdAll, [isSelected]);
  8211.       end;
  8212.   end;
  8213. end;
  8214.  
  8215. function TCustomListView.GetDropTarget: TListItem;
  8216. begin
  8217.   Result := GetNextItem(nil, sdAll, [isDropHilited]);
  8218.   if Result = nil then Result := FLastDropTarget;
  8219. end;
  8220.  
  8221. procedure TCustomListView.SetDropTarget(Value: TListItem);
  8222. begin
  8223.   if HandleAllocated then
  8224.     if Value <> nil then Value.DropTarget := True
  8225.     else begin
  8226.       Value := DropTarget;
  8227.       if Value <> nil then Value.DropTarget := False;
  8228.     end;
  8229. end;
  8230.  
  8231. function TCustomListView.GetFocused: TListItem;
  8232. begin
  8233.   Result := GetNextItem(nil, sdAll, [isFocused]);
  8234. end;
  8235.  
  8236. procedure TCustomListView.SetFocused(Value: TListItem);
  8237. begin
  8238.   if HandleAllocated then
  8239.     if Value <> nil then Value.Focused := True
  8240.     else begin
  8241.       Value := ItemFocused;
  8242.       if Value <> nil then Value.Focused := False;
  8243.     end;
  8244. end;
  8245.  
  8246. function TCustomListView.GetNextItem(StartItem: TListItem;
  8247.   Direction: TSearchDirection; States: TItemStates): TListItem;
  8248. var
  8249.   Flags, Index: Integer;
  8250. begin
  8251.   Result := nil;
  8252.   if HandleAllocated then
  8253.   begin
  8254.     Flags := 0;
  8255.     case Direction of
  8256.       sdAbove: Flags := LVNI_ABOVE;
  8257.       sdBelow: Flags := LVNI_BELOW;
  8258.       sdLeft: Flags := LVNI_TOLEFT;
  8259.       sdRight: Flags := LVNI_TORIGHT;
  8260.       sdAll: Flags := LVNI_ALL;
  8261.     end;
  8262.     if StartItem <> nil then Index := StartItem.Index
  8263.     else Index := -1;
  8264.     if isCut in States then Flags := Flags or LVNI_CUT;
  8265.     if isDropHilited in States then Flags := Flags or LVNI_DROPHILITED;
  8266.     if isFocused in States then Flags := Flags or LVNI_FOCUSED;
  8267.     if isSelected in States then Flags := Flags or LVNI_SELECTED;
  8268.     Index := ListView_GetNextItem(Handle, Index, Flags);
  8269.     if Index <> -1 then Result := Items[Index];
  8270.   end;
  8271. end;
  8272.  
  8273. function TCustomListView.GetNearestItem(Point: TPoint;
  8274.   Direction: TSearchDirection): TListItem;
  8275. const
  8276.   Directions: array[TSearchDirection] of Integer = (VK_LEFT, VK_RIGHT,
  8277.     VK_UP, VK_DOWN, 0);
  8278. var
  8279.   Info: TLVFindInfo;
  8280.   Index: Integer;
  8281. begin
  8282.   with Info do
  8283.   begin
  8284.     flags := LVFI_NEARESTXY;
  8285.     pt := Point;
  8286.     vkDirection := Directions[Direction];
  8287.   end;
  8288.   Index := ListView_FindItem(Handle, -1, Info);
  8289.   if Index <> -1 then Result := Items[Index]
  8290.   else Result := nil;
  8291. end;
  8292.  
  8293. function TCustomListView.GetItemAt(X, Y: Integer): TListItem;
  8294. var
  8295.   Info: TLVHitTestInfo;
  8296. var
  8297.   Index: Integer;
  8298. begin
  8299.   Result := nil;
  8300.   if HandleAllocated then
  8301.   begin
  8302.     Info.pt := Point(X, Y);
  8303.     Index := ListView_HitTest(Handle, Info);
  8304.     if Index <> -1 then Result := Items[Index];
  8305.   end;
  8306. end;
  8307.  
  8308. procedure TCustomListView.Arrange(Code: TListArrangement);
  8309. const
  8310.   Codes: array[TListArrangement] of Longint = (LVA_ALIGNBOTTOM, LVA_ALIGNLEFT,
  8311.     LVA_ALIGNRIGHT, LVA_ALIGNTOP, LVA_DEFAULT, LVA_SNAPTOGRID);
  8312. begin
  8313.   ListView_Arrange(Handle, Codes[Code]);
  8314. end;
  8315.  
  8316. function TCustomListView.StringWidth(S: string): Integer;
  8317. begin
  8318.   Result := ListView_GetStringWidth(Handle, PChar(S));
  8319. end;
  8320.  
  8321. procedure TCustomListView.UpdateColumns;
  8322. var
  8323.   I: Integer;
  8324. begin
  8325.   if HandleAllocated then
  8326.     for I := 0 to Columns.Count - 1 do UpdateColumn(I);
  8327. end;
  8328.  
  8329. procedure TCustomListView.UpdateColumn(Index: Integer);
  8330. var
  8331.   Column: TLVColumn;
  8332. begin
  8333.   if HandleAllocated then
  8334.     with Column, Columns.Items[Index] do
  8335.     begin
  8336.       mask := LVCF_TEXT or LVCF_FMT;
  8337.       pszText := PChar(Caption);
  8338.       if Index <> 0 then
  8339.         case Alignment of
  8340.           taLeftJustify: fmt := LVCFMT_LEFT;
  8341.           taCenter: fmt := LVCFMT_CENTER;
  8342.           taRightJustify: fmt := LVCFMT_RIGHT;
  8343.         end
  8344.       else fmt := LVCFMT_LEFT;
  8345.       if WidthType > ColumnTextWidth then
  8346.       begin
  8347.         mask := mask or LVCF_WIDTH;
  8348.         cx := FWidth;
  8349.         ListView_SetColumn(Handle, Index, Column);
  8350.       end
  8351.       else begin
  8352.         ListView_SetColumn(Handle, Index, Column);
  8353.         if ViewStyle = vsList then
  8354.           ListView_SetColumnWidth(Handle, -1, WidthType)
  8355.         else if ViewStyle = vsReport then
  8356.           ListView_SetColumnWidth(Handle, Index, WidthType);
  8357.       end;
  8358.     end;
  8359. end;
  8360.  
  8361. procedure TCustomListView.WMRButtonDown(var Message: TWMRButtonDown);
  8362. var
  8363.   MousePos: TPoint;
  8364. begin
  8365.   FRClicked := False;
  8366.   inherited;
  8367.   if FRClicked then
  8368.   begin
  8369.     GetCursorPos(MousePos);
  8370.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  8371.       Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
  8372.   end;
  8373. end;
  8374.  
  8375. procedure TCustomListView.WMLButtonDown(var Message: TWMLButtonDown);
  8376. var
  8377.   Item: TListItem;
  8378.   MousePos: TPoint;
  8379.   ShiftState: TShiftState;
  8380. begin
  8381.   SetFocus;
  8382.   ShiftState := KeysToShiftState(Message.Keys);
  8383.   FClicked := False;
  8384.   FDragIndex := -1;
  8385.   inherited;
  8386.   if (DragMode = dmAutomatic) and MultiSelect then
  8387.   begin
  8388.     if not (ssShift in ShiftState) and not (ssCtrl in ShiftState) then
  8389.     begin
  8390.       if not FClicked then
  8391.       begin
  8392.         Item := GetItemAt(Message.XPos, Message.YPos);
  8393.         if (Item <> nil) and Item.Selected then
  8394.         begin
  8395.           BeginDrag(False);
  8396.           Exit;
  8397.         end;
  8398.       end;
  8399.     end;
  8400.   end;
  8401.   if FClicked then
  8402.   begin
  8403.     GetCursorPos(MousePos);
  8404.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  8405.       if not Dragging then Perform(WM_LBUTTONUP, 0, MakeLong(X, Y))
  8406.       else SendMessage(GetCapture, WM_LBUTTONUP, 0, MakeLong(X, Y));
  8407.   end
  8408.   else if (DragMode = dmAutomatic) and not (MultiSelect and
  8409.     ((ssShift in ShiftState) or (ssCtrl in ShiftState))) then
  8410.   begin
  8411.     Item := GetItemAt(Message.XPos, Message.YPos);
  8412.     if (Item <> nil) and Item.Selected then
  8413.       BeginDrag(False);
  8414.   end;
  8415. end;
  8416.  
  8417. function TCustomListView.GetSearchString: string;
  8418. var
  8419.   Buffer: array[0..1023] of char;
  8420. begin
  8421.   Result := '';
  8422.   if HandleAllocated and ListView_GetISearchString(Handle, Buffer) then
  8423.     Result := Buffer;
  8424. end;
  8425.  
  8426. end.
  8427.