home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / COMCTRLS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  239KB  |  8,454 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.12  $
  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) and (Nodes.Count = Count) then
  3863.       for I := 0 to Count - 1 do
  3864.       begin
  3865.         Result := not Item[I].IsEqual(Nodes[I]);
  3866.         if Result then Break;
  3867.       end
  3868.     else Result := Count > 0;
  3869.   end;
  3870.  
  3871. begin
  3872.   inherited DefineProperties(Filer);
  3873.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteNodes);
  3874. end;
  3875.  
  3876. procedure TTreeNodes.ReadData(Stream: TStream);
  3877. var
  3878.   I, Count: Integer;
  3879.   NodeInfo: TNodeInfo;
  3880. begin
  3881.   Clear;
  3882.   Stream.ReadBuffer(Count, SizeOf(Count));
  3883.   for I := 0 to Count - 1 do
  3884.     Add(nil, '').ReadData(Stream, @NodeInfo);
  3885. end;
  3886.  
  3887. procedure TTreeNodes.WriteData(Stream: TStream);
  3888. var
  3889.   I: Integer;
  3890.   Node: TTreeNode;
  3891.   NodeInfo: TNodeInfo;
  3892. begin
  3893.   I := 0;
  3894.   Node := GetFirstNode;
  3895.   while Node <> nil do
  3896.   begin
  3897.     Inc(I);
  3898.     Node := Node.getNextSibling;
  3899.   end;
  3900.   Stream.WriteBuffer(I, SizeOf(I));
  3901.   Node := GetFirstNode;
  3902.   while Node <> nil do
  3903.   begin
  3904.     Node.WriteData(Stream, @NodeInfo);
  3905.     Node := Node.getNextSibling;
  3906.   end;
  3907. end;
  3908.  
  3909. type
  3910.   TTreeStrings = class(TStrings)
  3911.   private
  3912.     FOwner: TTreeNodes;
  3913.   protected
  3914.     function Get(Index: Integer): string; override;
  3915.     function GetCount: Integer; override;
  3916.     function GetObject(Index: Integer): TObject; override;
  3917.     procedure PutObject(Index: Integer; AObject: TObject); override;
  3918.     procedure SetUpdateState(Updating: Boolean); override;
  3919.   public
  3920.     constructor Create(AOwner: TTreeNodes);
  3921.     function Add(const S: string): Integer; override;
  3922.     procedure Clear; override;
  3923.     procedure Delete(Index: Integer); override;
  3924.     procedure Insert(Index: Integer; const S: string); override;
  3925.     property Owner: TTreeNodes read FOwner;
  3926.   end;
  3927.  
  3928. constructor TTreeStrings.Create(AOwner: TTreeNodes);
  3929. begin
  3930.   inherited Create;
  3931.   FOwner := AOwner;
  3932. end;
  3933.  
  3934. function TTreeStrings.Get(Index: Integer): string;
  3935. const
  3936.   TAB = Chr(9);
  3937. var
  3938.   Level, I: Integer;
  3939.   Node: TTreeNode;
  3940. begin
  3941.   Result := '';
  3942.   Node := Owner.GetNodeFromIndex(Index);
  3943.   Level := Node.Level;
  3944.   for I := 0 to Level - 1 do Result := Result + TAB;
  3945.   Result := Result + Node.Text;
  3946. end;
  3947.  
  3948. function TTreeStrings.GetObject(Index: Integer): TObject;
  3949. begin
  3950.   Result := Owner.GetNodeFromIndex(Index).Data;
  3951. end;
  3952.  
  3953. procedure TTreeStrings.PutObject(Index: Integer; AObject: TObject);
  3954. begin
  3955.   Owner.GetNodeFromIndex(Index).Data := AObject;
  3956. end;
  3957.  
  3958. function TTreeStrings.GetCount: Integer;
  3959. begin
  3960.   Result := Owner.Count;
  3961. end;
  3962.  
  3963. procedure TTreeStrings.Clear;
  3964. begin
  3965.   Owner.Clear;
  3966. end;
  3967.  
  3968. procedure TTreeStrings.Delete(Index: Integer);
  3969. begin
  3970.   Owner.GetNodeFromIndex(Index).Delete;
  3971. end;
  3972.  
  3973. procedure TTreeStrings.SetUpdateState(Updating: Boolean);
  3974. begin
  3975.   SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3976.   if not Updating then Owner.Owner.Refresh;
  3977. end;
  3978.  
  3979. function TTreeStrings.Add(const S: string): Integer;
  3980. var
  3981.   Level, OldLevel, I: Integer;
  3982.   NewStr: string;
  3983.   Node: TTreeNode;
  3984.  
  3985.   function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
  3986.   begin
  3987.     Level := 0;
  3988.     while Buffer^ in [' ', #9] do
  3989.     begin
  3990.       Inc(Buffer);
  3991.       Inc(Level);
  3992.     end;
  3993.     Result := Buffer;
  3994.   end;
  3995.  
  3996. begin
  3997.   Result := GetCount;
  3998.   if (Length(S) = 1) and (S[1] = Chr($1A)) then Exit;
  3999.   Node := nil;
  4000.   OldLevel := 0;
  4001.   NewStr := GetBufStart(PChar(S), Level);
  4002.   if Result > 0 then
  4003.   begin
  4004.     Node := Owner.GetNodeFromIndex(Result - 1);
  4005.     OldLevel := Node.Level;
  4006.   end;
  4007.   if (Level > OldLevel) or (Node = nil) then
  4008.   begin
  4009.     if Level - OldLevel > 1 then TreeViewError(sInvalidLevel);
  4010.   end
  4011.   else begin
  4012.     for I := OldLevel downto Level do
  4013.     begin
  4014.       Node := Node.Parent;
  4015.       if (Node = nil) and (I - Level > 0) then
  4016.         TreeViewError(sInvalidLevel);
  4017.     end;
  4018.   end;
  4019.   Owner.AddChild(Node, NewStr);
  4020. end;
  4021.  
  4022. procedure TTreeStrings.Insert(Index: Integer; const S: string);
  4023. begin
  4024.   with Owner do
  4025.     Insert(GetNodeFromIndex(Index), S);
  4026. end;
  4027.  
  4028. { TCustomTreeView }
  4029.  
  4030. constructor TCustomTreeView.Create(AOwner: TComponent);
  4031. begin
  4032.   inherited Create(AOwner);
  4033.   ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage];
  4034.   Width := 121;
  4035.   Height := 97;
  4036.   TabStop := True;
  4037.   ParentColor := False;
  4038.   FTreeNodes := TTreeNodes.Create(Self);
  4039.   FBorderStyle := bsSingle;
  4040.   FShowButtons := True;
  4041.   FShowRoot := True;
  4042.   FShowLines := True;
  4043.   FHideSelection := True;
  4044.   FDragImage := TImageList.CreateSize(32, 32);
  4045.   FSaveIndent := -1;
  4046.   FEditInstance := MakeObjectInstance(EditWndProc);
  4047.   FImageChangeLink := TChangeLink.Create;
  4048.   FImageChangeLink.OnChange := ImageListChange;
  4049.   FStateChangeLink := TChangeLink.Create;
  4050.   FStateChangeLink.OnChange := ImageListChange;
  4051. end;
  4052.  
  4053. destructor TCustomTreeView.Destroy;
  4054. begin
  4055.   Items.Free;
  4056.   FSaveItems.Free;
  4057.   FDragImage.Free;
  4058.   FMemStream.Free;
  4059.   FreeObjectInstance(FEditInstance);
  4060.   FImageChangeLink.Free;
  4061.   FStateChangeLink.Free;
  4062.   inherited Destroy;
  4063. end;
  4064.  
  4065. procedure TCustomTreeView.CreateParams(var Params: TCreateParams);
  4066. const
  4067.   BorderStyles: array[TBorderStyle] of Integer = (0, WS_BORDER);
  4068.   LineStyles: array[Boolean] of Integer = (0, TVS_HASLINES);
  4069.   RootStyles: array[Boolean] of Integer = (0, TVS_LINESATROOT);
  4070.   ButtonStyles: array[Boolean] of Integer = (0, TVS_HASBUTTONS);
  4071.   EditStyles: array[Boolean] of Integer = (TVS_EDITLABELS, 0);
  4072.   HideSelections: array[Boolean] of Integer = (TVS_SHOWSELALWAYS, 0);
  4073.   DragStyles: array[TDragMode] of Integer = (TVS_DISABLEDRAGDROP, 0);
  4074. begin
  4075.   InitCommonControls;
  4076.   inherited CreateParams(Params);
  4077.   CreateSubClass(Params, WC_TREEVIEW);
  4078.   with Params do
  4079.   begin
  4080.     Style := Style or LineStyles[FShowLines] or BorderStyles[FBorderStyle] or
  4081.       RootStyles[FShowRoot] or ButtonStyles[FShowButtons] or
  4082.       EditStyles[FReadOnly] or HideSelections[FHideSelection] or
  4083.       DragStyles[DragMode];
  4084.     if Ctl3D and (FBorderStyle = bsSingle) then
  4085.       ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  4086.   end;
  4087. end;
  4088.  
  4089. procedure TCustomTreeView.CreateWnd;
  4090. begin
  4091.   inherited CreateWnd;
  4092.   if FMemStream <> nil then
  4093.   begin
  4094.     Items.ReadData(FMemStream);
  4095.     FMemStream.Destroy;
  4096.     FMemStream := nil;
  4097.     SetTopItem(Items.GetNodeFromIndex(FSaveTopIndex));
  4098.     FSaveTopIndex := 0;
  4099.     SetSelection(Items.GetNodeFromIndex(FSaveIndex));
  4100.     FSaveIndex := 0;
  4101.   end;
  4102.   if FSaveIndent <> -1 then Indent := FSaveIndent;
  4103.   if (Images <> nil) and Images.HandleAllocated then
  4104.     SetImageList(Images.Handle, TVSIL_NORMAL);
  4105.   if (StateImages <> nil) and StateImages.HandleAllocated then
  4106.     SetImageList(StateImages.Handle, TVSIL_STATE);
  4107. end;
  4108.  
  4109. procedure TCustomTreeView.DestroyWnd;
  4110. var
  4111.   Node: TTreeNode;
  4112. begin
  4113.   if Items.Count > 0 then
  4114.   begin
  4115.     FMemStream := TMemoryStream.Create;
  4116.     Items.WriteData(FMemStream);
  4117.     FMemStream.Position := 0;
  4118.     Node := GetTopItem;
  4119.     if Node <> nil then FSaveTopIndex := Node.AbsoluteIndex;
  4120.     Node := Selected;
  4121.     if Node <> nil then FSaveIndex := Node.AbsoluteIndex;
  4122.   end;
  4123.   FSaveIndent := Indent;
  4124.   inherited DestroyWnd;
  4125. end;
  4126.  
  4127. procedure TCustomTreeView.EditWndProc(var Message: TMessage);
  4128. begin
  4129.   try
  4130.     with Message do
  4131.     begin
  4132.       case Msg of
  4133.         WM_KEYDOWN,
  4134.         WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
  4135.         WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit;
  4136.         WM_KEYUP,
  4137.         WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
  4138.         CN_KEYDOWN,
  4139.         CN_CHAR, CN_SYSKEYDOWN,
  4140.         CN_SYSCHAR:
  4141.           begin
  4142.             WndProc(Message);
  4143.             Exit;
  4144.           end;
  4145.       end;
  4146.       Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam);
  4147.     end;
  4148.   except
  4149.     Application.HandleException(Self);
  4150.   end;
  4151. end;
  4152.  
  4153. procedure TCustomTreeView.CMColorChanged(var Message: TMessage);
  4154. begin
  4155.   inherited;
  4156.   RecreateWnd;
  4157. end;
  4158.  
  4159. procedure TCustomTreeView.CMCtl3DChanged(var Message: TMessage);
  4160. begin
  4161.   inherited;
  4162.   if FBorderStyle = bsSingle then RecreateWnd;
  4163. end;
  4164.  
  4165. function TCustomTreeView.AlphaSort: Boolean;
  4166. var
  4167.   I: Integer;
  4168. begin
  4169.   if HandleAllocated then
  4170.   begin
  4171.     Result := CustomSort(nil, 0);
  4172.     for I := 0 to Items.Count - 1 do
  4173.       with Items[I] do
  4174.         if HasChildren then AlphaSort;
  4175.   end
  4176.   else Result := False;
  4177. end;
  4178.  
  4179. function TCustomTreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  4180. var
  4181.   SortCB: TTVSortCB;
  4182.   I: Integer;
  4183.   Node: TTreeNode;
  4184. begin
  4185.   Result := False;
  4186.   if HandleAllocated then
  4187.   begin
  4188.     with SortCB do
  4189.     begin
  4190.       if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  4191.       else lpfnCompare := SortProc;
  4192.       hParent := TVI_ROOT;
  4193.       lParam := Data;
  4194.       Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  4195.     end;
  4196.     for I := 0 to Items.Count - 1 do
  4197.     begin
  4198.       Node := Items[I];
  4199.       if Node.HasChildren then Node.CustomSort(SortProc, Data);
  4200.     end;
  4201.   end;
  4202. end;
  4203.  
  4204. procedure TCustomTreeView.SetSortType(Value: TSortType);
  4205. begin
  4206.   if SortType <> Value then
  4207.   begin
  4208.     FSortType := Value;
  4209.     if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
  4210.       (SortType in [stText, stBoth]) then
  4211.       AlphaSort;
  4212.   end;
  4213. end;
  4214.  
  4215. procedure TCustomTreeView.SetStyle(Value: Integer; UseStyle: Boolean);
  4216. var
  4217.   Style: Integer;
  4218. begin
  4219.   if HandleAllocated then
  4220.   begin
  4221.     Style := GetWindowLong(Handle, GWL_STYLE);
  4222.     if not UseStyle then Style := Style and not Value
  4223.     else Style := Style or Value;
  4224.     SetWindowLong(Handle, GWL_STYLE, Style);
  4225.   end;
  4226. end;
  4227.  
  4228. procedure TCustomTreeView.SetBorderStyle(Value: TBorderStyle);
  4229. begin
  4230.   if BorderStyle <> Value then
  4231.   begin
  4232.     FBorderStyle := Value;
  4233.     RecreateWnd;
  4234.   end;
  4235. end;
  4236.  
  4237. procedure TCustomTreeView.SetDragMode(Value: TDragMode);
  4238. begin
  4239.   if Value <> DragMode then
  4240.     SetStyle(TVS_DISABLEDRAGDROP, Value = dmManual);
  4241.   inherited;
  4242. end;
  4243.  
  4244. procedure TCustomTreeView.SetButtonStyle(Value: Boolean);
  4245. begin
  4246.   if ShowButtons <> Value then
  4247.   begin
  4248.     FShowButtons := Value;
  4249.     SetStyle(TVS_HASBUTTONS, Value);
  4250.   end;
  4251. end;
  4252.  
  4253. procedure TCustomTreeView.SetLineStyle(Value: Boolean);
  4254. begin
  4255.   if ShowLines <> Value then
  4256.   begin
  4257.     FShowLines := Value;
  4258.     SetStyle(TVS_HASLINES, Value);
  4259.   end;
  4260. end;
  4261.  
  4262. procedure TCustomTreeView.SetRootStyle(Value: Boolean);
  4263. begin
  4264.   if ShowRoot <> Value then
  4265.   begin
  4266.     FShowRoot := Value;
  4267.     SetStyle(TVS_LINESATROOT, Value);
  4268.   end;
  4269. end;
  4270.  
  4271. procedure TCustomTreeView.SetReadOnly(Value: Boolean);
  4272. begin
  4273.   if ReadOnly <> Value then
  4274.   begin
  4275.     FReadOnly := Value;
  4276.     SetStyle(TVS_EDITLABELS, not Value);
  4277.   end;
  4278. end;
  4279.  
  4280. procedure TCustomTreeView.SetHideSelection(Value: Boolean);
  4281. begin
  4282.   if HideSelection <> Value then
  4283.   begin
  4284.     FHideSelection := Value;
  4285.     SetStyle(TVS_SHOWSELALWAYS, not Value);
  4286.   end;
  4287. end;
  4288.  
  4289. function TCustomTreeView.GetNodeAt(X, Y: Integer): TTreeNode;
  4290. var
  4291.   HitTest: TTVHitTestInfo;
  4292. begin
  4293.   with HitTest do
  4294.   begin
  4295.     pt.X := X;
  4296.     pt.Y := Y;
  4297.     if TreeView_HitTest(Handle, HitTest) <> nil then
  4298.       Result := Items.GetNode(HitTest.hItem)
  4299.     else Result := nil;
  4300.   end;
  4301. end;
  4302.  
  4303. function TCustomTreeView.GetHitTestInfoAt(X, Y: Integer): THitTests;
  4304. var
  4305.   HitTest: TTVHitTestInfo;
  4306. begin
  4307.   Result := [];
  4308.   with HitTest do
  4309.   begin
  4310.     pt.X := X;
  4311.     pt.Y := Y;
  4312.     TreeView_HitTest(Handle, HitTest);
  4313.     if (flags and TVHT_ABOVE) <> 0 then Include(Result, htAbove);
  4314.     if (flags and TVHT_BELOW) <> 0 then Include(Result, htBelow);
  4315.     if (flags and TVHT_NOWHERE) <> 0 then Include(Result, htNowhere);
  4316.     if (flags and TVHT_ONITEM) <> 0 then Include(Result, htOnItem);
  4317.     if (flags and TVHT_ONITEMBUTTON) <> 0 then Include(Result, htOnButton);
  4318.     if (flags and TVHT_ONITEMICON) <> 0 then Include(Result, htOnIcon);
  4319.     if (flags and TVHT_ONITEMINDENT) <> 0 then Include(Result, htOnIndent);
  4320.     if (flags and TVHT_ONITEMLABEL) <> 0 then Include(Result, htOnLabel);
  4321.     if (flags and TVHT_ONITEMRIGHT) <> 0 then Include(Result, htOnRight);
  4322.     if (flags and TVHT_ONITEMSTATEICON) <> 0 then Include(Result, htOnStateIcon);
  4323.     if (flags and TVHT_TOLEFT) <> 0 then Include(Result, htToLeft);
  4324.     if (flags and TVHT_TORIGHT) <> 0 then Include(Result, htToRight);
  4325.   end;
  4326. end;
  4327.  
  4328. procedure TCustomTreeView.SetTreeNodes(Value: TTreeNodes);
  4329. begin
  4330.   Items.Assign(Value);
  4331. end;
  4332.  
  4333. procedure TCustomTreeView.SetIndent(Value: Integer);
  4334. begin
  4335.   if Value <> Indent then TreeView_SetIndent(Handle, Value);
  4336. end;
  4337.  
  4338. function TCustomTreeView.GetIndent: Integer;
  4339. begin
  4340.   Result := TreeView_GetIndent(Handle)
  4341. end;
  4342.  
  4343. procedure TCustomTreeView.FullExpand;
  4344. var
  4345.   Node: TTreeNode;
  4346. begin
  4347.   Node := Items.GetFirstNode;
  4348.   while Node <> nil do
  4349.   begin
  4350.     Node.Expand(True);
  4351.     Node := Node.getNextSibling;
  4352.   end;
  4353. end;
  4354.  
  4355. procedure TCustomTreeView.FullCollapse;
  4356. var
  4357.   Node: TTreeNode;
  4358. begin
  4359.   Node := Items.GetFirstNode;
  4360.   while Node <> nil do
  4361.   begin
  4362.     Node.Collapse(True);
  4363.     Node := Node.getNextSibling;
  4364.   end;
  4365. end;
  4366.  
  4367. procedure TCustomTreeView.Loaded;
  4368. begin
  4369.   inherited Loaded;
  4370.   if csDesigning in ComponentState then FullExpand;
  4371. end;
  4372.  
  4373. function TCustomTreeView.GetTopItem: TTreeNode;
  4374. begin
  4375.   if HandleAllocated then
  4376.     Result := Items.GetNode(TreeView_GetFirstVisible(Handle))
  4377.   else Result := nil;
  4378. end;
  4379.  
  4380. procedure TCustomTreeView.SetTopItem(Value: TTreeNode);
  4381. begin
  4382.   if HandleAllocated and (Value <> nil) then
  4383.     TreeView_SelectSetFirstVisible(Handle, Value.ItemId);
  4384. end;
  4385.  
  4386. function TCustomTreeView.GetSelection: TTreeNode;
  4387. begin
  4388.   if HandleAllocated then
  4389.     Result := Items.GetNode(TreeView_GetSelection(Handle))
  4390.   else Result := nil;
  4391. end;
  4392.  
  4393. procedure TCustomTreeView.SetSelection(Value: TTreeNode);
  4394. begin
  4395.   if Value <> nil then Value.Selected := True
  4396.   else TreeView_SelectItem(Handle, nil);
  4397. end;
  4398.  
  4399. function TCustomTreeView.GetDropTarget: TTreeNode;
  4400. begin
  4401.   if HandleAllocated then
  4402.   begin
  4403.     Result := Items.GetNode(TreeView_GetDropHilite(Handle));
  4404.     if Result = nil then Result := FLastDropTarget;
  4405.   end
  4406.   else Result := nil;
  4407. end;
  4408.  
  4409. procedure TCustomTreeView.SetDropTarget(Value: TTreeNode);
  4410. begin
  4411.   if HandleAllocated then
  4412.     if Value <> nil then Value.DropTarget := True
  4413.     else TreeView_SelectDropTarget(Handle, nil);
  4414. end;
  4415.  
  4416. function TCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode;
  4417. begin
  4418.   with Item do
  4419.     if (state and TVIF_PARAM) <> 0 then Result := Pointer(lParam)
  4420.     else Result := Items.GetNode(hItem);
  4421. end;
  4422.  
  4423. function TCustomTreeView.IsEditing: Boolean;
  4424. begin
  4425.   Result := TreeView_GetEditControl(Handle) <> 0;
  4426. end;
  4427.  
  4428. procedure TCustomTreeView.CNNotify(var Message: TWMNotify);
  4429. var
  4430.   Node: TTreeNode;
  4431. begin
  4432.   with Message.NMHdr^ do
  4433.     case code of
  4434.       TVN_BEGINDRAG:
  4435.         begin
  4436.           FDragged := True;
  4437.           with PNMTreeView(Pointer(Message.NMHdr))^ do
  4438.             FDragNode := GetNodeFromItem(ItemNew);
  4439.         end;
  4440.       TVN_BEGINLABELEDIT:
  4441.         begin
  4442.           with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4443.             if Dragging or not CanEdit(GetNodeFromItem(item)) then
  4444.               Message.Result := 1;
  4445.           if Message.Result = 0 then
  4446.           begin
  4447.             FEditHandle := TreeView_GetEditControl(Handle);
  4448.             FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  4449.             SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
  4450.           end;
  4451.         end;
  4452.       TVN_ENDLABELEDIT:
  4453.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4454.           Edit(item);
  4455.       TVN_ITEMEXPANDING:
  4456.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4457.         begin
  4458.           Node := GetNodeFromItem(ItemNew);
  4459.           if (action = TVE_EXPAND) and not CanExpand(Node) then
  4460.             Message.Result := 1
  4461.           else if (action = TVE_COLLAPSE) and
  4462.             not CanCollapse(Node) then Message.Result := 1;
  4463.         end;
  4464.       TVN_ITEMEXPANDED:
  4465.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4466.         begin
  4467.           Node := GetNodeFromItem(itemNew);
  4468.           if (action = TVE_EXPAND) then Expand(Node)
  4469.           else if (action = TVE_COLLAPSE) then Collapse(Node);
  4470.         end;
  4471.       TVN_SELCHANGING:
  4472.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4473.           if not CanChange(GetNodeFromItem(itemNew)) then
  4474.             Message.Result := 1;
  4475.       TVN_SELCHANGED:
  4476.         with PNMTreeView(Pointer(Message.NMHdr))^ do
  4477.           Change(GetNodeFromItem(itemNew));
  4478.       TVN_DELETEITEM:
  4479.         begin
  4480.           with PNMTreeView(Pointer(Message.NMHdr))^ do
  4481.             Node := GetNodeFromItem(itemOld);
  4482.           if Node <> nil then
  4483.           begin
  4484.             Node.FItemId := nil;
  4485.             Items.Delete(Node);
  4486.           end;
  4487.         end;
  4488.       TVN_SETDISPINFO:
  4489.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4490.         begin
  4491.           Node := GetNodeFromItem(item);
  4492.           if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
  4493.             Node.Text := item.pszText;
  4494.         end;
  4495.       TVN_GETDISPINFO:
  4496.         with PTVDispInfo(Pointer(Message.NMHdr))^ do
  4497.         begin
  4498.           Node := GetNodeFromItem(item);
  4499.           if Node <> nil then
  4500.           begin
  4501.             if (item.mask and TVIF_TEXT) <> 0 then
  4502.               StrLCopy(item.pszText, PChar(Node.Text), item.cchTextMax);
  4503.             if (item.mask and TVIF_IMAGE) <> 0 then
  4504.             begin
  4505.               GetImageIndex(Node);
  4506.               item.iImage := Node.ImageIndex;
  4507.             end;
  4508.             if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
  4509.             begin
  4510.               GetSelectedIndex(Node);
  4511.               item.iSelectedImage := Node.SelectedIndex;
  4512.             end;
  4513.           end;
  4514.         end;
  4515.       NM_RCLICK: FRClicked := True;
  4516.     end;
  4517. end;
  4518.  
  4519. function TCustomTreeView.GetDragImages: TCustomImageList;
  4520. begin
  4521.   if FDragImage.Count > 0 then
  4522.     Result := FDragImage else
  4523.     Result := nil;
  4524. end;
  4525.  
  4526. procedure TCustomTreeView.WndProc(var Message: TMessage);
  4527. begin
  4528.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  4529.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and (DragMode = dmAutomatic) then
  4530.   begin
  4531.     if not IsControlMouseMsg(TWMMouse(Message)) then
  4532.     begin
  4533.       ControlState := ControlState + [csLButtonDown];
  4534.       Dispatch(Message);
  4535.     end;
  4536.   end
  4537.   else inherited WndProc(Message);
  4538. end;
  4539.  
  4540. procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject);
  4541. var
  4542.   ImageHandle: HImageList;
  4543.   DragNode: TTreeNode;
  4544.   P: TPoint;
  4545. begin
  4546.   inherited DoStartDrag(DragObject);
  4547.   DragNode := FDragNode;
  4548.   FLastDropTarget := nil;
  4549.   FDragNode := nil;
  4550.   if DragNode = nil then
  4551.   begin
  4552.     GetCursorPos(P);
  4553.     with ScreenToClient(P) do DragNode := GetNodeAt(X, Y);
  4554.   end;
  4555.   if DragNode <> nil then
  4556.   begin
  4557.     ImageHandle := TreeView_CreateDragImage(Handle, DragNode.ItemId);
  4558.     if ImageHandle <> 0 then
  4559.       with FDragImage do
  4560.       begin
  4561.         Handle := ImageHandle;
  4562.         SetDragImage(0, 2, 2);
  4563.       end;
  4564.   end;
  4565. end;
  4566.  
  4567. procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer);
  4568. begin
  4569.   inherited DoEndDrag(Target, X, Y);
  4570.   FLastDropTarget := nil;
  4571. end;
  4572.  
  4573. procedure TCustomTreeView.CMDrag(var Message: TCMDrag);
  4574. begin
  4575.   inherited;
  4576.   if Message.Result <> 0 then
  4577.     with Message, DragRec^ do
  4578.       case DragMessage of
  4579.         dmDragMove: with ScreenToClient(Pos) do DoDragOver(Source, X, Y);
  4580.         dmDragLeave:
  4581.           begin
  4582.             TDragObject(Source).HideDragImage;
  4583.             FLastDropTarget := DropTarget;
  4584.             DropTarget := nil;
  4585.             TDragObject(Source).ShowDragImage;
  4586.           end;
  4587.         dmDragDrop: FLastDropTarget := nil;
  4588.       end;
  4589. end;
  4590.  
  4591. procedure TCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer);
  4592. var
  4593.   Node: TTreeNode;
  4594. begin
  4595.   Node := GetNodeAt(X, Y);
  4596.   if (Node <> nil) and
  4597.     ((Node <> DropTarget) or (Node = FLastDropTarget)) then
  4598.   begin
  4599.     FLastDropTarget := nil;
  4600.     TDragObject(Source).HideDragImage;
  4601.     Node.DropTarget := True;
  4602.     TDragObject(Source).ShowDragImage;
  4603.   end;
  4604. end;
  4605.  
  4606. procedure TCustomTreeView.GetImageIndex(Node: TTreeNode);
  4607. begin
  4608.   if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node);
  4609. end;
  4610.  
  4611. procedure TCustomTreeView.GetSelectedIndex(Node: TTreeNode);
  4612. begin
  4613.   if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node);
  4614. end;
  4615.  
  4616. function TCustomTreeView.CanChange(Node: TTreeNode): Boolean;
  4617. begin
  4618.   Result := True;
  4619.   if Assigned(FOnChanging) then FOnChanging(Self, Node, Result);
  4620. end;
  4621.  
  4622. procedure TCustomTreeView.Change(Node: TTreeNode);
  4623. begin
  4624.   if Assigned(FOnChange) then FOnChange(Self, Node);
  4625. end;
  4626.  
  4627. procedure TCustomTreeView.Expand(Node: TTreeNode);
  4628. begin
  4629.   if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
  4630. end;
  4631.  
  4632. function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean;
  4633. begin
  4634.   Result := True;
  4635.   if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result);
  4636. end;
  4637.  
  4638. procedure TCustomTreeView.Collapse(Node: TTreeNode);
  4639. begin
  4640.   if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node);
  4641. end;
  4642.  
  4643. function TCustomTreeView.CanCollapse(Node: TTreeNode): Boolean;
  4644. begin
  4645.   Result := True;
  4646.   if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result);
  4647. end;
  4648.  
  4649. function TCustomTreeView.CanEdit(Node: TTreeNode): Boolean;
  4650. begin
  4651.   Result := True;
  4652.   if Assigned(FOnEditing) then FOnEditing(Self, Node, Result);
  4653. end;
  4654.  
  4655. procedure TCustomTreeView.Edit(const Item: TTVItem);
  4656. var
  4657.   S: string;
  4658.   Node: TTreeNode;
  4659. begin
  4660.   with Item do
  4661.     if pszText <> nil then
  4662.     begin
  4663.       S := pszText;
  4664.       Node := GetNodeFromItem(Item);
  4665.       if Assigned(FOnEdited) then FOnEdited(Self, Node, S);
  4666.       if Node <> nil then Node.Text := S;
  4667.     end;
  4668. end;
  4669.  
  4670. function TCustomTreeView.CreateNode: TTreeNode;
  4671. begin
  4672.   Result := TTreeNode.Create(Items);
  4673. end;
  4674.  
  4675. procedure TCustomTreeView.SetImageList(Value: HImageList; Flags: Integer);
  4676. begin
  4677.   if HandleAllocated then TreeView_SetImageList(Handle, Value, Flags);
  4678. end;
  4679.  
  4680. procedure TCustomTreeView.ImageListChange(Sender: TObject);
  4681. var
  4682.   ImageHandle: HImageList;
  4683. begin
  4684.   if HandleAllocated then
  4685.   begin
  4686.     ImageHandle := TImageList(Sender).Handle;
  4687.     if Sender = Images then
  4688.       SetImageList(ImageHandle, TVSIL_NORMAL)
  4689.     else if Sender = StateImages then
  4690.       SetImageList(ImageHandle, TVSIL_STATE);
  4691.   end;
  4692. end;
  4693.  
  4694. procedure TCustomTreeView.Notification(AComponent: TComponent;
  4695.   Operation: TOperation);
  4696. begin
  4697.   inherited Notification(AComponent, Operation);
  4698.   if Operation = opRemove then
  4699.   begin
  4700.     if AComponent = Images then Images := nil;
  4701.     if AComponent = StateImages then StateImages := nil;
  4702.   end;
  4703. end;
  4704.  
  4705. procedure TCustomTreeView.SetImages(Value: TImageList);
  4706. begin
  4707.   if Images <> nil then
  4708.     Images.UnRegisterChanges(FImageChangeLink);
  4709.   FImages := Value;
  4710.   if Images <> nil then
  4711.   begin
  4712.     Images.RegisterChanges(FImageChangeLink);
  4713.     SetImageList(Images.Handle, TVSIL_NORMAL)
  4714.   end
  4715.   else SetImageList(0, TVSIL_NORMAL);
  4716. end;
  4717.  
  4718. procedure TCustomTreeView.SetStateImages(Value: TImageList);
  4719. begin
  4720.   if StateImages <> nil then
  4721.     StateImages.UnRegisterChanges(FStateChangeLink);
  4722.   FStateImages := Value;
  4723.   if StateImages <> nil then
  4724.   begin
  4725.     StateImages.RegisterChanges(FStateChangeLink);
  4726.     SetImageList(StateImages.Handle, TVSIL_STATE)
  4727.   end
  4728.   else SetImageList(0, TVSIL_STATE);
  4729. end;
  4730.  
  4731. procedure TCustomTreeView.LoadFromFile(const FileName: string);
  4732. var
  4733.   Stream: TStream;
  4734. begin
  4735.   Stream := TFileStream.Create(FileName, fmOpenRead);
  4736.   try
  4737.     LoadFromStream(Stream);
  4738.   finally
  4739.     Stream.Free;
  4740.   end;
  4741. end;
  4742.  
  4743. procedure TCustomTreeView.LoadFromStream(Stream: TStream);
  4744. begin
  4745.   with TTreeStrings.Create(Items) do
  4746.     try
  4747.       LoadFromStream(Stream);
  4748.     finally
  4749.       Free;
  4750.   end;
  4751. end;
  4752.  
  4753. procedure TCustomTreeView.SaveToFile(const FileName: string);
  4754. var
  4755.   Stream: TStream;
  4756. begin
  4757.   Stream := TFileStream.Create(FileName, fmCreate);
  4758.   try
  4759.     SaveToStream(Stream);
  4760.   finally
  4761.     Stream.Free;
  4762.   end;
  4763. end;
  4764.  
  4765. procedure TCustomTreeView.SaveToStream(Stream: TStream);
  4766. begin
  4767.   with TTreeStrings.Create(Items) do
  4768.     try
  4769.       SaveToStream(Stream);
  4770.     finally
  4771.       Free;
  4772.   end;
  4773. end;
  4774.  
  4775. procedure TCustomTreeView.WMRButtonDown(var Message: TWMRButtonDown);
  4776. var
  4777.   MousePos: TPoint;
  4778. begin
  4779.   FRClicked := False;
  4780.   inherited;
  4781.   if FRClicked then
  4782.   begin
  4783.     GetCursorPos(MousePos);
  4784.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  4785.       Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
  4786.   end;
  4787. end;
  4788.  
  4789. procedure TCustomTreeView.WMLButtonDown(var Message: TWMLButtonDown);
  4790. var
  4791.   Node: TTreeNode;
  4792.   MousePos: TPoint;
  4793. begin
  4794.   FDragged := False;
  4795.   FDragNode := nil;
  4796.   try
  4797.     inherited;
  4798.     if DragMode = dmAutomatic then
  4799.     begin
  4800.       SetFocus;
  4801.       if not FDragged then
  4802.       begin
  4803.         GetCursorPos(MousePos);
  4804.         with PointToSmallPoint(ScreenToClient(MousePos)) do
  4805.           Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
  4806.       end
  4807.       else begin
  4808.         Node := GetNodeAt(Message.XPos, Message.YPos);
  4809.         if Node <> nil then
  4810.         begin
  4811.           Node.Focused := True;
  4812.           Node.Selected := True;
  4813.           BeginDrag(False);
  4814.         end;
  4815.       end;
  4816.     end;
  4817.   finally
  4818.     FDragNode := nil;
  4819.   end;
  4820. end;
  4821.  
  4822. { TTrackBar }
  4823. constructor TTrackBar.Create(AOwner: TComponent);
  4824. begin
  4825.   inherited Create(AOwner);
  4826.   Width := 150;
  4827.   Height := 45;
  4828.   TabStop := True;
  4829.   FMin := 0;
  4830.   FMax := 10;
  4831.   FLineSize := 1;
  4832.   FPageSize := 2;
  4833.   FFrequency := 1;
  4834.  
  4835.   FTickMarks := tmBottomRight;
  4836.   FTickStyle := tsAuto;
  4837.   FOrientation := trHorizontal;
  4838.   ControlStyle := ControlStyle - [csDoubleClicks];
  4839. end;
  4840.  
  4841. procedure TTrackBar.CreateParams(var Params: TCreateParams);
  4842. const
  4843.   OrientationStyle: array[TTrackbarOrientation] of Longint = (TBS_HORZ, TBS_VERT);
  4844.   TickStyles: array[TTickStyle] of Longint = (TBS_NOTICKS, TBS_AUTOTICKS, 0);
  4845.   ATickMarks: array[TTickMark] of Longint = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
  4846. begin
  4847.   InitCommonControls;
  4848.   inherited CreateParams(Params);
  4849.   CreateSubClass(Params, TRACKBAR_CLASS);
  4850.   Params.Style := Params.Style or OrientationStyle[FOrientation] or
  4851.     TickStyles[FTickStyle] or ATickMarks[FTickMarks] or TBS_ENABLESELRANGE;
  4852.   Params.WindowClass.style := Params.WindowClass.style or CS_DBLCLKS;
  4853. end;
  4854.  
  4855. procedure TTrackBar.CreateWnd;
  4856. begin
  4857.   inherited CreateWnd;
  4858.   if HandleAllocated then
  4859.   begin
  4860.     SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
  4861.     SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
  4862.     SendMessage(Handle, TBM_SETRANGEMIN, 0, FMin);
  4863.     SendMessage(Handle, TBM_SETRANGEMAX, 0, FMax);
  4864.     UpdateSelection;
  4865.     SendMessage(Handle, TBM_SETPOS, 1, FPosition);
  4866.     SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  4867.   end;
  4868. end;
  4869.  
  4870. procedure TTrackBar.DestroyWnd;
  4871. begin
  4872.   inherited DestroyWnd;
  4873. end;
  4874.  
  4875. procedure TTrackBar.CNHScroll(var Message: TWMHScroll);
  4876. begin
  4877.   inherited;
  4878.   FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  4879.  
  4880.   if Assigned(FOnChange) then
  4881.     FOnChange(Self);
  4882.   Message.Result := 0;
  4883. end;
  4884.  
  4885. procedure TTrackBar.CNVScroll(var Message: TWMVScroll);
  4886. begin
  4887.   inherited;
  4888.   FPosition := SendMessage(Handle, TBM_GETPOS, 0, 0);
  4889.  
  4890.   if Assigned(FOnChange) then
  4891.     FOnChange(Self);
  4892.   Message.Result := 0;
  4893. end;
  4894.  
  4895. procedure TTrackBar.SetOrientation(Value: TTrackBarOrientation);
  4896. begin
  4897.   if Value <> FOrientation then
  4898.   begin
  4899.     FOrientation := Value;
  4900.     if ComponentState * [csLoading, csUpdating] = [] then
  4901.       SetBounds(Left, Top, Height, Width);
  4902.     RecreateWnd;
  4903.   end;
  4904. end;
  4905.  
  4906. procedure TTrackBar.SetParams(APosition, AMin, AMax: Integer);
  4907. begin
  4908.   if AMax < AMin then
  4909.     raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  4910.   if APosition < AMin then APosition := AMin;
  4911.   if APosition > AMax then APosition := AMax;
  4912.   if (FMin <> AMin) then
  4913.   begin
  4914.     FMin := AMin;
  4915.     if HandleAllocated then
  4916.       SendMessage(Handle, TBM_SETRANGEMIN, 1, AMin);
  4917.   end;
  4918.   if (FMax <> AMax) then
  4919.   begin
  4920.     FMax := AMax;
  4921.     if HandleAllocated then
  4922.       SendMessage(Handle, TBM_SETRANGEMAX, 1, AMax);
  4923.   end;
  4924.   if FPosition <> APosition then
  4925.   begin
  4926.     FPosition := APosition;
  4927.     if HandleAllocated then
  4928.       SendMessage(Handle, TBM_SETPOS, 1, APosition);
  4929.   end;
  4930. end;
  4931.  
  4932. procedure TTrackBar.SetPosition(Value: Integer);
  4933. begin
  4934.   SetParams(Value, FMin, FMax);
  4935. end;
  4936.  
  4937. procedure TTrackBar.SetMin(Value: Integer);
  4938. begin
  4939.   SetParams(FPosition, Value, FMax);
  4940. end;
  4941.  
  4942. procedure TTrackBar.SetMax(Value: Integer);
  4943. begin
  4944.   SetParams(FPosition, FMin, Value);
  4945. end;
  4946.  
  4947. procedure TTrackBar.SetFrequency(Value: Integer);
  4948. begin
  4949.   if Value <> FFrequency then
  4950.   begin
  4951.     FFrequency := Value;
  4952.     if HandleAllocated then
  4953.       SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  4954.   end;
  4955. end;
  4956.  
  4957. procedure TTrackBar.SetTick(Value: Integer);
  4958. begin
  4959.   if HandleAllocated then
  4960.     SendMessage(Handle, TBM_SETTIC, 0, Value);
  4961. end;
  4962.  
  4963. procedure TTrackBar.SetTickStyle(Value: TTickStyle);
  4964. begin
  4965.   if Value <> FTickStyle then
  4966.   begin
  4967.     FTickStyle := Value;
  4968.     RecreateWnd;
  4969.   end;
  4970. end;
  4971.  
  4972. procedure TTrackBar.SetTickMarks(Value: TTickMark);
  4973. begin
  4974.   if Value <> FTickMarks then
  4975.   begin
  4976.     FTickMarks := Value;
  4977.     RecreateWnd;
  4978.   end;
  4979. end;
  4980.  
  4981. procedure TTrackBar.SetLineSize(Value: Integer);
  4982. begin
  4983.   if Value <> FLineSize then
  4984.   begin
  4985.     FLineSize := Value;
  4986.     if HandleAllocated then
  4987.       SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
  4988.   end;
  4989. end;
  4990.  
  4991. procedure TTrackBar.SetPageSize(Value: Integer);
  4992. begin
  4993.   if Value <> FPageSize then
  4994.   begin
  4995.     FPageSize := Value;
  4996.     if HandleAllocated then
  4997.       SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
  4998.   end;
  4999. end;
  5000.  
  5001. procedure TTrackBar.UpdateSelection;
  5002. begin
  5003.   if HandleAllocated then
  5004.   begin
  5005.     if (FSelStart = 0) and (FSelEnd = 0) then
  5006.       SendMessage(Handle, TBM_CLEARSEL, 1, 0)
  5007.     else
  5008.       SendMessage(Handle, TBM_SETSEL, Integer(True), MakeLong(FSelStart, FSelEnd));
  5009.   end;
  5010. end;
  5011.  
  5012. procedure TTrackBar.SetSelStart(Value: Integer);
  5013. begin
  5014.   if Value <> FSelStart then
  5015.   begin
  5016.     FSelStart := Value;
  5017.     UpdateSelection;
  5018.   end;
  5019. end;
  5020.  
  5021. procedure TTrackBar.SetSelEnd(Value: Integer);
  5022. begin
  5023.   if Value <> FSelEnd then
  5024.   begin
  5025.     FSelEnd := Value;
  5026.     UpdateSelection;
  5027.   end;
  5028. end;
  5029.  
  5030. { TProgressBar }
  5031. constructor TProgressBar.Create(AOwner: TComponent);
  5032. begin
  5033.   inherited Create(AOwner);
  5034.   Width := 150;
  5035.   Height := GetSystemMetrics(SM_CYVSCROLL);
  5036.   FMin := 0;
  5037.   FMax := 100;
  5038.   FStep := 10;
  5039. end;
  5040.  
  5041. procedure TProgressBar.CreateParams(var Params: TCreateParams);
  5042. begin
  5043.   InitCommonControls;
  5044.   inherited CreateParams(Params);
  5045.   CreateSubClass(Params, PROGRESS_CLASS);
  5046. end;
  5047.  
  5048. procedure TProgressBar.CreateWnd;
  5049. begin
  5050.   inherited CreateWnd;
  5051.   SendMessage(Handle, PBM_SETRANGE, 0, MakeLong(FMin, FMax));
  5052.   SendMessage(Handle, PBM_SETSTEP, FStep, 0);
  5053.   Position := FPosition;
  5054. end;
  5055.  
  5056. function TProgressBar.GetPosition: TProgressRange;
  5057. begin
  5058.   if HandleAllocated then
  5059.     Result := SendMessage(Handle, PBM_DELTAPOS, 0, 0) else
  5060.     Result := FPosition;
  5061. end;
  5062.  
  5063. procedure TProgressBar.SetParams(AMin, AMax: TProgressRange);
  5064. begin
  5065.   if AMax < AMin then
  5066.     raise EInvalidOperation.CreateResFmt(SPropertyOutOfRange, [Self.Classname]);
  5067.   if (FMin <> AMin) or (FMax <> AMax) then
  5068.   begin
  5069.     if HandleAllocated then
  5070.     begin
  5071.       SendMessage(Handle, PBM_SETRANGE, 0, MakeLong(AMin, AMax));
  5072.       if FMin > AMin then // since Windows sets Position when increase Min..
  5073.         SendMessage(Handle, PBM_SETPOS, AMin, 0); // set it back if decrease
  5074.     end;
  5075.     FMin := AMin;
  5076.     FMax := AMax;
  5077.   end;
  5078. end;
  5079.  
  5080. procedure TProgressBar.SetMin(Value: TProgressRange);
  5081. begin
  5082.   SetParams(Value, FMax);
  5083. end;
  5084.  
  5085. procedure TProgressBar.SetMax(Value: TProgressRange);
  5086. begin
  5087.   SetParams(FMin, Value);
  5088. end;
  5089.  
  5090. procedure TProgressBar.SetPosition(Value: TProgressRange);
  5091. begin
  5092.   if HandleAllocated then
  5093.     SendMessage(Handle, PBM_SETPOS, Value, 0) else
  5094.     FPosition := Value;
  5095. end;
  5096.  
  5097. procedure TProgressBar.SetStep(Value: TProgressRange);
  5098. begin
  5099.   if Value <> FStep then
  5100.   begin
  5101.     FStep := Value;
  5102.     if HandleAllocated then
  5103.       SendMessage(Handle, PBM_SETSTEP, FStep, 0);
  5104.   end;
  5105. end;
  5106.  
  5107. procedure TProgressBar.StepIt;
  5108. begin
  5109.   if HandleAllocated then
  5110.     SendMessage(Handle, PBM_STEPIT, 0, 0);
  5111. end;
  5112.  
  5113. procedure TProgressBar.StepBy(Delta: TProgressRange);
  5114. begin
  5115.   if HandleAllocated then
  5116.     SendMessage(Handle, PBM_DELTAPOS, Delta, 0);
  5117. end;
  5118.  
  5119. { TTextAttributes }
  5120.  
  5121. constructor TTextAttributes.Create(AOwner: TCustomRichEdit;
  5122.   AttributeType: TAttributeType);
  5123. begin
  5124.   inherited Create;
  5125.   RichEdit := AOwner;
  5126.   FType := AttributeType;
  5127. end;
  5128.  
  5129. procedure TTextAttributes.InitFormat(var Format: TCharFormat);
  5130. begin
  5131.   FillChar(Format, SizeOf(TCharFormat), 0);
  5132.   Format.cbSize := SizeOf(TCharFormat);
  5133. end;
  5134.  
  5135. function TTextAttributes.GetConsistentAttributes: TConsistentAttributes;
  5136. var
  5137.   Format: TCharFormat;
  5138. begin
  5139.   Result := [];
  5140.   if RichEdit.HandleAllocated and (FType = atSelected) then
  5141.   begin
  5142.     InitFormat(Format);
  5143.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  5144.       WPARAM(FType = atSelected), LPARAM(@Format));
  5145.     with Format do
  5146.     begin
  5147.       if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
  5148.       if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
  5149.       if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
  5150.       if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
  5151.       if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
  5152.       if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
  5153.       if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
  5154.       if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
  5155.     end;
  5156.   end;
  5157. end;
  5158.  
  5159. procedure TTextAttributes.GetAttributes(var Format: TCharFormat);
  5160. begin
  5161.   InitFormat(Format);
  5162.   if RichEdit.HandleAllocated then
  5163.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  5164.       WPARAM(FType = atSelected), LPARAM(@Format));
  5165. end;
  5166.  
  5167. procedure TTextAttributes.SetAttributes(var Format: TCharFormat);
  5168. var
  5169.   Flag: Longint;
  5170. begin
  5171.   if FType = atSelected then Flag := SCF_SELECTION
  5172.   else Flag := 0;
  5173.   if RichEdit.HandleAllocated then
  5174.     SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, Flag, LPARAM(@Format))
  5175. end;
  5176.  
  5177. function TTextAttributes.GetProtected: Boolean;
  5178. var
  5179.   Format: TCharFormat;
  5180. begin
  5181.   GetAttributes(Format);
  5182.   with Format do
  5183.     if (dwEffects and CFE_PROTECTED) <> 0 then
  5184.       Result := True else
  5185.       Result := False;
  5186. end;
  5187.  
  5188. procedure TTextAttributes.SetProtected(Value: Boolean);
  5189. var
  5190.   Format: TCharFormat;
  5191. begin
  5192.   InitFormat(Format);
  5193.   with Format do
  5194.   begin
  5195.     dwMask := CFM_PROTECTED;
  5196.     if Value then dwEffects := CFE_PROTECTED;
  5197.   end;
  5198.   SetAttributes(Format);
  5199. end;
  5200.  
  5201. function TTextAttributes.GetColor: TColor;
  5202. var
  5203.   Format: TCharFormat;
  5204. begin
  5205.   GetAttributes(Format);
  5206.   with Format do
  5207.     if (dwEffects and CFE_AUTOCOLOR) <> 0 then
  5208.       Result := clWindowText else
  5209.       Result := crTextColor;
  5210. end;
  5211.  
  5212. procedure TTextAttributes.SetColor(Value: TColor);
  5213. var
  5214.   Format: TCharFormat;
  5215. begin
  5216.   InitFormat(Format);
  5217.   with Format do
  5218.   begin
  5219.     dwMask := CFM_COLOR;
  5220.     if Value = clWindowText then
  5221.       dwEffects := CFE_AUTOCOLOR else
  5222.       crTextColor := ColorToRGB(Value);
  5223.   end;
  5224.   SetAttributes(Format);
  5225. end;
  5226.  
  5227. function TTextAttributes.GetName: TFontName;
  5228. var
  5229.   Format: TCharFormat;
  5230. begin
  5231.   GetAttributes(Format);
  5232.   Result := Format.szFaceName;
  5233. end;
  5234.  
  5235. procedure TTextAttributes.SetName(Value: TFontName);
  5236. var
  5237.   Format: TCharFormat;
  5238. begin
  5239.   InitFormat(Format);
  5240.   with Format do
  5241.   begin
  5242.     dwMask := CFM_FACE;
  5243.     StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
  5244.   end;
  5245.   SetAttributes(Format);
  5246. end;
  5247.  
  5248. function TTextAttributes.GetStyle: TFontStyles;
  5249. var
  5250.   Format: TCharFormat;
  5251. begin
  5252.   Result := [];
  5253.   GetAttributes(Format);
  5254.   with Format do
  5255.   begin
  5256.     if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
  5257.     if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
  5258.     if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
  5259.     if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  5260.   end;
  5261. end;
  5262.  
  5263. procedure TTextAttributes.SetStyle(Value: TFontStyles);
  5264. var
  5265.   Format: TCharFormat;
  5266. begin
  5267.   InitFormat(Format);
  5268.   with Format do
  5269.   begin
  5270.     dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
  5271.     if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
  5272.     if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
  5273.     if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
  5274.     if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  5275.   end;
  5276.   SetAttributes(Format);
  5277. end;
  5278.  
  5279. function TTextAttributes.GetSize: Integer;
  5280. var
  5281.   Format: TCharFormat;
  5282. begin
  5283.   GetAttributes(Format);
  5284.   Result := Format.yHeight div 20;
  5285. end;
  5286.  
  5287. procedure TTextAttributes.SetSize(Value: Integer);
  5288. var
  5289.   Format: TCharFormat;
  5290. begin
  5291.   InitFormat(Format);
  5292.   with Format do
  5293.   begin
  5294.     dwMask := CFM_SIZE;
  5295.     yHeight := Value * 20;
  5296.   end;
  5297.   SetAttributes(Format);
  5298. end;
  5299.  
  5300. function TTextAttributes.GetHeight: Integer;
  5301. begin
  5302.   Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72);
  5303. end;
  5304.  
  5305. procedure TTextAttributes.SetHeight(Value: Integer);
  5306. begin
  5307.   Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels);
  5308. end;
  5309.  
  5310. function TTextAttributes.GetPitch: TFontPitch;
  5311. var
  5312.   Format: TCharFormat;
  5313. begin
  5314.   GetAttributes(Format);
  5315.   case (Format.bPitchAndFamily and $03) of
  5316.     DEFAULT_PITCH: Result := fpDefault;
  5317.     VARIABLE_PITCH: Result := fpVariable;
  5318.     FIXED_PITCH: Result := fpFixed;
  5319.   else
  5320.     Result := fpDefault;
  5321.   end;
  5322. end;
  5323.  
  5324. procedure TTextAttributes.SetPitch(Value: TFontPitch);
  5325. var
  5326.   Format: TCharFormat;
  5327. begin
  5328.   InitFormat(Format);
  5329.   with Format do
  5330.   begin
  5331.     case Value of
  5332.       fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
  5333.       fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
  5334.     else
  5335.       Format.bPitchAndFamily := DEFAULT_PITCH;
  5336.     end;
  5337.   end;
  5338.   SetAttributes(Format);
  5339. end;
  5340.  
  5341. procedure TTextAttributes.Assign(Source: TPersistent);
  5342. begin
  5343.   if Source is TFont then
  5344.   begin
  5345.     Color := TFont(Source).Color;
  5346.     Name := TFont(Source).Name;
  5347.     Style := TFont(Source).Style;
  5348.     Size := TFont(Source).Size;
  5349.     Pitch := TFont(Source).Pitch;
  5350.   end
  5351.   else if Source is TTextAttributes then
  5352.   begin
  5353.     Color := TTextAttributes(Source).Color;
  5354.     Name := TTextAttributes(Source).Name;
  5355.     Style := TTextAttributes(Source).Style;
  5356.     Pitch := TTextAttributes(Source).Pitch;
  5357.   end
  5358.   else inherited Assign(Source);
  5359. end;
  5360.  
  5361. procedure TTextAttributes.AssignTo(Dest: TPersistent);
  5362. begin
  5363.   if Dest is TFont then
  5364.   begin
  5365.     TFont(Dest).Color := Color;
  5366.     TFont(Dest).Name := Name;
  5367.     TFont(Dest).Style := Style;
  5368.     TFont(Dest).Size := Size;
  5369.     TFont(Dest).Pitch := Pitch;
  5370.   end
  5371.   else if Dest is TTextAttributes then
  5372.   begin
  5373.     TTextAttributes(Dest).Color := Color;
  5374.     TTextAttributes(Dest).Name := Name;
  5375.     TTextAttributes(Dest).Style := Style;
  5376.     TTextAttributes(Dest).Pitch := Pitch;
  5377.   end
  5378.   else inherited AssignTo(Dest);
  5379. end;
  5380.  
  5381. { TParaAttributes }
  5382.  
  5383. constructor TParaAttributes.Create(AOwner: TCustomRichEdit);
  5384. begin
  5385.   inherited Create;
  5386.   RichEdit := AOwner;
  5387. end;
  5388.  
  5389. procedure TParaAttributes.InitPara(var Paragraph: TParaFormat);
  5390. begin
  5391.   FillChar(Paragraph, SizeOf(TParaFormat), 0);
  5392.   Paragraph.cbSize := SizeOf(TParaFormat);
  5393. end;
  5394.  
  5395. procedure TParaAttributes.GetAttributes(var Paragraph: TParaFormat);
  5396. begin
  5397.   InitPara(Paragraph);
  5398.   if RichEdit.HandleAllocated then
  5399.     SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
  5400. end;
  5401.  
  5402. procedure TParaAttributes.SetAttributes(var Paragraph: TParaFormat);
  5403. begin
  5404.   if RichEdit.HandleAllocated then
  5405.     SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph))
  5406. end;
  5407.  
  5408. function TParaAttributes.GetAlignment: TAlignment;
  5409. var
  5410.   Paragraph: TParaFormat;
  5411. begin
  5412.   GetAttributes(Paragraph);
  5413.   Result := TAlignment(Paragraph.wAlignment - 1);
  5414. end;
  5415.  
  5416. procedure TParaAttributes.SetAlignment(Value: TAlignment);
  5417. var
  5418.   Paragraph: TParaFormat;
  5419. begin
  5420.   InitPara(Paragraph);
  5421.   with Paragraph do
  5422.   begin
  5423.     dwMask := PFM_ALIGNMENT;
  5424.     wAlignment := Ord(Value) + 1;
  5425.   end;
  5426.   SetAttributes(Paragraph);
  5427. end;
  5428.  
  5429. function TParaAttributes.GetNumbering: TNumberingStyle;
  5430. var
  5431.   Paragraph: TParaFormat;
  5432. begin
  5433.   GetAttributes(Paragraph);
  5434.   Result := TNumberingStyle(Paragraph.wNumbering);
  5435. end;
  5436.  
  5437. procedure TParaAttributes.SetNumbering(Value: TNumberingStyle);
  5438. var
  5439.   Paragraph: TParaFormat;
  5440. begin
  5441.   case Value of
  5442.     nsBullet: if LeftIndent < 10 then LeftIndent := 10;
  5443.     nsNone: LeftIndent := 0;
  5444.   end;
  5445.   InitPara(Paragraph);
  5446.   with Paragraph do
  5447.   begin
  5448.     dwMask := PFM_NUMBERING;
  5449.     wNumbering := Ord(Value);
  5450.   end;
  5451.   SetAttributes(Paragraph);
  5452. end;
  5453.  
  5454. function TParaAttributes.GetFirstIndent: Longint;
  5455. var
  5456.   Paragraph: TParaFormat;
  5457. begin
  5458.   GetAttributes(Paragraph);
  5459.   Result := Paragraph.dxStartIndent div 20
  5460. end;
  5461.  
  5462. procedure TParaAttributes.SetFirstIndent(Value: Longint);
  5463. var
  5464.   Paragraph: TParaFormat;
  5465. begin
  5466.   InitPara(Paragraph);
  5467.   with Paragraph do
  5468.   begin
  5469.     dwMask := PFM_STARTINDENT;
  5470.     dxStartIndent := Value * 20;
  5471.   end;
  5472.   SetAttributes(Paragraph);
  5473. end;
  5474.  
  5475. function TParaAttributes.GetLeftIndent: Longint;
  5476. var
  5477.   Paragraph: TParaFormat;
  5478. begin
  5479.   GetAttributes(Paragraph);
  5480.   Result := Paragraph.dxOffset div 20;
  5481. end;
  5482.  
  5483. procedure TParaAttributes.SetLeftIndent(Value: Longint);
  5484. var
  5485.   Paragraph: TParaFormat;
  5486. begin
  5487.   InitPara(Paragraph);
  5488.   with Paragraph do
  5489.   begin
  5490.     dwMask := PFM_OFFSET;
  5491.     dxOffset := Value * 20;
  5492.   end;
  5493.   SetAttributes(Paragraph);
  5494. end;
  5495.  
  5496. function TParaAttributes.GetRightIndent: Longint;
  5497. var
  5498.   Paragraph: TParaFormat;
  5499. begin
  5500.   GetAttributes(Paragraph);
  5501.   Result := Paragraph.dxRightIndent div 20;
  5502. end;
  5503.  
  5504. procedure TParaAttributes.SetRightIndent(Value: Longint);
  5505. var
  5506.   Paragraph: TParaFormat;
  5507. begin
  5508.   InitPara(Paragraph);
  5509.   with Paragraph do
  5510.   begin
  5511.     dwMask := PFM_RIGHTINDENT;
  5512.     dxRightIndent := Value * 20;
  5513.   end;
  5514.   SetAttributes(Paragraph);
  5515. end;
  5516.  
  5517. function TParaAttributes.GetTab(Index: Byte): Longint;
  5518. var
  5519.   Paragraph: TParaFormat;
  5520. begin
  5521.   GetAttributes(Paragraph);
  5522.   Result := Paragraph.rgxTabs[Index] div 20;
  5523. end;
  5524.  
  5525. procedure TParaAttributes.SetTab(Index: Byte; Value: Longint);
  5526. var
  5527.   Paragraph: TParaFormat;
  5528. begin
  5529.   GetAttributes(Paragraph);
  5530.   with Paragraph do
  5531.   begin
  5532.     rgxTabs[Index] := Value * 20;
  5533.     dwMask := PFM_TABSTOPS;
  5534.     if cTabCount < Index then cTabCount := Index;
  5535.     SetAttributes(Paragraph);
  5536.   end;
  5537. end;
  5538.  
  5539. function TParaAttributes.GetTabCount: Integer;
  5540. var
  5541.   Paragraph: TParaFormat;
  5542. begin
  5543.   GetAttributes(Paragraph);
  5544.   Result := Paragraph.cTabCount;
  5545. end;
  5546.  
  5547. procedure TParaAttributes.SetTabCount(Value: Integer);
  5548. var
  5549.   Paragraph: TParaFormat;
  5550. begin
  5551.   GetAttributes(Paragraph);
  5552.   with Paragraph do
  5553.   begin
  5554.     dwMask := PFM_TABSTOPS;
  5555.     cTabCount := Value;
  5556.     SetAttributes(Paragraph);
  5557.   end;
  5558. end;
  5559.  
  5560. procedure TParaAttributes.Assign(Source: TPersistent);
  5561. var
  5562.   I: Integer;
  5563. begin
  5564.   if Source is TParaAttributes then
  5565.   begin
  5566.     Alignment := TParaAttributes(Source).Alignment;
  5567.     FirstIndent := TParaAttributes(Source).FirstIndent;
  5568.     LeftIndent := TParaAttributes(Source).LeftIndent;
  5569.     RightIndent := TParaAttributes(Source).RightIndent;
  5570.     Numbering := TParaAttributes(Source).Numbering;
  5571.     for I := 0 to MAX_TAB_STOPS - 1 do
  5572.       Tab[I] := TParaAttributes(Source).Tab[I];
  5573.   end
  5574.   else inherited Assign(Source);
  5575. end;
  5576.  
  5577. { TConversion }
  5578.  
  5579. function TConversion.ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
  5580. begin
  5581.   Result := Stream.Read(Buffer^, BufSize);
  5582. end;
  5583.  
  5584. function TConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer;
  5585. begin
  5586.   Result := Stream.Write(Buffer^, BufSize);
  5587. end;
  5588.  
  5589. { TRichEditStrings }
  5590.  
  5591. const
  5592.   ReadError = $0001;
  5593.   WriteError = $0002;
  5594.   NoError = $0000;
  5595.  
  5596. type
  5597.   TSelection = record
  5598.     StartPos, EndPos: Integer;
  5599.   end;
  5600.  
  5601.   TRichEditStrings = class(TStrings)
  5602.   private
  5603.     RichEdit: TCustomRichEdit;
  5604.     FPlainText: Boolean;
  5605.     FConverter: TConversion;
  5606.   protected
  5607.     function Get(Index: Integer): string; override;
  5608.     function GetCount: Integer; override;
  5609.     procedure Put(Index: Integer; const S: string); override;
  5610.     procedure SetUpdateState(Updating: Boolean); override;
  5611.   public
  5612.     procedure Clear; override;
  5613.     procedure AddStrings(Strings: TStrings); override;
  5614.     procedure Delete(Index: Integer); override;
  5615.     procedure Insert(Index: Integer; const S: string); override;
  5616.     procedure LoadFromFile(const FileName: string); override;
  5617.     procedure LoadFromStream(Stream: TStream); override;
  5618.     procedure SaveToFile(const FileName: string); override;
  5619.     procedure SaveToStream(Stream: TStream); override;
  5620.     property PlainText: Boolean read FPlainText write FPlainText;
  5621.   end;
  5622.  
  5623. procedure TRichEditStrings.AddStrings(Strings: TStrings);
  5624. var
  5625.   SelChange: TNotifyEvent;
  5626. begin
  5627.   SelChange := RichEdit.OnSelectionChange;
  5628.   RichEdit.OnSelectionChange := nil;
  5629.   try
  5630.     inherited AddStrings(Strings);
  5631.   finally
  5632.     RichEdit.OnSelectionChange := SelChange;
  5633.   end;
  5634. end;
  5635.  
  5636. function TRichEditStrings.GetCount: Integer;
  5637. begin
  5638.   Result := SendMessage(RichEdit.Handle, EM_GETLINECOUNT, 0, 0);
  5639.   if SendMessage(RichEdit.Handle, EM_LINELENGTH, SendMessage(RichEdit.Handle,
  5640.     EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  5641. end;
  5642.  
  5643. function TRichEditStrings.Get(Index: Integer): string;
  5644. var
  5645.   Text: array[0..4095] of Char;
  5646.   L: Integer;
  5647. begin
  5648.   Word((@Text)^) := SizeOf(Text);
  5649.   L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  5650.   if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2);
  5651.   SetString(Result, Text, L);
  5652. end;
  5653.  
  5654. procedure TRichEditStrings.Put(Index: Integer; const S: string);
  5655. var
  5656.   Selection: TSelection;
  5657. begin
  5658.   if Index >= 0 then
  5659.   begin
  5660.     Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5661.     if Selection.StartPos <> -1 then
  5662.     begin
  5663.       Selection.EndPos := Selection.StartPos +
  5664.         SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5665.       SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5666.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  5667.     end;
  5668.   end;
  5669. end;
  5670.  
  5671. procedure TRichEditStrings.Insert(Index: Integer; const S: string);
  5672. var
  5673.   L: Integer;
  5674.   Selection: TSelection;
  5675.   Fmt: PChar;
  5676.   Str: string;
  5677. begin
  5678.   if Index >= 0 then
  5679.   begin
  5680.     Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5681.     if Selection.StartPos >= 0 then Fmt := '%s'#13#10
  5682.     else begin
  5683.       Selection.StartPos :=
  5684.         SendMessage(RichEdit.Handle, EM_LINEINDEX, Index - 1, 0);
  5685.       if Selection.StartPos < 0 then Exit;
  5686.       L := SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5687.       if L = 0 then Exit;
  5688.       Inc(Selection.StartPos, L);
  5689.       Fmt := #13#10'%s';
  5690.     end;
  5691.     Selection.EndPos := Selection.StartPos;
  5692.     SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5693.     Str := Format(Fmt, [S]);
  5694.     SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, LongInt(PChar(Str)));
  5695.     if RichEdit.SelStart <> (Selection.EndPos + Length(Str)) then
  5696.       raise EOutOfResources.CreateRes(sRichEditInsertError);
  5697.   end;
  5698. end;
  5699.  
  5700. procedure TRichEditStrings.Delete(Index: Integer);
  5701. const
  5702.   Empty: PChar = '';
  5703. var
  5704.   Selection: TSelection;
  5705. begin
  5706.   if Index < 0 then Exit;
  5707.   Selection.StartPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  5708.   if Selection.StartPos <> -1 then
  5709.   begin
  5710.     Selection.EndPos := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index + 1, 0);
  5711.     if Selection.EndPos = -1 then
  5712.       Selection.EndPos := Selection.StartPos +
  5713.         SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.StartPos, 0);
  5714.     SendMessage(RichEdit.Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  5715.     SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  5716.   end;
  5717. end;
  5718.  
  5719. procedure TRichEditStrings.Clear;
  5720. begin
  5721.   RichEdit.Clear;
  5722. end;
  5723.  
  5724. procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
  5725. begin
  5726.   SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  5727.   if not Updating then RichEdit.Refresh;
  5728. end;
  5729.  
  5730. function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
  5731. asm
  5732.         PUSH    ESI
  5733.         PUSH    EDI
  5734.         MOV     EDI,EAX
  5735.         MOV     ESI,EDX
  5736.         MOV     EDX,EAX
  5737.         CLD
  5738. @@1:    LODSB
  5739. @@2:    OR      AL,AL
  5740.         JE      @@4
  5741.         CMP     AL,0AH
  5742.         JE      @@3
  5743.         STOSB
  5744.         CMP     AL,0DH
  5745.         JNE     @@1
  5746.         MOV     AL,0AH
  5747.         STOSB
  5748.         LODSB
  5749.         CMP     AL,0AH
  5750.         JE      @@1
  5751.         JMP     @@2
  5752. @@3:    MOV     EAX,0A0DH
  5753.         STOSW
  5754.         JMP     @@1
  5755. @@4:    STOSB
  5756.         LEA     EAX,[EDI-1]
  5757.         SUB     EAX,EDX
  5758.         POP     EDI
  5759.         POP     ESI
  5760. end;
  5761.  
  5762. function StreamSave(dwCookie: Longint; pbBuff: PByte;
  5763.   cb: Longint; var pcb: Longint): Longint; stdcall;
  5764. var
  5765.   StreamInfo: PRichEditStreamInfo;
  5766. begin
  5767.   Result := NoError;
  5768.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  5769.   try
  5770.     pcb := 0;
  5771.     if StreamInfo^.Converter <> nil then
  5772.       pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
  5773.   except
  5774.     Result := WriteError;
  5775.   end;
  5776. end;
  5777.  
  5778. function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  5779.   cb: Longint; var pcb: Longint): Longint; stdcall;
  5780. var
  5781.   Buffer, pBuff: PChar;
  5782.   StreamInfo: PRichEditStreamInfo;
  5783. begin
  5784.   Result := NoError;
  5785.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  5786.   Buffer := StrAlloc(cb + 1);
  5787.   try
  5788.     cb := cb div 2;
  5789.     pcb := 0;
  5790.     pBuff := Buffer + cb;
  5791.     try
  5792.       if StreamInfo^.Converter <> nil then
  5793.         pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
  5794.       if pcb > 0 then
  5795.       begin
  5796.         pBuff[pcb] := #0;
  5797.         if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
  5798.         pcb := AdjustLineBreaks(Buffer, pBuff);
  5799.         Move(Buffer^, pbBuff^, pcb);
  5800.       end;
  5801.     except
  5802.       Result := ReadError;
  5803.     end;
  5804.   finally
  5805.     StrDispose(Buffer);
  5806.   end;
  5807. end;
  5808.  
  5809. procedure TRichEditStrings.LoadFromStream(Stream: TStream);
  5810. var
  5811.   EditStream: TEditStream;
  5812.   Position: Longint;
  5813.   TextType: Longint;
  5814.   StreamInfo: TRichEditStreamInfo;
  5815.   Converter: TConversion;
  5816. begin
  5817.   StreamInfo.Stream := Stream;
  5818.   if FConverter <> nil then
  5819.     Converter := FConverter else
  5820.     Converter := RichEdit.DefaultConverter.Create;
  5821.   StreamInfo.Converter := Converter;
  5822.   try
  5823.     with EditStream do
  5824.     begin
  5825.       dwCookie := LongInt(Pointer(@StreamInfo));
  5826.       pfnCallBack := @StreamLoad;
  5827.       dwError := 0;
  5828.     end;
  5829.     Position := Stream.Position;
  5830.     if PlainText then TextType := SF_TEXT
  5831.     else TextType := SF_RTF;
  5832.     SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  5833.     if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
  5834.     begin
  5835.       Stream.Position := Position;
  5836.       if PlainText then TextType := SF_RTF
  5837.       else TextType := SF_TEXT;
  5838.       SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  5839.       if EditStream.dwError <> 0 then
  5840.         raise EOutOfResources.CreateRes(sRichEditLoadFail);
  5841.     end;
  5842.   finally
  5843.     if FConverter = nil then Converter.Free;
  5844.   end;
  5845. end;
  5846.  
  5847. procedure TRichEditStrings.SaveToStream(Stream: TStream);
  5848. var
  5849.   EditStream: TEditStream;
  5850.   TextType: Longint;
  5851.   StreamInfo: TRichEditStreamInfo;
  5852.   Converter: TConversion;
  5853. begin
  5854.   if FConverter <> nil then
  5855.     Converter := FConverter else
  5856.     Converter := RichEdit.DefaultConverter.Create;
  5857.   StreamInfo.Stream := Stream;
  5858.   StreamInfo.Converter := Converter;
  5859.   try
  5860.     with EditStream do
  5861.     begin
  5862.       dwCookie := LongInt(Pointer(@StreamInfo));
  5863.       pfnCallBack := @StreamSave;
  5864.       dwError := 0;
  5865.     end;
  5866.     if PlainText then TextType := SF_TEXT
  5867.     else TextType := SF_RTF;
  5868.     SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
  5869.     if EditStream.dwError <> 0 then
  5870.       raise EOutOfResources.CreateRes(sRichEditSaveFail);
  5871.   finally
  5872.     if FConverter = nil then Converter.Free;
  5873.   end;
  5874. end;
  5875.  
  5876. procedure TRichEditStrings.LoadFromFile(const FileName: string);
  5877. var
  5878.   Ext: string;
  5879.   Convert: PConversionFormat;
  5880. begin
  5881.   Ext := AnsiLowerCaseFileName(Copy(ExtractFileExt(Filename), 2, Maxint));
  5882.   Convert := ConversionFormatList;
  5883.   while Convert <> nil do
  5884.     with Convert^ do
  5885.       if Extension <> Ext then Convert := Next
  5886.       else Break;
  5887.   if Convert = nil then
  5888.     Convert := @TextConversionFormat;
  5889.   FConverter := Convert^.ConversionClass.Create;
  5890.   try
  5891.     inherited LoadFromFile(FileName);
  5892.   except
  5893.     FConverter.Free;
  5894.     FConverter := nil;
  5895.     raise;
  5896.   end;
  5897. end;
  5898.  
  5899. procedure TRichEditStrings.SaveToFile(const FileName: string);
  5900. var
  5901.   Ext: string;
  5902.   Convert: PConversionFormat;
  5903. begin
  5904.   Ext := AnsiLowerCaseFileName(Copy(ExtractFileExt(Filename), 2, Maxint));
  5905.   Convert := ConversionFormatList;
  5906.   while Convert <> nil do
  5907.     with Convert^ do
  5908.       if Extension <> Ext then Convert := Next
  5909.       else Break;
  5910.   if Convert = nil then
  5911.     Convert := @TextConversionFormat;
  5912.   FConverter := Convert^.ConversionClass.Create;
  5913.   try
  5914.     inherited SaveToFile(FileName);
  5915.   except
  5916.     FConverter.Free;
  5917.     FConverter := nil;
  5918.     raise;
  5919.   end;
  5920. end;
  5921.  
  5922. { TRichEdit }
  5923.  
  5924. constructor TCustomRichEdit.Create(AOwner: TComponent);
  5925. var
  5926.   DC: HDC;
  5927. begin
  5928.   inherited Create(AOwner);
  5929.   FSelAttributes := TTextAttributes.Create(Self, atSelected);
  5930.   FDefAttributes := TTextAttributes.Create(Self, atDefaultText);
  5931.   FParagraph := TParaAttributes.Create(Self);
  5932.   FRichEditStrings := TRichEditStrings.Create;
  5933.   TRichEditStrings(FRichEditStrings).RichEdit := Self;
  5934.   TabStop := True;
  5935.   Width := 185;
  5936.   Height := 89;
  5937.   AutoSize := False;
  5938.   FHideSelection := True;
  5939.   HideScrollBars := True;
  5940.   DC := GetDC(0);
  5941.   FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  5942.   DefaultConverter := TConversion;
  5943.   ReleaseDC(0, DC);
  5944. end;
  5945.  
  5946. destructor TCustomRichEdit.Destroy;
  5947. begin
  5948.   FSelAttributes.Free;
  5949.   FDefAttributes.Free;
  5950.   FParagraph.Free;
  5951.   FRichEditStrings.Free;
  5952.   FMemStream.Free;
  5953.   inherited Destroy;
  5954. end;
  5955.  
  5956. procedure TCustomRichEdit.CreateParams(var Params: TCreateParams);
  5957. const
  5958.   RichEditModuleName = 'RICHED32.DLL';
  5959.   HideScrollBars: array[Boolean] of Longint = (ES_DISABLENOSCROLL, 0);
  5960.   HideSelections: array[Boolean] of Longint = (ES_NOHIDESEL, 0);
  5961. var
  5962.   OldError: Longint;
  5963. begin
  5964.   OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  5965.   FLibHandle := LoadLibrary(RichEditModuleName);
  5966.   if FLibHandle < HINSTANCE_ERROR then FLibHandle := 0;
  5967.   SetErrorMode(OldError);
  5968.   inherited CreateParams(Params);
  5969.   CreateSubClass(Params, 'RICHEDIT');
  5970.   with Params do
  5971.     Style := Style or HideScrollBars[FHideScrollBars] or
  5972.       HideSelections[HideSelection];
  5973. end;
  5974.  
  5975. procedure TCustomRichEdit.CreateWnd;
  5976. var
  5977.   Plain: Boolean;
  5978.   Format: TCharFormat;
  5979. begin
  5980.   inherited CreateWnd;
  5981.   FillChar(Format, SizeOf(TCharFormat), 0);
  5982.   Format.cbSize := SizeOf(TCharFormat);
  5983.   with Format do
  5984.   begin
  5985.     dwMask := CFM_CHARSET;
  5986.     bCharSet := GetDefFontCharset;
  5987.   end;
  5988.   SendMessage(Handle, EM_SETCHARFORMAT, SCF_DEFAULT, LPARAM(@Format));
  5989.   SendMessage(Handle, EM_SETEVENTMASK, 0,
  5990.     ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
  5991.     ENM_PROTECTED);
  5992.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
  5993.   if FMemStream <> nil then
  5994.   begin
  5995.     Plain := PlainText;
  5996.     PlainText := False;
  5997.     try
  5998.       Lines.LoadFromStream(FMemStream);
  5999.       FMemStream.Free;
  6000.       FMemStream := nil;
  6001.     finally
  6002.       PlainText := Plain;
  6003.     end;
  6004.   end;
  6005.   Modified := FModified;
  6006. end;
  6007.  
  6008. procedure TCustomRichEdit.DestroyWnd;
  6009. var
  6010.   Plain: Boolean;
  6011. begin
  6012.   FModified := Modified;
  6013.   FMemStream := TMemoryStream.Create;
  6014.   Plain := PlainText;
  6015.   PlainText := False;
  6016.   try
  6017.     Lines.SaveToStream(FMemStream);
  6018.     FMemStream.Position := 0;
  6019.   finally
  6020.     PlainText := Plain;
  6021.   end;
  6022.   inherited DestroyWnd;
  6023. end;
  6024.  
  6025. procedure TCustomRichEdit.WMNCDestroy(var Message: TWMNCDestroy);
  6026. begin
  6027.   inherited;
  6028.   if FLibHandle <> 0 then FreeLibrary(FLibHandle);
  6029. end;
  6030.  
  6031. procedure TCustomRichEdit.WMSetFont(var Message: TWMSetFont);
  6032. begin
  6033.   FDefAttributes.Assign(Font);
  6034. end;
  6035.  
  6036. procedure TCustomRichEdit.CMFontChanged(var Message: TMessage);
  6037. begin
  6038.   FDefAttributes.Assign(Font);
  6039. end;
  6040.  
  6041. procedure TCustomRichEdit.SetHideScrollBars(Value: Boolean);
  6042. begin
  6043.   if HideScrollBars <> Value then
  6044.   begin
  6045.     FHideScrollBars := value;
  6046.     RecreateWnd;
  6047.   end;
  6048. end;
  6049.  
  6050. procedure TCustomRichEdit.SetHideSelection(Value: Boolean);
  6051. begin
  6052.   if HideSelection <> Value then
  6053.   begin
  6054.     FHideSelection := Value;
  6055.     SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LongInt(True));
  6056.   end;
  6057. end;
  6058.  
  6059. procedure TCustomRichEdit.SetSelAttributes(Value: TTextAttributes);
  6060. begin
  6061.   SelAttributes.Assign(Value);
  6062. end;
  6063.  
  6064. procedure TCustomRichEdit.SetDefAttributes(Value: TTextAttributes);
  6065. begin
  6066.   DefAttributes.Assign(Value);
  6067. end;
  6068.  
  6069. function TCustomRichEdit.GetPlainText: Boolean;
  6070. begin
  6071.   Result := TRichEditStrings(Lines).PlainText;
  6072. end;
  6073.  
  6074. procedure TCustomRichEdit.SetPlainText(Value: Boolean);
  6075. begin
  6076.   TRichEditStrings(Lines).PlainText := Value;
  6077. end;
  6078.  
  6079. procedure TCustomRichEdit.CMColorChanged(var Message: TMessage);
  6080. begin
  6081.   inherited;
  6082.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
  6083. end;
  6084.  
  6085. procedure TCustomRichEdit.SetRichEditStrings(Value: TStrings);
  6086. begin
  6087.   FRichEditStrings.Assign(Value);
  6088. end;
  6089.  
  6090. procedure TCustomRichEdit.Print(const Caption: string);
  6091. var
  6092.   Range: TFormatRange;
  6093.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  6094. begin
  6095.   FillChar(Range, SizeOf(TFormatRange), 0);
  6096.   with Printer, Range do
  6097.   begin
  6098.     BeginDoc;
  6099.     hdc := Handle;
  6100.     hdcTarget := hdc;
  6101.     LogX := GetDeviceCaps(Handle, LOGPIXELSX);
  6102.     LogY := GetDeviceCaps(Handle, LOGPIXELSY);
  6103.     if IsRectEmpty(PageRect) then
  6104.     begin
  6105.       rc.right := PageWidth * 1440 div LogX;
  6106.       rc.bottom := PageHeight * 1440 div LogY;
  6107.     end
  6108.     else begin
  6109.       rc.left := PageRect.Left * 1440 div LogX;
  6110.       rc.top := PageRect.Top * 1440 div LogY;
  6111.       rc.right := PageRect.Right * 1440 div LogX;
  6112.       rc.bottom := PageRect.Bottom * 1440 div LogY;
  6113.     end;
  6114.     rcPage := rc;
  6115.     Title := Caption;
  6116.     LastChar := 0;
  6117.     MaxLen := GetTextLen;
  6118.     chrg.cpMax := -1;
  6119.     // ensure printer DC is in text map mode
  6120.     OldMap := SetMapMode(hdc, MM_TEXT);
  6121.     SendMessage(Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
  6122.     try
  6123.       repeat
  6124.         chrg.cpMin := LastChar;
  6125.         LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  6126.         if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
  6127.       until (LastChar >= MaxLen) or (LastChar = -1);
  6128.       EndDoc;
  6129.     finally
  6130.       SendMessage(Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
  6131.       SetMapMode(hdc, OldMap);       // restore previous map mode
  6132.     end;
  6133.   end;
  6134. end;
  6135.  
  6136. var
  6137.   Painting: Boolean = False;
  6138.  
  6139. procedure TCustomRichEdit.WMPaint(var Message: TWMPaint);
  6140. var
  6141.   R, R1: TRect;
  6142. begin
  6143.   if GetUpdateRect(Handle, R, True) then
  6144.   begin
  6145.     with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
  6146.     if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
  6147.   end;
  6148.   if Painting then
  6149.     Invalidate
  6150.   else begin
  6151.     Painting := True;
  6152.     try
  6153.       inherited;
  6154.     finally
  6155.       Painting := False;
  6156.     end;
  6157.   end;
  6158. end;
  6159.  
  6160. procedure TCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
  6161. var
  6162.   P: TPoint;
  6163. begin
  6164.   inherited;
  6165.   if Message.Result = 0 then
  6166.   begin
  6167.     Message.Result := 1;
  6168.     GetCursorPos(P);
  6169.     with PointToSmallPoint(P) do
  6170.       case Perform(WM_NCHITTEST, 0, MakeLong(X, Y)) of
  6171.         HTVSCROLL,
  6172.         HTHSCROLL:
  6173.           Windows.SetCursor(Screen.Cursors[crArrow]);
  6174.         HTCLIENT:
  6175.           Windows.SetCursor(Screen.Cursors[crIBeam]);
  6176.       end;
  6177.   end;
  6178. end;
  6179.  
  6180. procedure TCustomRichEdit.CNNotify(var Message: TWMNotify);
  6181. begin
  6182.   with Message.NMHdr^ do
  6183.     case code of
  6184.       EN_SELCHANGE: SelectionChange;
  6185.       EN_REQUESTRESIZE: RequestSize(PReqSize(Pointer(Message.NMHdr))^.rc);
  6186.       EN_SAVECLIPBOARD:
  6187.         with PENSaveClipboard(Pointer(Message.NMHdr))^ do
  6188.           if not SaveClipboard(cObjectCount, cch) then Message.Result := 1;
  6189.       EN_PROTECTED:
  6190.         with PENProtected(Pointer(Message.NMHdr))^.chrg do
  6191.           if not ProtectChange(cpMin, cpMax) then Message.Result := 1;
  6192.     end;
  6193. end;
  6194.  
  6195. function TCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
  6196. begin
  6197.   Result := True;
  6198.   if Assigned(OnSaveClipboard) then OnSaveClipboard(Self, NumObj, NumChars, Result);
  6199. end;
  6200.  
  6201. function TCustomRichEdit.ProtectChange(StartPos, EndPos: Integer): Boolean;
  6202. begin
  6203.   Result := False;
  6204.   if Assigned(OnProtectChange) then OnProtectChange(Self, StartPos, EndPos, Result);
  6205. end;
  6206.  
  6207. procedure TCustomRichEdit.SelectionChange;
  6208. begin
  6209.   if Assigned(OnSelectionChange) then OnSelectionChange(Self);
  6210. end;
  6211.  
  6212. procedure TCustomRichEdit.RequestSize(const Rect: TRect);
  6213. begin
  6214.   if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
  6215. end;
  6216.  
  6217. function TCustomRichEdit.FindText(const SearchStr: string;
  6218.   StartPos, Length: Integer; Options: TSearchTypes): Integer;
  6219. var
  6220.   Find: TFindText;
  6221.   Flags: Integer;
  6222. begin
  6223.   with Find.chrg do
  6224.   begin
  6225.     cpMin := StartPos;
  6226.     cpMax := cpMin + Length;
  6227.   end;
  6228.   Flags := 0;
  6229.   if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
  6230.   if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
  6231.   Find.lpstrText := PChar(SearchStr);
  6232.   Result := SendMessage(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
  6233. end;
  6234.  
  6235. procedure AppendConversionFormat(const Ext: string; AClass: TConversionClass);
  6236. var
  6237.   NewRec: PConversionFormat;
  6238. begin
  6239.   New(NewRec);
  6240.   with NewRec^ do
  6241.   begin
  6242.     Extension := AnsiLowerCaseFileName(Ext);
  6243.     ConversionClass := AClass;
  6244.     Next := ConversionFormatList;
  6245.   end;
  6246.   ConversionFormatList := NewRec;
  6247. end;
  6248.  
  6249. class procedure TCustomRichEdit.RegisterConversionFormat(const AExtension: string;
  6250.   AConversionClass: TConversionClass);
  6251. begin
  6252.   AppendConversionFormat(AExtension, AConversionClass);
  6253. end;
  6254.  
  6255. { TUpDown }
  6256.  
  6257. constructor TCustomUpDown.Create(AOwner: TComponent);
  6258. begin
  6259.   inherited Create(AOwner);
  6260.   Width := GetSystemMetrics(SM_CXVSCROLL);
  6261.   Height := GetSystemMetrics(SM_CYVSCROLL);
  6262.   Height := Height + (Height div 2);
  6263.   FArrowKeys := True;
  6264.   FMax := 100;
  6265.   FIncrement := 1;
  6266.   FAlignButton := udRight;
  6267.   FOrientation := udVertical;
  6268.   FThousands := True;
  6269.   ControlStyle := ControlStyle - [csDoubleClicks];
  6270. end;
  6271.  
  6272. procedure TCustomUpDown.CreateParams(var Params: TCreateParams);
  6273. begin
  6274.   InitCommonControls;
  6275.   inherited CreateParams(Params);
  6276.   with Params do
  6277.   begin
  6278.     Style := Style or UDS_SETBUDDYINT;
  6279.     if FAlignButton = udRight then Style := Style or UDS_ALIGNRIGHT
  6280.     else Style := Style or UDS_ALIGNLEFT;
  6281.     if FOrientation = udHorizontal then Style := Style or UDS_HORZ;
  6282.     if FArrowKeys then Style := Style or UDS_ARROWKEYS;
  6283.     if not FThousands then Style := Style or UDS_NOTHOUSANDS;
  6284.     if FWrap then Style := Style or UDS_WRAP;
  6285.   end;
  6286.   CreateSubClass(Params, UPDOWN_CLASS);
  6287.   Params.WindowClass.style := Params.WindowClass.style or CS_DBLCLKS;
  6288. end;
  6289.  
  6290. procedure TCustomUpDown.CreateWnd;
  6291. var
  6292.   OrigWidth: Integer;
  6293.   AccelArray: array [0..0] of TUDAccel;
  6294. begin
  6295.   OrigWidth := Width;  { control resizes width - disallowing user to set width }
  6296.   inherited CreateWnd;
  6297.   Width := OrigWidth;
  6298.   SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6299.   if SysLocale.PriLangID <> LANG_JAPANESE then
  6300.     SendMessage(Handle, UDM_SETPOS, 0, MakeLong(FPosition, 0));
  6301.   SendMessage(Handle, UDM_GETACCEL, 1, Longint(@AccelArray));
  6302.   AccelArray[0].nInc := FIncrement;
  6303.   SendMessage(Handle, UDM_SETACCEL, 1, Longint(@AccelArray));
  6304.  
  6305.   if FAssociate <> nil then
  6306.   begin
  6307.     UndoAutoResizing(FAssociate);
  6308.     SendMessage(Handle, UDM_SETBUDDY, FAssociate.Handle, 0);
  6309.     if SysLocale.PriLangID = LANG_JAPANESE then
  6310.       SendMessage(Handle, UDM_SETPOS, 0, MakeLong(FPosition, 0));
  6311.   end;
  6312. end;
  6313.  
  6314. procedure TCustomUpDown.WMVScroll(var Message: TWMVScroll);
  6315. begin
  6316.   inherited;
  6317.   if Message.ScrollCode = SB_THUMBPOSITION then
  6318.   begin
  6319.     if Message.Pos > FPosition then Click(btNext)
  6320.     else if Message.Pos < FPosition then Click(btPrev);
  6321.     FPosition := Message.Pos;
  6322.   end;
  6323. end;
  6324.  
  6325. procedure TCustomUpDown.WMHScroll(var Message: TWMHScroll);
  6326. begin
  6327.   inherited;
  6328.   if Message.ScrollCode = SB_THUMBPOSITION then
  6329.   begin
  6330.     if Message.Pos > FPosition then Click(btNext)
  6331.     else if Message.Pos < FPosition then Click(btPrev);
  6332.     FPosition := Message.Pos;
  6333.   end;
  6334. end;
  6335.  
  6336. function TCustomUpDown.CanChange: Boolean;
  6337. begin
  6338.   Result := True;
  6339.   if Assigned(FOnChanging) then
  6340.     FOnChanging(Self, Result);
  6341. end;
  6342.  
  6343. procedure TCustomUpDown.CNNotify(var Message: TWMNotify);
  6344. begin
  6345.   with Message.NMHdr^ do
  6346.   begin
  6347.     case code of
  6348.       UDN_DELTAPOS: LongBool(Message.Result) := not CanChange;
  6349.     end;
  6350.   end;
  6351. end;
  6352.  
  6353. procedure TCustomUpDown.Click(Button: TUDBtnType);
  6354. begin
  6355.   if Assigned(FOnClick) then FOnClick(Self, Button);
  6356. end;
  6357.  
  6358. procedure TCustomUpDown.SetAssociate(Value: TWinControl);
  6359. var
  6360.   I: Integer;
  6361.  
  6362.   function IsClass(ClassType: TClass; const Name: string): Boolean;
  6363.   begin
  6364.     Result := True;
  6365.     while ClassType <> nil do
  6366.     begin
  6367.       if ClassType.ClassNameIs(Name) then Exit;
  6368.       ClassType := ClassType.ClassParent;
  6369.     end;
  6370.     Result := False;
  6371.   end;
  6372.  
  6373. begin
  6374.   for I := 0 to Parent.ControlCount - 1 do
  6375.     if (Parent.Controls[I] is TCustomUpDown) and (Parent.Controls[I] <> Self) then
  6376.       if TCustomUpDown(Parent.Controls[I]).Associate = Value then
  6377.         raise Exception.CreateResFmt(sUDAssociated,
  6378.           [Value.Name, Parent.Controls[I].Name]);
  6379.  
  6380.   if FAssociate <> nil then { undo the current associate control }
  6381.   begin
  6382.     if HandleAllocated then
  6383.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6384.     FAssociate := nil;
  6385.   end;
  6386.  
  6387.   if (Value <> nil) and (Value.Parent = Self.Parent) and
  6388.     not (Value is TCustomUpDown) and
  6389.     not (Value is TCustomTreeView) and not (Value is TCustomListView) and
  6390.     not IsClass(Value.ClassType, 'TDBEdit') and
  6391.     not IsClass(Value.ClassType, 'TDBMemo') then
  6392.   begin
  6393.     if HandleAllocated then
  6394.     begin
  6395.       UndoAutoResizing(Value);
  6396.       SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
  6397.     end;
  6398.     FAssociate := Value;
  6399.     if Value is TCustomEdit then
  6400.       TCustomEdit(Value).Text := IntToStr(FPosition);
  6401.   end;
  6402. end;
  6403.  
  6404. procedure TCustomUpDown.UndoAutoResizing(Value: TWinControl);
  6405. var
  6406.   OrigWidth, NewWidth, DeltaWidth: Integer;
  6407.   OrigLeft, NewLeft, DeltaLeft: Integer;
  6408. begin
  6409.   { undo Window's auto-resizing }
  6410.   OrigWidth := Value.Width;
  6411.   OrigLeft := Value.Left;
  6412.   SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
  6413.   NewWidth := Value.Width;
  6414.   NewLeft := Value.Left;
  6415.   DeltaWidth := OrigWidth - NewWidth;
  6416.   DeltaLeft := NewLeft - OrigLeft;
  6417.   Value.Width := OrigWidth + DeltaWidth;
  6418.   Value.Left := OrigLeft - DeltaLeft;
  6419. end;
  6420.  
  6421. procedure TCustomUpDown.Notification(AComponent: TComponent;
  6422.   Operation: TOperation);
  6423. begin
  6424.   inherited Notification(AComponent, Operation);
  6425.   if (Operation = opRemove) and (AComponent = FAssociate) then
  6426.     if HandleAllocated then
  6427.     begin
  6428.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6429.       FAssociate := nil;
  6430.     end;
  6431. end;
  6432.  
  6433. function TCustomUpDown.GetPosition: SmallInt;
  6434. begin
  6435.   if HandleAllocated then
  6436.   begin
  6437.     Result := LoWord(SendMessage(Handle, UDM_GETPOS, 0, 0));
  6438.     FPosition := Result;
  6439.   end
  6440.   else Result := FPosition;
  6441. end;
  6442.  
  6443. procedure TCustomUpDown.SetMin(Value: SmallInt);
  6444. begin
  6445.   if Value <> FMin then
  6446.   begin
  6447.     FMin := Value;
  6448.     if HandleAllocated then
  6449.       SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6450.   end;
  6451. end;
  6452.  
  6453. procedure TCustomUpDown.SetMax(Value: SmallInt);
  6454. begin
  6455.   if Value <> FMax then
  6456.   begin
  6457.     FMax := Value;
  6458.     if HandleAllocated then
  6459.       SendMessage(Handle, UDM_SETRANGE, 0, MakeLong(FMax, FMin));
  6460.   end;
  6461. end;
  6462.  
  6463. procedure TCustomUpDown.SetIncrement(Value: Integer);
  6464. var
  6465.   AccelArray: array [0..0] of TUDAccel;
  6466. begin
  6467.   if Value <> FIncrement then
  6468.   begin
  6469.     FIncrement := Value;
  6470.     if HandleAllocated then
  6471.     begin
  6472.       SendMessage(Handle, UDM_GETACCEL, 1, Longint(@AccelArray));
  6473.       AccelArray[0].nInc := Value;
  6474.       SendMessage(Handle, UDM_SETACCEL, 1, Longint(@AccelArray));
  6475.     end;
  6476.   end;
  6477. end;
  6478.  
  6479. procedure TCustomUpDown.SetPosition(Value: SmallInt);
  6480. begin
  6481.   if Value <> FPosition then
  6482.   begin
  6483.     FPosition := Value;
  6484.     if (csDesigning in ComponentState) and (FAssociate <> nil) then
  6485.       if FAssociate is TCustomEdit then
  6486.         TCustomEdit(FAssociate).Text := IntToStr(FPosition);
  6487.     if HandleAllocated then
  6488.       SendMessage(Handle, UDM_SETPOS, 0, MakeLong(FPosition, 0));
  6489.   end;
  6490. end;
  6491.  
  6492. procedure TCustomUpDown.SetOrientation(Value: TUDOrientation);
  6493. begin
  6494.   if Value <> FOrientation then
  6495.   begin
  6496.     FOrientation := Value;
  6497.     if ComponentState * [csLoading, csUpdating] = [] then
  6498.       SetBounds(Left, Top, Height, Width);
  6499.     if HandleAllocated then
  6500.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6501.     RecreateWnd;
  6502.   end;
  6503. end;
  6504.  
  6505. procedure TCustomUpDown.SetAlignButton(Value: TUDAlignButton);
  6506. begin
  6507.   if Value <> FAlignButton then
  6508.   begin
  6509.     FAlignButton := Value;
  6510.     if HandleAllocated then
  6511.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6512.     RecreateWnd;
  6513.   end;
  6514. end;
  6515.  
  6516. procedure TCustomUpDown.SetArrowKeys(Value: Boolean);
  6517. begin
  6518.   if Value <> FArrowKeys then
  6519.   begin
  6520.     FArrowKeys := Value;
  6521.     if HandleAllocated then
  6522.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6523.     RecreateWnd;
  6524.   end;
  6525. end;
  6526.  
  6527. procedure TCustomUpDown.SetThousands(Value: Boolean);
  6528. begin
  6529.   if Value <> FThousands then
  6530.   begin
  6531.     FThousands := Value;
  6532.     if HandleAllocated then
  6533.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6534.     RecreateWnd;
  6535.   end;
  6536. end;
  6537.  
  6538. procedure TCustomUpDown.SetWrap(Value: Boolean);
  6539. begin
  6540.   if Value <> FWrap then
  6541.   begin
  6542.     FWrap := Value;
  6543.     if HandleAllocated then
  6544.       SendMessage(Handle, UDM_SETBUDDY, 0, 0);
  6545.     RecreateWnd;
  6546.   end;
  6547. end;
  6548.  
  6549. { THotKey }
  6550.  
  6551. constructor TCustomHotKey.Create(AOwner: TComponent);
  6552. begin
  6553.   inherited Create(AOwner);
  6554.   Width := 121;
  6555.   Height := 25;
  6556.   TabStop := True;
  6557.   ParentColor := False;
  6558.   FAutoSize := True;
  6559.   FInvalidKeys := [hcNone, hcShift];
  6560.   FModifiers := [hkAlt];
  6561.   FHotKey := $0041;     // default - 'Alt+A'
  6562.   AdjustHeight;
  6563. end;
  6564.  
  6565. procedure TCustomHotKey.CreateParams(var Params: TCreateParams);
  6566. begin
  6567.   InitCommonControls;
  6568.   inherited CreateParams(Params);
  6569.   CreateSubClass(Params, HOTKEYCLASS);
  6570. end;
  6571.  
  6572. procedure TCustomHotKey.CreateWnd;
  6573. begin
  6574.   inherited CreateWnd;
  6575.   SendMessage(Handle, HKM_SETRULES, Byte(FInvalidKeys), MakeLong(Byte(FModifiers), 0));
  6576.   SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6577. end;
  6578.  
  6579. procedure TCustomHotKey.SetAutoSize(Value: Boolean);
  6580. begin
  6581.   if FAutoSize <> Value then
  6582.   begin
  6583.     FAutoSize := Value;
  6584.     UpdateHeight;
  6585.   end;
  6586. end;
  6587.  
  6588. procedure TCustomHotKey.SetModifiers(Value: THKModifiers);
  6589. begin
  6590.   if Value <> FModifiers then
  6591.   begin
  6592.     FModifiers := Value;
  6593.     SendMessage(Handle, HKM_SETRULES, Byte(FInvalidKeys), MakeLong(Byte(Value), 0));
  6594.     SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6595.   end;
  6596. end;
  6597.  
  6598. procedure TCustomHotKey.SetInvalidKeys(Value: THKInvalidKeys);
  6599. begin
  6600.   if Value <> FInvalidKeys then
  6601.   begin
  6602.     FInvalidKeys := Value;
  6603.     SendMessage(Handle, HKM_SETRULES, Byte(Value), MakeLong(Byte(FModifiers), 0));
  6604.     SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6605.   end;
  6606. end;
  6607.  
  6608. function TCustomHotKey.GetHotKey: TShortCut;
  6609. var
  6610.   HK: Longint;
  6611. begin
  6612.   HK := SendMessage(Handle, HKM_GETHOTKEY, 0, 0);
  6613.   Result := HotKeyToShortCut(HK);
  6614. end;
  6615.  
  6616. procedure TCustomHotKey.SetHotKey(Value: TShortCut);
  6617. begin
  6618.   ShortCutToHotKey(Value);
  6619.   SendMessage(Handle, HKM_SETHOTKEY, MakeWord(Byte(FHotKey), Byte(FModifiers)), 0);
  6620. end;
  6621.  
  6622. procedure TCustomHotKey.UpdateHeight;
  6623. begin
  6624.   if FAutoSize then
  6625.   begin
  6626.     ControlStyle := ControlStyle + [csFixedHeight];
  6627.     AdjustHeight;
  6628.   end else
  6629.     ControlStyle := ControlStyle - [csFixedHeight];
  6630. end;
  6631.  
  6632. procedure TCustomHotKey.AdjustHeight;
  6633. var
  6634.   DC: HDC;
  6635.   SaveFont: HFont;
  6636.   I: Integer;
  6637.   SysMetrics, Metrics: TTextMetric;
  6638. begin
  6639.   DC := GetDC(0);
  6640.   GetTextMetrics(DC, SysMetrics);
  6641.   SaveFont := SelectObject(DC, Font.Handle);
  6642.   GetTextMetrics(DC, Metrics);
  6643.   SelectObject(DC, SaveFont);
  6644.   ReleaseDC(0, DC);
  6645.   if NewStyleControls then
  6646.   begin
  6647.     if Ctl3D then I := 8 else I := 6;
  6648.     I := GetSystemMetrics(SM_CYBORDER) * I;
  6649.   end else
  6650.   begin
  6651.     I := SysMetrics.tmHeight;
  6652.     if I > Metrics.tmHeight then I := Metrics.tmHeight;
  6653.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  6654.   end;
  6655.   Height := Metrics.tmHeight + I;
  6656. end;
  6657.  
  6658. procedure TCustomHotKey.ShortCutToHotKey(Value: TShortCut);
  6659. begin
  6660.   FHotKey := Value and not (scShift + scCtrl + scAlt);
  6661.   FModifiers := [];
  6662.   if Value and scShift <> 0 then Include(FModifiers, hkShift);
  6663.   if Value and scCtrl <> 0 then Include(FModifiers, hkCtrl);
  6664.   if Value and scAlt <> 0 then Include(FModifiers, hkAlt);
  6665. end;
  6666.  
  6667. function TCustomHotKey.HotKeyToShortCut(Value: Longint): TShortCut;
  6668. begin
  6669.   Byte(FModifiers) := LoWord(HiByte(Value));
  6670.   FHotKey := LoWord(LoByte(Value));
  6671.   Result := FHotKey;
  6672.   if hkShift in FModifiers then Inc(Result, scShift);
  6673.   if hkCtrl in FModifiers then Inc(Result, scCtrl);
  6674.   if hkAlt in FModifiers then Inc(Result, scAlt);
  6675. end;
  6676.  
  6677. { TListColumn }
  6678.  
  6679. constructor TListColumn.Create(Collection: TCollection);
  6680. var
  6681.   Column: TLVColumn;
  6682. begin
  6683.   inherited Create(Collection);
  6684.   FWidth := 50;
  6685.   FAlignment := taLeftJustify;
  6686.   with Column do
  6687.   begin
  6688.     mask := LVCF_FMT or LVCF_WIDTH;
  6689.     fmt := LVCFMT_LEFT;
  6690.     cx := FWidth;
  6691.   end;
  6692.   ListView_InsertColumn(TListColumns(Collection).Owner.Handle, Index, Column);
  6693. end;
  6694.  
  6695. destructor TListColumn.Destroy;
  6696. begin
  6697.   if TListColumns(Collection).Owner.HandleAllocated then
  6698.     ListView_DeleteColumn(TListColumns(Collection).Owner.Handle, Index);
  6699.   inherited Destroy;
  6700. end;
  6701.  
  6702. procedure TListColumn.DefineProperties(Filer: TFiler);
  6703. begin
  6704.   inherited DefineProperties(Filer);
  6705.   Filer.DefineProperty('WidthType', ReadData, WriteData,
  6706.     WidthType <= ColumnTextWidth);
  6707. end;
  6708.  
  6709. procedure TListColumn.ReadData(Reader: TReader);
  6710. begin
  6711.   with Reader do
  6712.   begin
  6713.     ReadListBegin;
  6714.     Width := TWidth(ReadInteger);
  6715.     ReadListEnd;
  6716.   end;
  6717. end;
  6718.  
  6719. procedure TListColumn.WriteData(Writer: TWriter);
  6720. begin
  6721.   with Writer do
  6722.   begin
  6723.     WriteListBegin;
  6724.     WriteInteger(Ord(WidthType));
  6725.     WriteListEnd;
  6726.   end;
  6727. end;
  6728.  
  6729. procedure TListColumn.DoChange;
  6730. var
  6731.   I: Integer;
  6732. begin
  6733.   for I := 0 to Collection.Count - 1 do
  6734.     if TListColumn(Collection.Items[I]).WidthType <= ColumnTextWidth then Break;
  6735.   Changed(I <> Collection.Count);
  6736. end;
  6737.  
  6738. procedure TListColumn.SetCaption(const Value: string);
  6739. begin
  6740.   if FCaption <> Value then
  6741.   begin
  6742.     FCaption := Value;
  6743.     DoChange;
  6744.   end;
  6745. end;
  6746.  
  6747. function TListColumn.GetWidth: TWidth;
  6748. var
  6749.   Column: TLVColumn;
  6750.   ListView: TCustomListView;
  6751. begin
  6752.   ListView := TListColumns(Collection).Owner;
  6753.   if ListView.HandleAllocated then
  6754.   begin
  6755.     Column.mask := LVCF_WIDTH;
  6756.     ListView_GetColumn(ListView.Handle, Index, Column);
  6757.     Result := Column.cx;
  6758.     if WidthType > ColumnTextWidth then FWidth := Result;
  6759.   end
  6760.   else Result := 0;
  6761. end;
  6762.  
  6763. procedure TListColumn.SetWidth(Value: TWidth);
  6764. begin
  6765.   if Width <> Value then
  6766.   begin
  6767.     FWidth := Value;
  6768.     DoChange;
  6769.   end;
  6770. end;
  6771.  
  6772. procedure TListColumn.SetAlignment(Value: TAlignment);
  6773. begin
  6774.   if (Alignment <> Value) and (Index <> 0) then
  6775.   begin
  6776.     FAlignment := Value;
  6777.     Changed(False);
  6778.     TListColumns(Collection).Owner.Repaint;
  6779.   end;
  6780. end;
  6781.  
  6782. procedure TListColumn.Assign(Source: TPersistent);
  6783. var
  6784.   Column: TListColumn;
  6785. begin
  6786.   if Source is TListColumn then
  6787.   begin
  6788.     Column := TListColumn(Source);
  6789.     Alignment := Column.Alignment;
  6790.     Width := Column.Width;
  6791.     Caption := Column.Caption;
  6792.   end
  6793.   else inherited Assign(Source);
  6794. end;
  6795.  
  6796. { TListColumns }
  6797.  
  6798. constructor TListColumns.Create(AOwner: TCustomListView);
  6799. begin
  6800.   inherited Create(TListColumn);
  6801.   FOwner := AOwner;
  6802. end;
  6803.  
  6804. function TListColumns.GetItem(Index: Integer): TListColumn;
  6805. begin
  6806.   Result := TListColumn(inherited GetItem(Index));
  6807. end;
  6808.  
  6809. procedure TListColumns.SetItem(Index: Integer; Value: TListColumn);
  6810. begin
  6811.   inherited SetItem(Index, Value);
  6812. end;
  6813.  
  6814. function TListColumns.Add: TListColumn;
  6815. begin
  6816.   Result := TListColumn(inherited Add);
  6817. end;
  6818.  
  6819. procedure TListColumns.Update(Item: TCollectionItem);
  6820. begin
  6821.   if Item <> nil then Owner.UpdateColumn(Item.Index)
  6822.   else Owner.UpdateColumns;
  6823. end;
  6824.  
  6825. { TSubItems }
  6826.  
  6827. type
  6828.   TSubItems = class(TStringList)
  6829.   private
  6830.     FOwner: TListItem;
  6831.     procedure SetColumnWidth(Index: Integer);
  6832.   protected
  6833.     function GetHandle: HWND;
  6834.     procedure SetUpdateState(Updating: Boolean); override;
  6835.   public
  6836.     constructor Create(AOwner: TListItem);
  6837.     function Add(const S: string): Integer; override;
  6838.     procedure Insert(Index: Integer; const S: string); override;
  6839.     property Handle: HWND read GetHandle;
  6840.     property Owner: TListItem read FOwner;
  6841.   end;
  6842.  
  6843. constructor TSubItems.Create(AOwner: TListItem);
  6844. begin
  6845.   inherited Create;
  6846.   FOwner := AOwner;
  6847. end;
  6848.  
  6849. function TSubItems.GetHandle: HWND;
  6850. begin
  6851.   Result := Owner.Owner.Handle;
  6852. end;
  6853.  
  6854. procedure TSubItems.SetColumnWidth(Index: Integer);
  6855. var
  6856.   ListView: TCustomListView;
  6857. begin
  6858.   ListView := Owner.ListView;
  6859.   if ListView.ColumnsShowing and
  6860.     (ListView.Columns.Count > Index) and
  6861.     (ListView.Column[Index].WidthType = ColumnTextWidth) then
  6862.     ListView.UpdateColumn(Index);
  6863. end;
  6864.  
  6865. function TSubItems.Add(const S: string): Integer;
  6866. begin
  6867.   Result := inherited Add(S);
  6868.   ListView_SetItemText(Handle, Owner.Index, Count, LPSTR_TEXTCALLBACK);
  6869.   SetColumnWidth(Count);
  6870. end;
  6871.  
  6872. procedure TSubItems.Insert(Index: Integer; const S: string);
  6873. begin
  6874.   inherited Insert(Index, S);
  6875.   ListView_SetItemText(Handle, Owner.Index, Index + 1, LPSTR_TEXTCALLBACK);
  6876.   SetColumnWidth(Index + 1);
  6877. end;
  6878.  
  6879. procedure TSubItems.SetUpdateState(Updating: Boolean);
  6880. begin
  6881.   Owner.Owner.SetUpdateState(Updating);
  6882. end;
  6883.  
  6884. { TListItem }
  6885.  
  6886. constructor TListItem.Create(AOwner: TListItems);
  6887. begin
  6888.   FOwner := AOwner;
  6889.   FSubItems := TSubItems.Create(Self);
  6890.   FOverlayIndex := -1;
  6891.   FStateIndex := -1;
  6892. end;
  6893.  
  6894. destructor TListItem.Destroy;
  6895. begin
  6896.   FDeleting := True;
  6897.   if ListView.HandleAllocated then ListView_DeleteItem(Handle, Index);
  6898.   FSubItems.Free;
  6899.   inherited Destroy;
  6900. end;
  6901.  
  6902. function TListItem.GetListView: TCustomListView;
  6903. begin
  6904.   Result := Owner.Owner;
  6905. end;
  6906.  
  6907. procedure TListItem.Delete;
  6908. begin
  6909.   if not FDeleting then Free;
  6910. end;
  6911.  
  6912. function TListItem.GetHandle: HWND;
  6913. begin
  6914.   Result := ListView.Handle;
  6915. end;
  6916.  
  6917. procedure TListItem.MakeVisible(PartialOK: Boolean);
  6918. begin
  6919.   ListView_EnsureVisible(Handle, Index, PartialOK);
  6920. end;
  6921.  
  6922. function TListItem.GetLeft: Integer;
  6923. begin
  6924.   Result := GetPosition.X;
  6925. end;
  6926.  
  6927. procedure TListItem.SetLeft(Value: Integer);
  6928. begin
  6929.   SetPosition(Point(Value, 0));
  6930. end;
  6931.  
  6932. function TListItem.GetTop: Integer;
  6933. begin
  6934.   Result := GetPosition.Y;
  6935. end;
  6936.  
  6937. procedure TListItem.SetTop(Value: Integer);
  6938. begin
  6939.   SetPosition(Point(0, Value));
  6940. end;
  6941.  
  6942. procedure TListItem.Update;
  6943. begin
  6944.   ListView_Update(Handle, Index);
  6945. end;
  6946.  
  6947. procedure TListItem.SetCaption(const Value: string);
  6948. begin
  6949.   FCaption := Value;
  6950.   ListView_SetItemText(Handle, Index, 0, LPSTR_TEXTCALLBACK);
  6951.   if ListView.ColumnsShowing and
  6952.     (ListView.Columns.Count > 0) and
  6953.     (ListView.Column[0].WidthType <= ColumnTextWidth) then
  6954.     ListView.UpdateColumns;
  6955.   if ListView.SortType in [stBoth, stText] then ListView.AlphaSort;
  6956. end;
  6957.  
  6958. procedure TListItem.SetData(Value: Pointer);
  6959. begin
  6960.   FData := Value;
  6961.   if ListView.SortType in [stBoth, stData] then ListView.AlphaSort;
  6962. end;
  6963.  
  6964. function TListItem.EditCaption: Boolean;
  6965. begin
  6966.   Result := ListView_EditLabel(Handle, Index) <> 0;
  6967. end;
  6968.  
  6969. procedure TListItem.CancelEdit;
  6970. begin
  6971.   ListView_EditLabel(Handle, -1);
  6972. end;
  6973.  
  6974. function TListItem.GetState(Index: Integer): Boolean;
  6975. var
  6976.   Mask: Integer;
  6977. begin
  6978.   case Index of
  6979.     0: Mask := LVIS_CUT;
  6980.     1: Mask := LVIS_DROPHILITED;
  6981.     2: Mask := LVIS_FOCUSED;
  6982.     3: Mask := LVIS_SELECTED;
  6983.   end;
  6984.   Result := ListView_GetItemState(Handle, Self.Index, Mask) and Mask <> 0;
  6985. end;
  6986.  
  6987. procedure TListItem.SetState(Index: Integer; State: Boolean);
  6988. var
  6989.   Mask: Integer;
  6990.   Data: Integer;
  6991. begin
  6992.   case Index of
  6993.     0: Mask := LVIS_CUT;
  6994.     1: Mask := LVIS_DROPHILITED;
  6995.     2: Mask := LVIS_FOCUSED;
  6996.     3: Mask := LVIS_SELECTED;
  6997.   end;
  6998.   if State then Data := Mask
  6999.   else Data := 0;
  7000.   ListView_SetItemState(Handle, Self.Index, Data, Mask);
  7001. end;
  7002.  
  7003. procedure TListItem.SetImage(Index: Integer; Value: Integer);
  7004. var
  7005.   Item: TLVItem;
  7006. begin
  7007.   case Index of
  7008.     0:
  7009.       begin
  7010.         FImageIndex := Value;
  7011.         with Item do
  7012.         begin
  7013.           mask := LVIF_IMAGE;
  7014.           iImage := I_IMAGECALLBACK;
  7015.           iItem := Self.Index;
  7016.           iSubItem := 0;
  7017.         end;
  7018.         ListView_SetItem(Handle, Item);
  7019.       end;
  7020.     1:
  7021.       begin
  7022.         FOverlayIndex := Value;
  7023.         ListView_SetItemState(Handle, Self.Index,
  7024.           IndexToOverlayMask(OverlayIndex + 1), LVIS_OVERLAYMASK);
  7025.       end;
  7026.     2:
  7027.       begin
  7028.         FStateIndex := Value;
  7029.         ListView_SetItemState(Handle, Self.Index,
  7030.           IndexToStateImageMask(StateIndex + 1), LVIS_STATEIMAGEMASK);
  7031.       end;
  7032.   end;
  7033.   ListView.UpdateItems(Self.Index, Self.Index);
  7034. end;
  7035.  
  7036. procedure TListItem.Assign(Source: TPersistent);
  7037. begin
  7038.   if Source is TListItem then
  7039.     with Source as TListItem do
  7040.     begin
  7041.       Self.Caption := Caption;
  7042.       Self.Data := Data;
  7043.       Self.ImageIndex := ImageIndex;
  7044.       Self.OverlayIndex := OverlayIndex;
  7045.       Self.StateIndex := StateIndex;
  7046.       Self.SubItems := SubItems;
  7047.     end
  7048.   else inherited Assign(Source);
  7049. end;
  7050.  
  7051. function TListItem.IsEqual(Item: TListItem): Boolean;
  7052. begin
  7053.   Result := (Caption = Item.Caption) and (Data = Item.Data);
  7054. end;
  7055.  
  7056. procedure TListItem.SetSubItems(Value: TStrings);
  7057. begin
  7058.   if Value <> nil then FSubItems.Assign(Value);
  7059. end;
  7060.  
  7061. function TListItem.GetIndex: Integer;
  7062. begin
  7063.   Result := Owner.IndexOf(Self);
  7064. end;
  7065.  
  7066. function TListItem.GetPosition: TPoint;
  7067. begin
  7068.   ListView_GetItemPosition(Handle, Index, Result);
  7069. end;
  7070.  
  7071. procedure TListItem.SetPosition(const Value: TPoint);
  7072. begin
  7073.   if ListView.ViewStyle in [vsSmallIcon, vsIcon] then
  7074.     ListView_SetItemPosition32(Handle, Index, Value.X, Value.Y);
  7075. end;
  7076.  
  7077. function TListItem.DisplayRect(Code: TDisplayCode): TRect;
  7078. const
  7079.   Codes: array[TDisplayCode] of Longint = (LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL,
  7080.     LVIR_SELECTBOUNDS);
  7081. begin
  7082.   ListView_GetItemRect(Handle, Index, Result, Codes[Code]);
  7083. end;
  7084.  
  7085. { TListItems }
  7086.  
  7087. type
  7088.   PItemHeader = ^TItemHeader;
  7089.   TItemHeader = packed record
  7090.     Size, Count: Integer;
  7091.     Items: record end;
  7092.   end;
  7093.   PItemInfo = ^TItemInfo;
  7094.   TItemInfo = packed record
  7095.     ImageIndex: Integer;
  7096.     StateIndex: Integer;
  7097.     OverlayIndex: Integer;
  7098.     SubItemCount: Integer;
  7099.     Data: Pointer;
  7100.     Caption: string[255];
  7101.   end;
  7102.   ShortStr = string[255];
  7103.   PShortStr = ^ShortStr;
  7104.  
  7105. constructor TListItems.Create(AOwner: TCustomListView);
  7106. begin
  7107.   inherited Create;
  7108.   FOwner := AOwner;
  7109. end;
  7110.  
  7111. destructor TListItems.Destroy;
  7112. begin
  7113.   Clear;
  7114.   inherited Destroy;
  7115. end;
  7116.  
  7117. function TListItems.Add: TListItem;
  7118. begin
  7119.   Result := Owner.CreateListItem;
  7120.   ListView_InsertItem(Handle, CreateItem(Count, Result));
  7121. end;
  7122.  
  7123. function TListItems.Insert(Index: Integer): TListItem;
  7124. begin
  7125.   Result := Owner.CreateListItem;
  7126.   ListView_InsertItem(Handle, CreateItem(Index, Result));
  7127. end;
  7128.  
  7129. function TListItems.GetCount: Integer;
  7130. begin
  7131.   if Owner.HandleAllocated then Result := ListView_GetItemCount(Handle)
  7132.   else Result := 0;
  7133. end;
  7134.  
  7135. function TListItems.GetHandle: HWND;
  7136. begin
  7137.   Result := Owner.Handle;
  7138. end;
  7139.  
  7140. function TListItems.GetItem(Index: Integer): TListItem;
  7141. var
  7142.   Item: TLVItem;
  7143. begin
  7144.   Result := nil;
  7145.   if Owner.HandleAllocated then
  7146.   begin
  7147.     with Item do
  7148.     begin
  7149.       mask := LVIF_PARAM;
  7150.       iItem := Index;
  7151.       iSubItem := 0;
  7152.     end;
  7153.     if ListView_GetItem(Handle, Item) then Result := TListItem(Item.lParam);
  7154.   end;
  7155. end;
  7156.  
  7157. function TListItems.IndexOf(Value: TListItem): Integer;
  7158. var
  7159.   Info: TLVFindInfo;
  7160. begin
  7161.   with Info do
  7162.   begin
  7163.     flags := LVFI_PARAM;
  7164.     lParam := Integer(Value);
  7165.   end;
  7166.   Result := ListView_FindItem(Handle, -1, Info);
  7167. end;
  7168.  
  7169. procedure TListItems.SetItem(Index: Integer; Value: TListItem);
  7170. begin
  7171.   Item[Index].Assign(Value);
  7172. end;
  7173.  
  7174. procedure TListItems.Clear;
  7175. begin
  7176.   if Owner.HandleAllocated then ListView_DeleteAllItems(Handle);
  7177. end;
  7178.  
  7179. procedure TListItems.BeginUpdate;
  7180. begin
  7181.   if FUpdateCount = 0 then SetUpdateState(True);
  7182.   Inc(FUpdateCount);
  7183. end;
  7184.  
  7185. procedure TListItems.SetUpdateState(Updating: Boolean);
  7186. begin
  7187.   if Updating then
  7188.   begin
  7189.     SendMessage(Handle, WM_SETREDRAW, 0, 0);
  7190.     if Owner.ColumnsShowing and Owner.ValidHeaderHandle then
  7191.       SendMessage(Owner.FHeaderHandle, WM_SETREDRAW, 0, 0);
  7192.   end
  7193.   else if FUpdateCount = 0 then
  7194.   begin
  7195.     FNoRedraw := True;
  7196.     try
  7197.       SendMessage(Handle, WM_SETREDRAW, 1, 0);
  7198.       Owner.Invalidate;
  7199.     finally
  7200.       FNoRedraw := False;
  7201.     end;
  7202.     if Owner.ColumnsShowing and Owner.ValidHeaderHandle then
  7203.       SendMessage(Owner.FHeaderHandle, WM_SETREDRAW, 1, 0);
  7204.   end;
  7205. end;
  7206.  
  7207. procedure TListItems.EndUpdate;
  7208. begin
  7209.   Dec(FUpdateCount);
  7210.   if FUpdateCount = 0 then SetUpdateState(False);
  7211. end;
  7212.  
  7213. procedure TListItems.Assign(Source: TPersistent);
  7214. var
  7215.   Items: TListItems;
  7216.   I: Integer;
  7217. begin
  7218.   if Source is TListItems then
  7219.   begin
  7220.     Clear;
  7221.     Items := TListItems(Source);
  7222.     for I := 0 to Items.Count - 1 do Add.Assign(Items[I]);
  7223.   end
  7224.   else inherited Assign(Source);
  7225. end;
  7226.  
  7227. procedure TListItems.DefineProperties(Filer: TFiler);
  7228.  
  7229.   function WriteItems: Boolean;
  7230.   var
  7231.     I: Integer;
  7232.     Items: TListItems;
  7233.   begin
  7234.     Items := TListItems(Filer.Ancestor);
  7235.     if (Items = nil) then
  7236.       Result := Count > 0
  7237.     else if (Items.Count <> Count) then
  7238.       Result := True
  7239.     else
  7240.     begin
  7241.       Result := False;
  7242.       for I := 0 to Count - 1 do
  7243.       begin
  7244.         Result := not Item[I].IsEqual(Items[I]);
  7245.         if Result then Break;
  7246.       end
  7247.     end;
  7248.   end;
  7249.  
  7250. begin
  7251.   inherited DefineProperties(Filer);
  7252.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteItems);
  7253. end;
  7254.  
  7255. procedure TListItems.ReadData(Stream: TStream);
  7256. var
  7257.   I, J, Size, L, Len: Integer;
  7258.   ItemHeader: PItemHeader;
  7259.   ItemInfo: PItemInfo;
  7260.   PStr: PShortStr;
  7261. begin
  7262.   Clear;
  7263.   Stream.ReadBuffer(Size, SizeOf(Integer));
  7264.   ItemHeader := AllocMem(Size);
  7265.   try
  7266.     Stream.ReadBuffer(ItemHeader^.Count, Size - SizeOf(Integer));
  7267.     ItemInfo := @ItemHeader^.Items;
  7268.     for I := 0 to ItemHeader^.Count - 1 do
  7269.     begin
  7270.       with Add do
  7271.       begin
  7272.         Caption := ItemInfo^.Caption;
  7273.         ImageIndex := ItemInfo^.ImageIndex;
  7274.         OverlayIndex := ItemInfo^.OverlayIndex;
  7275.         StateIndex := ItemInfo^.StateIndex;
  7276.         Data := ItemInfo^.Data;
  7277.         PStr := @ItemInfo^.Caption;
  7278.         Inc(Integer(PStr), Length(PStr^) + 1);
  7279.         Len := 0;
  7280.         for J := 0 to ItemInfo^.SubItemCount - 1 do
  7281.         begin
  7282.           SubItems.Add(PStr^);
  7283.           L := Length(PStr^);
  7284.           Inc(Len, L + 1);
  7285.           Inc(Integer(PStr), L + 1);
  7286.         end;
  7287.       end;
  7288.       Inc(Integer(ItemInfo), SizeOf(TItemInfo) - 255 +
  7289.         Length(ItemInfo.Caption) + Len);
  7290.     end;
  7291.   finally
  7292.     FreeMem(ItemHeader, Size);
  7293.   end;
  7294. end;
  7295.  
  7296. procedure TListItems.WriteData(Stream: TStream);
  7297. var
  7298.   I, J, Size, L, Len: Integer;
  7299.   ItemHeader: PItemHeader;
  7300.   ItemInfo: PItemInfo;
  7301.   PStr: PShortStr;
  7302.  
  7303.   function GetLength(const S: string): Integer;
  7304.   begin
  7305.     Result := Length(S);
  7306.     if Result > 255 then Result := 255;
  7307.   end;
  7308.  
  7309. begin
  7310.   Size := SizeOf(TItemHeader);
  7311.   for I := 0 to Count - 1 do
  7312.   begin
  7313.     L := GetLength(Item[I].Caption);
  7314.     for J := 0 to Item[I].SubItems.Count - 1 do
  7315.       Inc(L, GetLength(Item[I].SubItems[J]) + 1);
  7316.     Inc(Size, SizeOf(TItemInfo) - 255 + L);
  7317.   end;
  7318.   ItemHeader := AllocMem(Size);
  7319.   try
  7320.     ItemHeader^.Size := Size;
  7321.     ItemHeader^.Count := Count;
  7322.     ItemInfo := @ItemHeader^.Items;
  7323.     for I := 0 to Count - 1 do
  7324.     begin
  7325.       with Item[I] do
  7326.       begin
  7327.         ItemInfo^.Caption := Caption;
  7328.         ItemInfo^.ImageIndex := ImageIndex;
  7329.         ItemInfo^.OverlayIndex := OverlayIndex;
  7330.         ItemInfo^.StateIndex := StateIndex;
  7331.         ItemInfo^.Data := Data;
  7332.         ItemInfo^.SubItemCount := SubItems.Count;
  7333.         PStr := @ItemInfo^.Caption;
  7334.         Inc(Integer(PStr), Length(ItemInfo^.Caption) + 1);
  7335.         Len := 0;
  7336.         for J := 0 to SubItems.Count - 1 do
  7337.         begin
  7338.           PStr^ := SubItems[J];
  7339.           L := Length(PStr^);
  7340.           Inc(Len, L + 1);
  7341.           Inc(Integer(PStr), L + 1);
  7342.         end;
  7343.       end;
  7344.       Inc(Integer(ItemInfo), SizeOf(TItemInfo) - 255 +
  7345.         Length(ItemInfo^.Caption) + Len);
  7346.     end;
  7347.     Stream.WriteBuffer(ItemHeader^, Size);
  7348.   finally
  7349.     FreeMem(ItemHeader, Size);
  7350.   end;
  7351. end;
  7352.  
  7353. procedure TListItems.Delete(Index: Integer);
  7354. begin
  7355.   Item[Index].Delete;
  7356. end;
  7357.  
  7358. function TListItems.CreateItem(Index: Integer;
  7359.   ListItem: TListItem): TLVItem;
  7360. begin
  7361.   with Result do
  7362.   begin
  7363.     mask := LVIF_PARAM or LVIF_IMAGE;
  7364.     iItem := Index;
  7365.     iSubItem := 0;
  7366.     iImage := I_IMAGECALLBACK;
  7367.     lParam := Longint(ListItem);
  7368.   end;
  7369. end;
  7370.  
  7371. { TIconOptions }
  7372.  
  7373. constructor TIconOptions.Create(AOwner: TCustomListView);
  7374. begin
  7375.   inherited Create;
  7376.   if AOwner = nil then raise Exception.CreateRes(sInvalidOwner);
  7377.   FListView := AOwner;
  7378.   Arrangement := iaTop;
  7379.   AutoArrange := False;
  7380.   WrapText := True;
  7381. end;
  7382.  
  7383. procedure TIconOptions.SetArrangement(Value: TIconArrangement);
  7384. begin
  7385.   if Value <> Arrangement then
  7386.   begin;
  7387.     FArrangement := Value;
  7388.     FListView.RecreateWnd;
  7389.     {FListView.SetIconArrangement(Value);}
  7390.   end;
  7391. end;
  7392.  
  7393. procedure TIconOptions.SetAutoArrange(Value: Boolean);
  7394. begin
  7395.   if Value <> AutoArrange then
  7396.   begin
  7397.     FAutoArrange := Value;
  7398.     FListView.RecreateWnd;
  7399.   end;
  7400. end;
  7401.  
  7402. procedure TIconOptions.SetWrapText(Value: Boolean);
  7403. begin
  7404.   if Value <> WrapText then
  7405.   begin
  7406.     FWrapText := Value;
  7407.     FListView.RecreateWnd;
  7408.   end;
  7409. end;
  7410.  
  7411. { TCustomListView }
  7412.  
  7413. function DefaultListViewSort(Item1, Item2: TListItem;
  7414.   lParam: Integer): Integer; stdcall;
  7415. begin
  7416.   with Item1 do
  7417.     if Assigned(ListView.OnCompare) then
  7418.       ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
  7419.     else Result := lstrcmp(PChar(Item1.Caption), PChar(Item2.Caption));
  7420. end;
  7421.  
  7422. constructor TCustomListView.Create(AOwner: TComponent);
  7423. begin
  7424.   inherited Create(AOwner);
  7425.   ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage];
  7426.   Width := 250;
  7427.   Height := 150;
  7428.   BorderStyle := bsSingle;
  7429.   ViewStyle := vsIcon;
  7430.   ParentColor := False;
  7431.   TabStop := True;
  7432.   HideSelection := True;
  7433.   ShowColumnHeaders := True;
  7434.   ColumnClick := True;
  7435.   FDragIndex := -1;
  7436.   FListColumns := TListColumns.Create(Self);
  7437.   FListItems := TListItems.Create(Self);
  7438.   FIconOptions := TIconOptions.Create(Self);
  7439.   FDragImage := TImageList.CreateSize(32, 32);
  7440.   FEditInstance := MakeObjectInstance(EditWndProc);
  7441.   FHeaderInstance := MakeObjectInstance(HeaderWndProc);
  7442.   FLargeChangeLink := TChangeLink.Create;
  7443.   FLargeChangeLink.OnChange := ImageListChange;
  7444.   FSmallChangeLink := TChangeLink.Create;
  7445.   FSmallChangeLink.OnChange := ImageListChange;
  7446.   FStateChangeLink := TChangeLink.Create;
  7447.   FStateChangeLink.OnChange := ImageListChange;
  7448. end;
  7449.  
  7450. destructor TCustomListView.Destroy;
  7451. begin
  7452.   FDragImage.Free;
  7453.   FListColumns.Free;
  7454.   FListItems.Free;
  7455.   FIconOptions.Free;
  7456.   FMemStream.Free;
  7457.   FreeObjectInstance(FEditInstance);
  7458.   if FHeaderHandle <> 0 then
  7459.     SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
  7460.   FreeObjectInstance(FHeaderInstance);
  7461.   FLargeChangeLink.Free;
  7462.   FSmallChangeLink.Free;
  7463.   FStateChangeLink.Free;
  7464.   inherited Destroy;
  7465. end;
  7466.  
  7467. procedure TCustomListView.CreateParams(var Params: TCreateParams);
  7468. const
  7469.   BorderStyles: array[TBorderStyle] of Integer = (0, WS_BORDER);
  7470.   EditStyles: array[Boolean] of Integer = (LVS_EDITLABELS, 0);
  7471.   MultiSelections: array[Boolean] of Integer = (LVS_SINGLESEL, 0);
  7472.   HideSelections: array[Boolean] of Integer = (LVS_SHOWSELALWAYS, 0);
  7473.   Arrangements: array[TIconArrangement] of Integer = (LVS_ALIGNTOP,
  7474.     LVS_ALIGNLEFT);
  7475.   AutoArrange: array[Boolean] of Integer = (0, LVS_AUTOARRANGE);
  7476.   WrapText: array[Boolean] of Integer = (LVS_NOLABELWRAP, 0);
  7477.   ViewStyles: array[TViewStyle] of Integer = (LVS_ICON, LVS_SMALLICON,
  7478.     LVS_LIST, LVS_REPORT);
  7479.   ShowColumns: array[Boolean] of Integer = (LVS_NOCOLUMNHEADER, 0);
  7480.   ColumnClicks: array[Boolean] of Integer = (LVS_NOSORTHEADER, 0);
  7481. begin
  7482.   InitCommonControls;
  7483.   inherited CreateParams(Params);
  7484.   CreateSubClass(Params, WC_LISTVIEW);
  7485.   with Params do
  7486.   begin
  7487.     Style := Style or WS_CLIPCHILDREN or ViewStyles[ViewStyle] or
  7488.       BorderStyles[BorderStyle] or Arrangements[IconOptions.Arrangement] or
  7489.       EditStyles[ReadOnly] or MultiSelections[MultiSelect] or
  7490.       HideSelections[HideSelection] or
  7491.       AutoArrange[IconOptions.AutoArrange] or
  7492.       WrapText[IconOptions.WrapText] or
  7493.       ShowColumns[ShowColumnHeaders] or
  7494.       ColumnClicks[ColumnClick] or
  7495.       LVS_SHAREIMAGELISTS;
  7496.     if Ctl3D and (FBorderStyle = bsSingle) then
  7497.       ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  7498.   end;
  7499. end;
  7500.  
  7501. procedure TCustomListView.CreateWnd;
  7502. begin
  7503.   inherited CreateWnd;
  7504.   SetTextBKColor(Color);
  7505.   SetTextColor(Font.Color);
  7506.   SetAllocBy(AllocBy);
  7507.   if FMemStream <> nil then
  7508.   begin
  7509.     Items.BeginUpdate;
  7510.     try
  7511.       Columns.Clear;
  7512.       FMemStream.ReadComponentRes(Self);
  7513.       FMemStream.Destroy;
  7514.       FMemStream := nil;
  7515.       Font := Font;
  7516.     finally
  7517.       Items.EndUpdate;
  7518.     end;
  7519.   end;
  7520.   if (LargeImages <> nil) and LargeImages.HandleAllocated then
  7521.     SetImageList(LargeImages.Handle, LVSIL_NORMAL);
  7522.   if (SmallImages <> nil) and SmallImages.HandleAllocated then
  7523.     SetImageList(SmallImages.Handle, LVSIL_SMALL);
  7524.   if (StateImages <> nil) and StateImages.HandleAllocated then
  7525.     SetImageList(StateImages.Handle, TVSIL_STATE);
  7526. end;
  7527.  
  7528. procedure TCustomListView.DestroyWnd;
  7529. begin
  7530.   FMemStream := TMemoryStream.Create;
  7531.   FMemStream.WriteComponentRes(ClassName, Self);
  7532.   FMemStream.Position := 0;
  7533.   inherited DestroyWnd;
  7534. end;
  7535.  
  7536. procedure TCustomListView.SetImageList(Value: HImageList; Flags: Integer);
  7537. begin
  7538.   if HandleAllocated then ListView_SetImageList(Handle, Value, Flags);
  7539. end;
  7540.  
  7541. procedure TCustomListView.ImageListChange(Sender: TObject);
  7542. var
  7543.   ImageHandle: HImageList;
  7544. begin
  7545.   if HandleAllocated then
  7546.   begin
  7547.     ImageHandle := TImageList(Sender).Handle;
  7548.     if Sender = LargeImages then SetImageList(ImageHandle, LVSIL_NORMAL)
  7549.     else if Sender = SmallImages then SetImageList(ImageHandle, LVSIL_SMALL)
  7550.     else if Sender = StateImages then SetImageList(ImageHandle, LVSIL_STATE);
  7551.   end;
  7552. end;
  7553.  
  7554. procedure TCustomListView.Notification(AComponent: TComponent;
  7555.   Operation: TOperation);
  7556. begin
  7557.   inherited Notification(AComponent, Operation);
  7558.   if Operation = opRemove then
  7559.   begin
  7560.     if AComponent = LargeImages then LargeImages := nil;
  7561.     if AComponent = SmallImages then SmallImages := nil;
  7562.     if AComponent = StateImages then StateImages := nil;
  7563.   end;
  7564. end;
  7565.  
  7566. procedure TCustomListView.HeaderWndProc(var Message: TMessage);
  7567. begin
  7568.   try
  7569.     with Message do
  7570.     begin
  7571.       case Msg of
  7572.         WM_NCHITTEST:
  7573.           with TWMNCHitTest(Message) do
  7574.             if csDesigning in ComponentState then
  7575.             begin
  7576.               Result := Windows.HTTRANSPARENT;
  7577.               Exit;
  7578.             end;
  7579.         WM_NCDESTROY:
  7580.           begin
  7581.             Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg, WParam, LParam);
  7582.             FHeaderHandle := 0;
  7583.             FDefHeaderProc := nil;
  7584.             Exit;
  7585.           end;
  7586.       end;
  7587.       Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg, WParam, LParam);
  7588.     end;
  7589.   except
  7590.     Application.HandleException(Self);
  7591.   end;
  7592. end;
  7593.  
  7594. procedure TCustomListView.EditWndProc(var Message: TMessage);
  7595. begin
  7596.   try
  7597.     with Message do
  7598.     begin
  7599.       case Msg of
  7600.         WM_KEYDOWN,
  7601.         WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
  7602.         WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit;
  7603.         WM_KEYUP,
  7604.         WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
  7605.         CN_KEYDOWN,
  7606.         CN_CHAR, CN_SYSKEYDOWN,
  7607.         CN_SYSCHAR:
  7608.           begin
  7609.             WndProc(Message);
  7610.             Exit;
  7611.           end;
  7612.       end;
  7613.       Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam);
  7614.     end;
  7615.   except
  7616.     Application.HandleException(Self);
  7617.   end;
  7618. end;
  7619.  
  7620. procedure TCustomListView.UpdateItems(FirstIndex, LastIndex: Integer);
  7621. begin
  7622.   ListView_RedrawItems(Handle, FirstIndex, LastIndex);
  7623. end;
  7624.  
  7625. procedure TCustomListView.SetBorderStyle(Value: TBorderStyle);
  7626. begin
  7627.   if BorderStyle <> Value then
  7628.   begin
  7629.     FBorderStyle := Value;
  7630.     RecreateWnd;
  7631.   end;
  7632. end;
  7633.  
  7634. procedure TCustomListView.SetColumnClick(Value: Boolean);
  7635. begin
  7636.   if ColumnClick <> Value then
  7637.   begin
  7638.     FColumnClick := Value;
  7639.     RecreateWnd;
  7640.   end;
  7641. end;
  7642.  
  7643. procedure TCustomListView.SetMultiSelect(Value: Boolean);
  7644. begin
  7645.   if Value <> MultiSelect then
  7646.   begin
  7647.     FMultiSelect := Value;
  7648.     RecreateWnd;
  7649.   end;
  7650. end;
  7651.  
  7652. procedure TCustomListView.SetColumnHeaders(Value: Boolean);
  7653. begin
  7654.   if Value <> ShowColumnHeaders then
  7655.   begin
  7656.     FShowColumnHeaders := Value;
  7657.     RecreateWnd;
  7658.   end;
  7659. end;
  7660.  
  7661. procedure TCustomListView.SetTextColor(Value: TColor);
  7662. begin
  7663.   ListView_SetTextColor(Handle, ColorToRGB(Font.Color));
  7664. end;
  7665.  
  7666. procedure TCustomListView.SetTextBkColor(Value: TColor);
  7667. begin
  7668.   ListView_SetTextBkColor(Handle, ColorToRGB(Color));
  7669. end;
  7670.  
  7671. procedure TCustomListView.SetAllocBy(Value: Integer);
  7672. begin
  7673.   if AllocBy <> Value then
  7674.   begin
  7675.     FAllocBy := Value;
  7676.     if HandleAllocated then ListView_SetItemCount(Handle, Value);
  7677.   end;
  7678. end;
  7679.  
  7680. procedure TCustomListView.CMColorChanged(var Message: TMessage);
  7681. begin
  7682.   inherited;
  7683.   SetTextBkColor(Color);
  7684. end;
  7685.  
  7686. procedure TCustomListView.CMCtl3DChanged(var Message: TMessage);
  7687. begin
  7688.   if FBorderStyle = bsSingle then RecreateWnd;
  7689.   inherited;
  7690. end;
  7691.  
  7692. procedure TCustomListView.WMNotify(var Message: TWMNotify);
  7693. begin
  7694.   inherited;
  7695.   if ValidHeaderHandle then
  7696.     with Message.NMHdr^ do
  7697.       if (hWndFrom = FHeaderHandle) and (code = HDN_BEGINTRACK) then
  7698.         with PHDNotify(Pointer(Message.NMHdr))^, PItem^ do
  7699.           if (Mask and HDI_WIDTH) <> 0 then
  7700.             Column[Item].Width := cxy;
  7701. end;
  7702.  
  7703. function TCustomListView.ColumnsShowing: Boolean;
  7704. begin
  7705.   Result := (ViewStyle = vsReport);
  7706. end;
  7707.  
  7708. function TCustomListView.ValidHeaderHandle: Boolean;
  7709. begin
  7710.   Result := FHeaderHandle <> 0;
  7711. end;
  7712.  
  7713. procedure TCustomListView.CMFontChanged(var Message: TMessage);
  7714. begin
  7715.   inherited;
  7716.   if HandleAllocated then
  7717.   begin
  7718.     SetTextColor(Font.Color);
  7719.     if ValidHeaderHandle then
  7720.       InvalidateRect(FHeaderHandle, nil, True);
  7721.   end;
  7722. end;
  7723.  
  7724. procedure TCustomListView.SetHideSelection(Value: Boolean);
  7725. begin
  7726.   if Value <> HideSelection then
  7727.   begin
  7728.     FHideSelection := Value;
  7729.     RecreateWnd;
  7730.   end;
  7731. end;
  7732.  
  7733. procedure TCustomListView.SetReadOnly(Value: Boolean);
  7734. begin
  7735.   if Value <> ReadOnly then
  7736.   begin
  7737.     FReadOnly := Value;
  7738.     RecreateWnd;
  7739.   end;
  7740. end;
  7741.  
  7742. procedure TCustomListView.SetIconOptions(Value: TIconOptions);
  7743. begin
  7744.   with FIconOptions do
  7745.   begin
  7746.     Arrangement := Value.Arrangement;
  7747.     AutoArrange := Value.AutoArrange;
  7748.     WrapText := Value.WrapText;
  7749.   end;
  7750. end;
  7751.  
  7752. procedure TCustomListView.SetIconArrangement(Value: TIconArrangement);
  7753. const
  7754.   Arrangements: array[TIconArrangement] of Integer = (LVS_ALIGNTOP,
  7755.     LVS_ALIGNLEFT);
  7756. var
  7757.   Style: Longint;
  7758. begin
  7759.   if HandleAllocated then
  7760.   begin
  7761.     Style := GetWindowLong(Handle, GWL_STYLE);
  7762.     Style := Style and (not LVS_ALIGNMASK);
  7763.     Style := Style or Arrangements[Value];
  7764.     SetWindowLong(Handle, GWL_STYLE, Style);
  7765.   end;
  7766. end;
  7767.  
  7768. procedure TCustomListView.SetViewStyle(Value: TViewStyle);
  7769. const
  7770.   ViewStyles: array[TViewStyle] of Integer = (LVS_ICON, LVS_SMALLICON,
  7771.     LVS_LIST, LVS_REPORT);
  7772. var
  7773.   Style: Longint;
  7774. begin
  7775.   if Value <> FViewStyle then
  7776.   begin
  7777.     FViewStyle := Value;
  7778.     if HandleAllocated then
  7779.     begin
  7780.       Style := GetWindowLong(Handle, GWL_STYLE);
  7781.       Style := Style and (not LVS_TYPEMASK);
  7782.       Style := Style or ViewStyles[FViewStyle];
  7783.       SetWindowLong(Handle, GWL_STYLE, Style);
  7784.       UpdateColumns;
  7785.       case ViewStyle of
  7786.         vsIcon,
  7787.         vsSmallIcon:
  7788.           if IconOptions.Arrangement = iaTop then
  7789.             Arrange(arAlignTop) else
  7790.             Arrange(arAlignLeft);
  7791.       end;
  7792.     end;
  7793.   end;
  7794. end;
  7795.  
  7796. procedure TCustomListView.WMParentNotify(var Message: TWMParentNotify);
  7797. begin
  7798.   with Message do
  7799.     if (Event = WM_CREATE) and (FHeaderHandle = 0) then
  7800.     begin
  7801.       FHeaderHandle := ChildWnd;
  7802.       FDefHeaderProc := Pointer(GetWindowLong(FHeaderHandle, GWL_WNDPROC));
  7803.       SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));
  7804.     end;
  7805.   inherited;
  7806. end;
  7807.  
  7808. function TCustomListView.GetItemIndex(Value: TListItem): Integer;
  7809. var
  7810.   I: Integer;
  7811. begin
  7812.   Result := -1;
  7813.   for I := 0 to Items.Count - 1 do if Items[I] = Value then Break;
  7814.   if I < Items.Count then Result := I;
  7815. end;
  7816.  
  7817. function TCustomListView.CreateListItem: TListItem;
  7818. begin
  7819.   Result := TListItem.Create(Items);
  7820. end;
  7821.  
  7822. function TCustomListView.GetItem(Value: TLVItem): TListItem;
  7823. begin
  7824.   with Value do
  7825.     if (mask and LVIF_PARAM) <> 0 then Result := TListItem(lParam)
  7826.     else Result := Items[IItem];
  7827. end;
  7828.  
  7829. function TCustomListView.GetSelCount: Integer;
  7830. begin
  7831.   Result := ListView_GetSelectedCount(Handle);
  7832. end;
  7833.  
  7834. procedure TCustomListView.CNNotify(var Message: TWMNotify);
  7835. var
  7836.   Item: TListItem;
  7837.   I: Integer;
  7838. begin
  7839.   with Message.NMHdr^ do
  7840.     case code of
  7841.       LVN_BEGINDRAG:
  7842.         with PNMListView(Pointer(Message.NMHdr))^ do
  7843.           FDragIndex := iItem;
  7844.       LVN_DELETEITEM:
  7845.         with PNMListView(Pointer(Message.NMHdr))^ do
  7846.           Delete(TListItem(lParam));
  7847.       LVN_DELETEALLITEMS:
  7848.         for I := Items.Count - 1 downto 0 do Delete(Items[I]);
  7849.       LVN_GETDISPINFO:
  7850.         begin
  7851.           Item := GetItem(PLVDispInfo(Pointer(Message.NMHdr))^.item);
  7852.           with PLVDispInfo(Pointer(Message.NMHdr))^.item do
  7853.           begin
  7854.             if (mask and LVIF_TEXT) <> 0 then
  7855.               if iSubItem = 0 then
  7856.                 StrPLCopy(pszText, Item.Caption, cchTextMax)
  7857.               else
  7858.                 with Item.SubItems do
  7859.                   if iSubItem <= Count then
  7860.                     StrPLCopy(pszText, Strings[iSubItem - 1], cchTextMax)
  7861.                   else pszText[0] := #0;
  7862.             if (mask and LVIF_IMAGE) <> 0 then iImage := Item.ImageIndex;
  7863.           end;
  7864.         end;
  7865.       LVN_BEGINLABELEDIT:
  7866.         begin
  7867.           Item := GetItem(PLVDispInfo(Pointer(Message.NMHdr))^.item);
  7868.           if not CanEdit(Item) then Message.Result := 1;
  7869.           if Message.Result = 0 then
  7870.           begin
  7871.             FEditHandle := ListView_GetEditControl(Handle);
  7872.             FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  7873.             SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
  7874.           end;
  7875.         end;
  7876.       LVN_ENDLABELEDIT:
  7877.         with PLVDispInfo(Pointer(Message.NMHdr))^ do
  7878.           if (item.pszText <> nil) and (item.IItem <> -1) then
  7879.             Edit(item);
  7880.       LVN_COLUMNCLICK:
  7881.         with PNMListView(Pointer(Message.NMHdr))^ do
  7882.           ColClick(Column[iSubItem]);
  7883.       LVN_INSERTITEM:
  7884.         with PNMListView(Pointer(Message.NMHdr))^ do
  7885.           InsertItem(Items[iItem]);
  7886.       LVN_ITEMCHANGING:
  7887.         with PNMListView(Pointer(Message.NMHdr))^ do
  7888.           if not CanChange(Items[iItem], uChanged) then Message.Result := 1;
  7889.       LVN_ITEMCHANGED:
  7890.         with PNMListView(Pointer(Message.NMHdr))^ do
  7891.           Change(Items[iItem], uChanged);
  7892.       NM_CLICK: FClicked := True;
  7893.       NM_RCLICK: FRClicked := True;
  7894.     end;
  7895. end;
  7896.  
  7897. procedure TCustomListView.ColClick(Column: TListColumn);
  7898. begin
  7899.   if Assigned(FOnColumnClick) then FOnColumnClick(Self, Column);
  7900. end;
  7901.  
  7902. procedure TCustomListView.InsertItem(Item: TListItem);
  7903. begin
  7904.   if Assigned(FOnInsert) then FOnInsert(Self, Item);
  7905. end;
  7906.  
  7907. function TCustomListView.CanChange(Item: TListItem; Change: Integer): Boolean;
  7908. var
  7909.   ItemChange: TItemChange;
  7910. begin
  7911.   Result := True;
  7912.   case Change of
  7913.     LVIF_TEXT: ItemChange := ctText;
  7914.     LVIF_IMAGE: ItemChange := ctImage;
  7915.     LVIF_STATE: ItemChange := ctState;
  7916.   end;
  7917.   if Assigned(FOnChanging) then FOnChanging(Self, Item, ItemChange, Result);
  7918. end;
  7919.  
  7920. procedure TCustomListView.Change(Item: TListItem; Change: Integer);
  7921. var
  7922.   ItemChange: TItemChange;
  7923. begin
  7924.   case Change of
  7925.     LVIF_TEXT: ItemChange := ctText;
  7926.     LVIF_IMAGE: ItemChange := ctImage;
  7927.     LVIF_STATE: ItemChange := ctState;
  7928.   end;
  7929.   if Assigned(FOnChange) then FOnChange(Self, Item, ItemChange);
  7930. end;
  7931.  
  7932. procedure TCustomListView.Delete(Item: TListItem);
  7933. begin
  7934.   if (Item <> nil) and not Item.FProcessedDeleting then
  7935.   begin
  7936.     if Assigned(FOnDeletion) then FOnDeletion(Self, Item);
  7937.     Item.FProcessedDeleting := True;
  7938.     Item.Delete;
  7939.   end;
  7940. end;
  7941.  
  7942. function TCustomListView.CanEdit(Item: TListItem): Boolean;
  7943. begin
  7944.   Result := True;
  7945.   if Assigned(FOnEditing) then FOnEditing(Self, Item, Result);
  7946. end;
  7947.  
  7948. procedure TCustomListView.Edit(const Item: TLVItem);
  7949. var
  7950.   S: string;
  7951.   EditItem: TListItem;
  7952. begin
  7953.   with Item do
  7954.   begin
  7955.     S := pszText;
  7956.     EditItem := GetItem(Item);
  7957.     if Assigned(FOnEdited) then FOnEdited(Self, EditItem, S);
  7958.     if EditItem <> nil then EditItem.Caption := S;
  7959.   end;
  7960. end;
  7961.  
  7962. function TCustomListView.IsEditing: Boolean;
  7963. begin
  7964.   Result := ListView_GetEditControl(Handle) <> 0;
  7965. end;
  7966.  
  7967. function TCustomListView.GetDragImages: TCustomImageList;
  7968. begin
  7969.   if SelCount = 1 then
  7970.     Result := FDragImage else
  7971.     Result := nil;
  7972. end;
  7973.  
  7974. procedure TCustomListView.WndProc(var Message: TMessage);
  7975. begin
  7976.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  7977.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and (DragMode = dmAutomatic) then
  7978.   begin
  7979.     if not IsControlMouseMsg(TWMMouse(Message)) then
  7980.     begin
  7981.       ControlState := ControlState + [csLButtonDown];
  7982.       Dispatch(Message);
  7983.     end;
  7984.   end
  7985.   else if not (((Message.Msg = WM_PAINT) or (Message.Msg = WM_ERASEBKGND)) and
  7986.     Items.FNoRedraw) then
  7987.     inherited WndProc(Message);
  7988. end;
  7989.  
  7990. procedure TCustomListView.DoStartDrag(var DragObject: TDragObject);
  7991. var
  7992.   P, P1: TPoint;
  7993.   ImageHandle: HImageList;
  7994.   DragItem: TListItem;
  7995. begin
  7996.   inherited DoStartDrag(DragObject);
  7997.   FLastDropTarget := nil;
  7998.   GetCursorPos(P);
  7999.   P := ScreenToClient(P);
  8000.   if FDragIndex <> -1 then
  8001.     DragItem := Items[FDragIndex]
  8002.     else DragItem := nil;
  8003.   FDragIndex := -1;
  8004.   if DragItem = nil then
  8005.     with P do DragItem := GetItemAt(X, Y);
  8006.   if DragItem <> nil then
  8007.   begin
  8008.     ImageHandle := ListView_CreateDragImage(Handle, DragItem.Index, P1);
  8009.     if ImageHandle <> 0 then
  8010.       with FDragImage do
  8011.       begin
  8012.         Handle := ImageHandle;
  8013.         with P, DragItem.DisplayRect(drBounds) do
  8014.           SetDragImage(0, X - Left , Y - Top);
  8015.       end;
  8016.   end;
  8017. end;
  8018.  
  8019. procedure TCustomListView.DoEndDrag(Target: TObject; X, Y: Integer);
  8020. begin
  8021.   inherited DoEndDrag(Target, X, Y);
  8022.   FLastDropTarget := nil;
  8023. end;
  8024.  
  8025. procedure TCustomListView.CMDrag(var Message: TCMDrag);
  8026. begin
  8027.   inherited;
  8028.   if Message.Result <> 0 then
  8029.     with Message, DragRec^ do
  8030.       case DragMessage of
  8031.         dmDragMove: with ScreenToClient(Pos) do DoDragOver(Source, X, Y);
  8032.         dmDragLeave:
  8033.           begin
  8034.             TDragObject(Source).HideDragImage;
  8035.             FLastDropTarget := DropTarget;
  8036.             DropTarget := nil;
  8037.             Update;
  8038.             TDragObject(Source).ShowDragImage;
  8039.           end;
  8040.         dmDragDrop: FLastDropTarget := nil;
  8041.       end;
  8042. end;
  8043.  
  8044. procedure TCustomListView.DoDragOver(Source: TDragObject; X, Y: Integer);
  8045. var
  8046.   Item: TListItem;
  8047.   Target: TListItem;
  8048. begin
  8049.   Item := GetItemAt(X, Y);
  8050.   if Item <> nil then
  8051.   begin
  8052.     Target := DropTarget;
  8053.     if (Item <> Target) or (Item = FLastDropTarget) then
  8054.     begin
  8055.       FLastDropTarget := nil;
  8056.       TDragObject(Source).HideDragImage;
  8057.       if Target <> nil then
  8058.         Target.DropTarget := False;
  8059.       Item.DropTarget := True;
  8060.       Update;
  8061.       TDragObject(Source).ShowDragImage;
  8062.     end;
  8063.   end;
  8064. end;
  8065.  
  8066. procedure TCustomListView.SetItems(Value: TListItems);
  8067. begin
  8068.   FListItems.Assign(Value);
  8069. end;
  8070.  
  8071. procedure TCustomListView.SetListColumns(Value: TListColumns);
  8072. begin
  8073.   FListColumns.Assign(Value);
  8074. end;
  8075.  
  8076. function TCustomListView.CustomSort(SortProc: TLVCompare; lParam: Longint): Boolean;
  8077. begin
  8078.   Result := False;
  8079.   if HandleAllocated then
  8080.   begin
  8081.     if not Assigned(SortProc) then SortProc := @DefaultListViewSort;
  8082.     Result := ListView_SortItems(Handle, SortProc, lParam);
  8083.   end;
  8084. end;
  8085.  
  8086. function TCustomListView.AlphaSort: Boolean;
  8087. begin
  8088.   if HandleAllocated then
  8089.     Result := ListView_SortItems(Handle, @DefaultListViewSort, 0)
  8090.   else Result := False;
  8091. end;
  8092.  
  8093. procedure TCustomListView.SetSortType(Value: TSortType);
  8094. begin
  8095.   if SortType <> Value then
  8096.   begin
  8097.     FSortType := Value;
  8098.     if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
  8099.       (SortType in [stText, stBoth]) then
  8100.       AlphaSort;
  8101.   end;
  8102. end;
  8103.  
  8104. function TCustomListView.GetVisibleRowCount: Integer;
  8105. begin
  8106.   if ViewStyle in [vsReport, vsList] then
  8107.     Result := ListView_GetCountPerPage(Handle)
  8108.   else Result := 0;
  8109. end;
  8110.  
  8111. function TCustomListView.GetViewOrigin: TPoint;
  8112. begin
  8113.   ListView_GetOrigin(Handle, Result);
  8114. end;
  8115.  
  8116. function TCustomListView.GetTopItem: TListItem;
  8117. var
  8118.   Index: Integer;
  8119. begin
  8120.   Result := nil;
  8121.   if not (ViewStyle in [vsSmallIcon, vsIcon]) then
  8122.   begin
  8123.     Index := ListView_GetTopIndex(Handle);
  8124.     if Index <> -1 then Result := Items[Index];
  8125.   end;
  8126. end;
  8127.  
  8128. function TCustomListView.GetBoundingRect: TRect;
  8129. begin
  8130.   ListView_GetViewRect(Handle, Result);
  8131. end;
  8132.  
  8133. procedure TCustomListView.Scroll(DX, DY: Integer);
  8134. begin
  8135.   ListView_Scroll(Handle, DX, DY);
  8136. end;
  8137.  
  8138. procedure TCustomListView.SetLargeImages(Value: TImageList);
  8139. begin
  8140.   if LargeImages <> nil then
  8141.     LargeImages.UnRegisterChanges(FLargeChangeLink);
  8142.   FLargeImages := Value;
  8143.   if LargeImages <> nil then
  8144.   begin
  8145.     LargeImages.RegisterChanges(FLargeChangeLink);
  8146.     SetImageList(LargeImages.Handle, LVSIL_NORMAL)
  8147.   end
  8148.   else SetImageList(0, LVSIL_NORMAL);
  8149. end;
  8150.  
  8151. procedure TCustomListView.SetSmallImages(Value: TImageList);
  8152. begin
  8153.   if SmallImages <> nil then
  8154.     SmallImages.UnRegisterChanges(FSmallChangeLink);
  8155.   FSmallImages := Value;
  8156.   if SmallImages <> nil then
  8157.   begin
  8158.     SmallImages.RegisterChanges(FSmallChangeLink);
  8159.     SetImageList(SmallImages.Handle, LVSIL_SMALL)
  8160.   end
  8161.   else SetImageList(0, LVSIL_SMALL);
  8162. end;
  8163.  
  8164. procedure TCustomListView.SetStateImages(Value: TImageList);
  8165. begin
  8166.   if StateImages <> nil then
  8167.     StateImages.UnRegisterChanges(FStateChangeLink);
  8168.   FStateImages := Value;
  8169.   if StateImages <> nil then
  8170.   begin
  8171.     StateImages.RegisterChanges(FStateChangeLink);
  8172.     SetImageList(StateImages.Handle, LVSIL_STATE)
  8173.   end
  8174.   else SetImageList(0, LVSIL_STATE);
  8175. end;
  8176.  
  8177. function TCustomListView.GetColumnFromIndex(Index: Integer): TListColumn;
  8178. begin
  8179.   Result := FListColumns[Index];
  8180. end;
  8181.  
  8182. function TCustomListView.FindCaption(StartIndex: Integer; Value: string;
  8183.   Partial, Inclusive, Wrap: Boolean): TListItem;
  8184. const
  8185.   FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
  8186.   Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
  8187. var
  8188.   Info: TLVFindInfo;
  8189.   Index: Integer;
  8190. begin
  8191.   with Info do
  8192.   begin
  8193.     flags := LVFI_STRING or FullString[Partial] or Wraps[Wrap];
  8194.     psz := PChar(Value);
  8195.   end;
  8196.   if Inclusive then Dec(StartIndex);
  8197.   Index := ListView_FindItem(Handle, StartIndex, Info);
  8198.   if Index <> -1 then Result := Items[Index]
  8199.   else Result := nil;
  8200. end;
  8201.  
  8202. function TCustomListView.FindData(StartIndex: Integer; Value: Pointer;
  8203.   Inclusive, Wrap: Boolean): TListItem;
  8204. var
  8205.   I: Integer;
  8206. begin
  8207.   Result := nil;
  8208.   if Inclusive then Dec(StartIndex);
  8209.   for I := StartIndex + 1 to Items.Count - 1 do
  8210.     if Items[I].Data = Value then Break;
  8211.   if I <= Items.Count - 1 then Result := Items[I]
  8212.   else if Wrap then
  8213.   begin
  8214.     if Inclusive then Inc(StartIndex);
  8215.     for I := 0 to StartIndex - 1 do
  8216.       if Items[I].Data = Value then Break;
  8217.     if I <= StartIndex then Result := Items[I];
  8218.   end;
  8219. end;
  8220.  
  8221. function TCustomListView.GetSelection: TListItem;
  8222. begin
  8223.   Result := GetNextItem(nil, sdAll, [isSelected]);
  8224. end;
  8225.  
  8226. procedure TCustomListView.SetSelection(Value: TListItem);
  8227. var
  8228.   I: Integer;
  8229. begin
  8230.   if Value <> nil then Value.Selected := True
  8231.   else begin
  8232.     Value := Selected;
  8233.     for I := 0 to SelCount - 1 do
  8234.       if Value <> nil then
  8235.       begin
  8236.         Value.Selected := False;
  8237.         Value := GetNextItem(Value, sdAll, [isSelected]);
  8238.       end;
  8239.   end;
  8240. end;
  8241.  
  8242. function TCustomListView.GetDropTarget: TListItem;
  8243. begin
  8244.   Result := GetNextItem(nil, sdAll, [isDropHilited]);
  8245.   if Result = nil then Result := FLastDropTarget;
  8246. end;
  8247.  
  8248. procedure TCustomListView.SetDropTarget(Value: TListItem);
  8249. begin
  8250.   if HandleAllocated then
  8251.     if Value <> nil then Value.DropTarget := True
  8252.     else begin
  8253.       Value := DropTarget;
  8254.       if Value <> nil then Value.DropTarget := False;
  8255.     end;
  8256. end;
  8257.  
  8258. function TCustomListView.GetFocused: TListItem;
  8259. begin
  8260.   Result := GetNextItem(nil, sdAll, [isFocused]);
  8261. end;
  8262.  
  8263. procedure TCustomListView.SetFocused(Value: TListItem);
  8264. begin
  8265.   if HandleAllocated then
  8266.     if Value <> nil then Value.Focused := True
  8267.     else begin
  8268.       Value := ItemFocused;
  8269.       if Value <> nil then Value.Focused := False;
  8270.     end;
  8271. end;
  8272.  
  8273. function TCustomListView.GetNextItem(StartItem: TListItem;
  8274.   Direction: TSearchDirection; States: TItemStates): TListItem;
  8275. var
  8276.   Flags, Index: Integer;
  8277. begin
  8278.   Result := nil;
  8279.   if HandleAllocated then
  8280.   begin
  8281.     Flags := 0;
  8282.     case Direction of
  8283.       sdAbove: Flags := LVNI_ABOVE;
  8284.       sdBelow: Flags := LVNI_BELOW;
  8285.       sdLeft: Flags := LVNI_TOLEFT;
  8286.       sdRight: Flags := LVNI_TORIGHT;
  8287.       sdAll: Flags := LVNI_ALL;
  8288.     end;
  8289.     if StartItem <> nil then Index := StartItem.Index
  8290.     else Index := -1;
  8291.     if isCut in States then Flags := Flags or LVNI_CUT;
  8292.     if isDropHilited in States then Flags := Flags or LVNI_DROPHILITED;
  8293.     if isFocused in States then Flags := Flags or LVNI_FOCUSED;
  8294.     if isSelected in States then Flags := Flags or LVNI_SELECTED;
  8295.     Index := ListView_GetNextItem(Handle, Index, Flags);
  8296.     if Index <> -1 then Result := Items[Index];
  8297.   end;
  8298. end;
  8299.  
  8300. function TCustomListView.GetNearestItem(Point: TPoint;
  8301.   Direction: TSearchDirection): TListItem;
  8302. const
  8303.   Directions: array[TSearchDirection] of Integer = (VK_LEFT, VK_RIGHT,
  8304.     VK_UP, VK_DOWN, 0);
  8305. var
  8306.   Info: TLVFindInfo;
  8307.   Index: Integer;
  8308. begin
  8309.   with Info do
  8310.   begin
  8311.     flags := LVFI_NEARESTXY;
  8312.     pt := Point;
  8313.     vkDirection := Directions[Direction];
  8314.   end;
  8315.   Index := ListView_FindItem(Handle, -1, Info);
  8316.   if Index <> -1 then Result := Items[Index]
  8317.   else Result := nil;
  8318. end;
  8319.  
  8320. function TCustomListView.GetItemAt(X, Y: Integer): TListItem;
  8321. var
  8322.   Info: TLVHitTestInfo;
  8323. var
  8324.   Index: Integer;
  8325. begin
  8326.   Result := nil;
  8327.   if HandleAllocated then
  8328.   begin
  8329.     Info.pt := Point(X, Y);
  8330.     Index := ListView_HitTest(Handle, Info);
  8331.     if Index <> -1 then Result := Items[Index];
  8332.   end;
  8333. end;
  8334.  
  8335. procedure TCustomListView.Arrange(Code: TListArrangement);
  8336. const
  8337.   Codes: array[TListArrangement] of Longint = (LVA_ALIGNBOTTOM, LVA_ALIGNLEFT,
  8338.     LVA_ALIGNRIGHT, LVA_ALIGNTOP, LVA_DEFAULT, LVA_SNAPTOGRID);
  8339. begin
  8340.   ListView_Arrange(Handle, Codes[Code]);
  8341. end;
  8342.  
  8343. function TCustomListView.StringWidth(S: string): Integer;
  8344. begin
  8345.   Result := ListView_GetStringWidth(Handle, PChar(S));
  8346. end;
  8347.  
  8348. procedure TCustomListView.UpdateColumns;
  8349. var
  8350.   I: Integer;
  8351. begin
  8352.   if HandleAllocated then
  8353.     for I := 0 to Columns.Count - 1 do UpdateColumn(I);
  8354. end;
  8355.  
  8356. procedure TCustomListView.UpdateColumn(Index: Integer);
  8357. var
  8358.   Column: TLVColumn;
  8359. begin
  8360.   if HandleAllocated then
  8361.     with Column, Columns.Items[Index] do
  8362.     begin
  8363.       mask := LVCF_TEXT or LVCF_FMT;
  8364.       pszText := PChar(Caption);
  8365.       if Index <> 0 then
  8366.         case Alignment of
  8367.           taLeftJustify: fmt := LVCFMT_LEFT;
  8368.           taCenter: fmt := LVCFMT_CENTER;
  8369.           taRightJustify: fmt := LVCFMT_RIGHT;
  8370.         end
  8371.       else fmt := LVCFMT_LEFT;
  8372.       if WidthType > ColumnTextWidth then
  8373.       begin
  8374.         mask := mask or LVCF_WIDTH;
  8375.         cx := FWidth;
  8376.         ListView_SetColumn(Handle, Index, Column);
  8377.       end
  8378.       else begin
  8379.         ListView_SetColumn(Handle, Index, Column);
  8380.         if ViewStyle = vsList then
  8381.           ListView_SetColumnWidth(Handle, -1, WidthType)
  8382.         else if ViewStyle = vsReport then
  8383.           ListView_SetColumnWidth(Handle, Index, WidthType);
  8384.       end;
  8385.     end;
  8386. end;
  8387.  
  8388. procedure TCustomListView.WMRButtonDown(var Message: TWMRButtonDown);
  8389. var
  8390.   MousePos: TPoint;
  8391. begin
  8392.   FRClicked := False;
  8393.   inherited;
  8394.   if FRClicked then
  8395.   begin
  8396.     GetCursorPos(MousePos);
  8397.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  8398.       Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
  8399.   end;
  8400. end;
  8401.  
  8402. procedure TCustomListView.WMLButtonDown(var Message: TWMLButtonDown);
  8403. var
  8404.   Item: TListItem;
  8405.   MousePos: TPoint;
  8406.   ShiftState: TShiftState;
  8407. begin
  8408.   SetFocus;
  8409.   ShiftState := KeysToShiftState(Message.Keys);
  8410.   FClicked := False;
  8411.   FDragIndex := -1;
  8412.   inherited;
  8413.   if (DragMode = dmAutomatic) and MultiSelect then
  8414.   begin
  8415.     if not (ssShift in ShiftState) and not (ssCtrl in ShiftState) then
  8416.     begin
  8417.       if not FClicked then
  8418.       begin
  8419.         Item := GetItemAt(Message.XPos, Message.YPos);
  8420.         if (Item <> nil) and Item.Selected then
  8421.         begin
  8422.           BeginDrag(False);
  8423.           Exit;
  8424.         end;
  8425.       end;
  8426.     end;
  8427.   end;
  8428.   if FClicked then
  8429.   begin
  8430.     GetCursorPos(MousePos);
  8431.     with PointToSmallPoint(ScreenToClient(MousePos)) do
  8432.       if not Dragging then Perform(WM_LBUTTONUP, 0, MakeLong(X, Y))
  8433.       else SendMessage(GetCapture, WM_LBUTTONUP, 0, MakeLong(X, Y));
  8434.   end
  8435.   else if (DragMode = dmAutomatic) and not (MultiSelect and
  8436.     ((ssShift in ShiftState) or (ssCtrl in ShiftState))) then
  8437.   begin
  8438.     Item := GetItemAt(Message.XPos, Message.YPos);
  8439.     if (Item <> nil) and Item.Selected then
  8440.       BeginDrag(False);
  8441.   end;
  8442. end;
  8443.  
  8444. function TCustomListView.GetSearchString: string;
  8445. var
  8446.   Buffer: array[0..1023] of char;
  8447. begin
  8448.   Result := '';
  8449.   if HandleAllocated and ListView_GetISearchString(Handle, Buffer) then
  8450.     Result := Buffer;
  8451. end;
  8452.  
  8453. end.
  8454.