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