Source/TntCheckLst.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntCheckLst;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, Messages, Windows, Controls, StdCtrls, CheckLst,
  20   TntClasses, TntControls, TntStdCtrls;
  21
  22 type
  23 {TNT-WARN TCheckListBox}
  24   TTntCheckListBox = class(TCheckListBox{TNT-ALLOW TCheckListBox}, IWideCustomListControl)
  25   private
  26     FItems: TTntStrings;
  27     FSaveItems: TTntStrings;
  28     FSaveTopIndex: Integer;
  29     FSaveItemIndex: Integer;
  30     FSaved_ItemEnabled: array of Boolean;
  31     FSaved_State: array of TCheckBoxState;
  32     FSaved_Header: array of Boolean;
  33     FOnData: TLBGetWideDataEvent;
  34     procedure SetItems(const Value: TTntStrings);
  35     function GetHint: WideString;
  36     procedure SetHint(const Value: WideString);
  37     function IsHintStored: Boolean;
  38     procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
  39     procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
  40   protected
  41     procedure CreateWindowHandle(const Params: TCreateParams); override;
  42     procedure DefineProperties(Filer: TFiler); override;
  43     function GetActionLinkClass: TControlActionLinkClass; override;
  44     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  45     procedure CreateWnd; override;
  46     procedure DestroyWnd; override;
  47     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  48   public
  49     constructor Create(AOwner: TComponent); override;
  50     destructor Destroy; override;
  51     procedure CopySelection(Destination: TCustomListControl); override;
  52     procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
  53   published
  54     property Hint: WideString read GetHint write SetHint stored IsHintStored;
  55     property Items: TTntStrings read FItems write SetItems;
  56     property OnData: TLBGetWideDataEvent read FOnData write FOnData;
  57   end;
  58
  59 implementation
  60
  61 uses
  62   SysUtils, Math, TntActnList;
  63
  64 { TTntCheckListBox }
  65
  66 constructor TTntCheckListBox.Create(AOwner: TComponent);
  67 begin
  68   inherited;
  69   FItems := TTntListBoxStrings.Create;
  70   TTntListBoxStrings(FItems).ListBox := Self;
  71 end;
  72
  73 destructor TTntCheckListBox.Destroy;
  74 begin
  75   FreeAndNil(FItems);
  76   inherited;
  77 end;
  78
  79 procedure TTntCheckListBox.CreateWindowHandle(const Params: TCreateParams);
  80 begin
  81   CreateUnicodeHandle(Self, Params, 'LISTBOX');
  82 end;
  83
  84 procedure TTntCheckListBox.DefineProperties(Filer: TFiler);
  85 begin
  86   inherited;
  87   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
  88 end;
  89
  90 procedure TTntCheckListBox.CreateWnd;
  91 var
  92   i: integer;
  93 begin
  94   inherited;
  95   TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
  96   if Length(FSaved_ItemEnabled) > 0 then begin
  97     for i := 0 to Min(Items.Count - 1, High(FSaved_ItemEnabled)) do begin
  98       ItemEnabled[i] := FSaved_ItemEnabled[i];
  99       State[i]       := FSaved_State[i];
 100       Header[i]      := FSaved_Header[i];
 101     end;
 102     SetLength(FSaved_ItemEnabled, 0);
 103     SetLength(FSaved_State, 0);
 104     SetLength(FSaved_Header, 0);
 105   end;
 106 end;
 107
 108 procedure TTntCheckListBox.DestroyWnd;
 109 var
 110   i: integer;
 111 begin
 112   SetLength(FSaved_ItemEnabled, Items.Count);
 113   SetLength(FSaved_State, Items.Count);
 114   SetLength(FSaved_Header, Items.Count);
 115   for i := 0 to Items.Count - 1 do begin
 116     FSaved_ItemEnabled[i] := ItemEnabled[i];
 117     FSaved_State[i]       := State[i];
 118     FSaved_Header[i]      := Header[i];
 119   end;
 120   TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
 121   inherited;
 122 end;
 123
 124 procedure TTntCheckListBox.SetItems(const Value: TTntStrings);
 125 begin
 126   FItems.Assign(Value);
 127 end;
 128
 129 procedure TTntCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
 130 begin
 131   inherited;
 132   if not Assigned(OnDrawItem) then
 133     TntListBox_DrawItem_Text(Self, Items, Index, Rect);
 134 end;
 135
 136 function TTntCheckListBox.IsHintStored: Boolean;
 137 begin
 138   Result := TntControl_IsHintStored(Self)
 139 end;
 140
 141 function TTntCheckListBox.GetHint: WideString;
 142 begin
 143   Result := TntControl_GetHint(Self)
 144 end;
 145
 146 procedure TTntCheckListBox.SetHint(const Value: WideString);
 147 begin
 148   TntControl_SetHint(Self, Value);
 149 end;
 150
 151 procedure TTntCheckListBox.AddItem(const Item: WideString; AObject: TObject);
 152 begin
 153   TntListBox_AddItem(Items, Item, AObject);
 154 end;
 155
 156 procedure TTntCheckListBox.CopySelection(Destination: TCustomListControl);
 157 begin
 158   TntListBox_CopySelection(Self, Items, Destination);
 159 end;
 160
 161 procedure TTntCheckListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 162 begin
 163   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 164   inherited;
 165 end;
 166
 167 function TTntCheckListBox.GetActionLinkClass: TControlActionLinkClass;
 168 begin
 169   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 170 end;
 171
 172 procedure TTntCheckListBox.LBGetText(var Message: TMessage);
 173 begin
 174   if not TntCustomListBox_LBGetText(Self, OnData, Message) then
 175     inherited;
 176 end;
 177
 178 procedure TTntCheckListBox.LBGetTextLen(var Message: TMessage);
 179 begin
 180   if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
 181     inherited;
 182 end;
 183
 184 end.