source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntCheckLst.pas@ 1226

Last change on this file since 1226 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.8 KB
RevLine 
[453]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
12unit TntCheckLst;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Classes, Messages, Windows, Controls, StdCtrls, CheckLst,
20 TntClasses, TntControls, TntStdCtrls;
21
22type
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
59implementation
60
61uses
62 SysUtils, Math, TntActnList;
63
64{ TTntCheckListBox }
65
66constructor TTntCheckListBox.Create(AOwner: TComponent);
67begin
68 inherited;
69 FItems := TTntListBoxStrings.Create;
70 TTntListBoxStrings(FItems).ListBox := Self;
71end;
72
73destructor TTntCheckListBox.Destroy;
74begin
75 FreeAndNil(FItems);
76 inherited;
77end;
78
79procedure TTntCheckListBox.CreateWindowHandle(const Params: TCreateParams);
80begin
81 CreateUnicodeHandle(Self, Params, 'LISTBOX');
82end;
83
84procedure TTntCheckListBox.DefineProperties(Filer: TFiler);
85begin
86 inherited;
87 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
88end;
89
90procedure TTntCheckListBox.CreateWnd;
91var
92 i: integer;
93begin
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;
106end;
107
108procedure TTntCheckListBox.DestroyWnd;
109var
110 i: integer;
111begin
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;
122end;
123
124procedure TTntCheckListBox.SetItems(const Value: TTntStrings);
125begin
126 FItems.Assign(Value);
127end;
128
129procedure TTntCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
130begin
131 inherited;
132 if not Assigned(OnDrawItem) then
133 TntListBox_DrawItem_Text(Self, Items, Index, Rect);
134end;
135
136function TTntCheckListBox.IsHintStored: Boolean;
137begin
138 Result := TntControl_IsHintStored(Self)
139end;
140
141function TTntCheckListBox.GetHint: WideString;
142begin
143 Result := TntControl_GetHint(Self)
144end;
145
146procedure TTntCheckListBox.SetHint(const Value: WideString);
147begin
148 TntControl_SetHint(Self, Value);
149end;
150
151procedure TTntCheckListBox.AddItem(const Item: WideString; AObject: TObject);
152begin
153 TntListBox_AddItem(Items, Item, AObject);
154end;
155
156procedure TTntCheckListBox.CopySelection(Destination: TCustomListControl);
157begin
158 TntListBox_CopySelection(Self, Items, Destination);
159end;
160
161procedure TTntCheckListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
162begin
163 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
164 inherited;
165end;
166
167function TTntCheckListBox.GetActionLinkClass: TControlActionLinkClass;
168begin
169 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
170end;
171
172procedure TTntCheckListBox.LBGetText(var Message: TMessage);
173begin
174 if not TntCustomListBox_LBGetText(Self, OnData, Message) then
175 inherited;
176end;
177
178procedure TTntCheckListBox.LBGetTextLen(var Message: TMessage);
179begin
180 if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
181 inherited;
182end;
183
184end.
Note: See TracBrowser for help on using the repository browser.