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