没有合适的局域网管理软件吗?你的网管工具够灵活够高效吗?看看这个network management software【http://www.hainsoft.com/】。
带复选框可以多选的组合框控件 TCheckCombobox
For Delphi 7
作者 覃茂藩
可以多选的组合框,相对于CheckListbox和ListView在界面上中能够节省很多空间。该控件继承自TCustomComboBox,标准控件,不会有兼容性问题。实现原理简单,没有创建任何TForm、TCheckBox、TCheckListBox,代码极少,非常简洁。相比现在网上能够找到的类似控件,优点非常明显。
下载地址: http://lczx.sdedu.net/download/TCheckCombobox.rar
安装方法:把文件CheckCombobox.dcu复制到Delphi安装目录下的LIB,然后点击菜单Component > Install Component,Unit File Name那里点击Browser,打开CheckCombobox.dcu,OK,Compile。然后控件就会在控件工具箱Samples那一页出现了。
本控件使用免费。
QQ: 179845876 (需要加验证,否则不通过)
邮箱: Qinmaofan@21cn.com
发表于 @2007年07月24日 12:42:00
其另一个参考源码网址:http://www.delphipraxis.net/127628-tcheckcombobox-komponente-ueberarbeiten.html
Delphi-Quellcode:
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425unit ATCheckedComboBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TATCBQuoteStyle = (qsNone,qsSingle,qsDouble);
TATCheckedComboBox =class(TCustomComboBox)
private
{ Private declarations }
FListInstance :Pointer;
FDefListProc :Pointer;
FListHandle : HWnd;
FQuoteStyle : TATCBQuoteStyle;
FColorNotFocus: TColor;
FCheckedCount :integer;
FTextAsHint :boolean;
FOnCheckClick : TNotifyEvent;
FVersion :String;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure ListWndProc(var Message: TMessage);
procedure SetColorNotFocus(value:TColor);
procedure SetVersion(value:String);
protected
{ Protected declarations }
m_strText :string;
m_bTextUpdated :boolean;
procedure WndProc(var Message: TMessage);override;
procedure RecalcText;
function GetText:string;
function GetCheckedCount:integer;
public
{ Public declarations }
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
procedure SetCheck(nIndex:integer;checked:boolean);
function AddChecked(value:string;checked:boolean):integer;
function IsChecked(nIndex:integer):boolean;
procedure CheckAll(checked:boolean);
property Text:string read GetText;
property CheckedCount :integer read GetCheckedCount;
published
{ Published declarations }
property Anchors;
property BiDiMode;
property Color;
property ColorNotFocus : TColor read FColorNotFocuswrite SetColorNotFocus;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property Items;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property QuoteStyle : TATCBQuoteStyle read FQuoteStylewrite FQuoteStyle default qsNone;
property ShowHint;
property ShowTextAsHint :Boolean read FTextAsHintwrite FTextAsHint defaulttrue;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property Version :string read FVersionwrite SetVersion;// ver 1.1
property OnChange;
property OnCheckClick: TNotifyEvent read FOnCheckClickwrite FOnCheckClick;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
{ TATCheckedComboBox }
procedure Register;
begin
RegisterComponents('Samples', [TATCheckedComboBox]);
end;
var
FCheckWidth, FCheckHeight:Integer;
procedure GetCheckSize;
begin
with TBitmap.Createdo
try
Handle := LoadBitmap(0,PChar(32759));
FCheckWidth := Widthdiv 4;
FCheckHeight := Heightdiv 3;
finally
Free;
end;
end;
procedure TATCheckedComboBox.SetVersion(value:String);
begin
// read only
end;
procedure TATCheckedComboBox.SetCheck(nIndex:integer;checked:boolean);
begin
if (nIndex>-1)and (nIndex
begin
Items.Objects[nIndex] := TObject(checked);
m_bTextUpdated :=FALSE;
Invalidate;
if Assigned(FOnCheckClick)then
OnCheckClick(self)
end;
end;
function TATCheckedComboBox.AddChecked(value:string;checked:boolean):integer;
begin
result := Items.AddObject(value, TObject(checked));
if result>=0 then
begin
m_bTextUpdated :=FALSE;
Invalidate;
end;
end;
function TATCheckedComboBox.IsChecked(nIndex:integer):boolean;
begin
result :=false;
if (nIndex>-1)and (nIndex
result := Items.Objects[nIndex] = TObject(TRUE)
end;
procedure TATCheckedComboBox.CheckAll(checked:boolean);
var i:integer;
begin
for i:=0 to Items.count-1 do
Items.Objects[i] := TObject(checked);
end;
function GetFormatedText(kind:TATCBQuoteStyle;str:string):string;
var s :string;
begin
result := str;
if length(str)>0 then
begin
s := str;
case kindof
qsSingle : result :=
''''+
StringReplace(S,',',''',''',[rfReplaceAll])+
'''';
qsDouble : result :=
'"'+
StringReplace(S,',','","',[rfReplaceAll])+
'"';
end;
end;
end;
function TATCheckedComboBox.GetText:string;
begin
RecalcText;
if FQuoteStyle = qsNonethen
result := m_strText
else
result := GetFormatedText(FQuoteStyle,m_strText);
end;
function TATCheckedComboBox.GetCheckedCount:integer;
begin
RecalcText;
result := FCheckedCount;
end;
procedure TATCheckedComboBox.RecalcText;
var
nCount,i :integer;
strItem,
strText,
strSeparator :string;
begin
if (not m_bTextUpdated)then
begin
FCheckedCount :=0;
nCount := items.count;
strSeparator :='; ';
strText :='';
for i :=0 to nCount -1 do
if IsChecked(i)then
begin
inc(FCheckedCount);
strItem := items[i];
if (strText<>'')then
strText := strText + strSeparator;
strText := strText + strItem;
end;
// Set the text
m_strText := strText;
if FTextAsHintthen
Hint := m_strText;
m_bTextUpdated :=TRUE;
end;
end;
procedure TATCheckedComboBox.SetColorNotFocus(value:TColor);
begin
if FColorNotFocus <> Valuethen
FColorNotFocus := Value;
Invalidate
end;
procedure TATCheckedComboBox.CMEnter(var Message: TCMEnter);
begin
Self.Color := clWhite;
if Assigned(OnEnter)then OnEnter(Self);
end;
procedure TATCheckedComboBox.CMExit(var Message: TCMExit);
begin
Self.Color := FColorNotFocus;
if Assigned(OnExit)then OnExit(Self);
end;
procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);
var
State : TOwnerDrawState;
rcBitmap,rcText : Trect;
nCheck :integer;// 0 - No check, 1 - Empty check, 2 - Checked
nState :integer;
strText :string;
ItId :Integer;
dc : HDC;
begin
with Message.DrawItemStruct^do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
dc := hDC;
rcBitmap := rcItem;
rcText := rcItem;
ItId := itemID;
end;
// Check if we are drawing the static portion of the combobox
if (itID <0)then
begin
RecalcText();
strText := m_strText;
nCheck :=0;
end
else
begin
strtext := Items[ItId];
rcBitmap.Left :=2;
rcBitmap.Top := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth)div 2;
rcBitmap.Right := rcBitmap.Left + FCheckWidth;
rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;
rcText.left := rcBitmap.right;
nCheck :=1;
if IsChecked(ItId)then
inc(nCheck);
end;
if (nCheck >0)then
begin
SetBkColor(dc, GetSysColor(COLOR_WINDOW));
SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));
nState := DFCS_BUTTONCHECK;
if (nCheck >1)then
nState := nStateor DFCS_CHECKED;
DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);
end;
if (odSelectedin State)then
begin
SetBkColor(dc,$0091622F);
SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));
end
else
begin
if (nCheck=0)then
begin
SetTextColor(dc, ColorToRGB(Font.Color));
SetBkColor(dc, ColorToRGB(FColorNotFocus));
end
else
begin
SetTextColor(dc, ColorToRGB(Font.Color));
SetBkColor(dc, ColorToRGB(Brush.Color));
end;
end;
if itID >=0 then
strText :=' ' + strtext;
ExtTextOut(dc,0,0, ETO_OPAQUE, @rcText,Nil,0,Nil);
DrawText(dc,pchar(strText), Length(strText), rcText, DT_SINGLELINEor DT_VCENTERor DT_END_ELLIPSIS);
if odFocusedin Statethen DrawFocusRect(dc, rcText);
end;
//DefWindowProc
procedure TATCheckedComboBox.ListWndProc(var Message: TMessage);
var
nItemHeight, nTopIndex, nIndex:Integer;
rcItem,rcClient: TRect;
pt : TPoint;
begin
case Message.Msgof
LB_GETCURSEL :// this is for to not draw the selected in the text area
begin
Message.result := -1;
exit;
end;
WM_CHAR:// pressing space toggles the checked
begin
if (TWMKey(Message).CharCode = VK_SPACE)then
begin
// Get the current selection
nIndex := CallWindowProcA(FDefListProc, FListHandle, LB_GETCURSEL,Message.wParam, Message.lParam);
SendMessage(FListHandle, LB_GETITEMRECT, nIndex,LongInt(@rcItem));
InvalidateRect(FListHandle, @rcItem,FALSE);
SetCheck(nIndex,not IsChecked(nIndex));
SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
Message.result :=0;
exit;
end
end;
WM_LBUTTONDOWN:
begin
Windows.GetClientRect(FListHandle, rcClient);
pt.x := TWMMouse(Message).XPos;//LOWORD(Message.lParam);
pt.y := TWMMouse(Message).YPos;//HIWORD(Message.lParam);
if (PtInRect(rcClient, pt))then
begin
nItemHeight := SendMessage(FListHandle, LB_GETITEMHEIGHT,0,0);
nTopIndex := SendMessage(FListHandle, LB_GETTOPINDEX,0,0);
// Compute which index to check/uncheck
nIndex := trunc(nTopIndex + pt.y / nItemHeight);
SendMessage(FListHandle, LB_GETITEMRECT, nIndex,LongInt(@rcItem));
if (PtInRect(rcItem, pt))then
begin
InvalidateRect(FListHandle, @rcItem,FALSE);
SetCheck(nIndex,not IsChecked(nIndex));
SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
end
end
end;
WM_LBUTTONUP:
begin
Message.result :=0;
exit;
end;
end;
ComboWndProc(Message, FListHandle, FDefListProc);
end;
constructor TATCheckedComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ShowHint :=true;
Fversion :='1.2';
FTextAsHint :=true;
ParentShowHint :=False;
FListHandle :=0;
FQuoteStyle := qsNone;
FColorNotFocus := clInfoBk;
Style := csOwnerDrawVariable;
m_bTextUpdated :=FALSE;
FListInstance := MakeObjectInstance(ListWndProc);
end;
destructor TATCheckedComboBox.Destroy;
begin
FreeObjectInstance(FListInstance);
inherited Destroy;
end;
procedure TATCheckedComboBox.WndProc(var Message: TMessage);
var lWnd : HWND;
begin
if message.Msg = WM_CTLCOLORLISTBOXthen
begin
// If the listbox hasn't been subclassed yet, do so...
if (FListHandle =0)then
begin
lwnd := message.LParam;
if (lWnd <>0)and (lWnd <> FDropHandle)then
begin
// Save the listbox handle
FListHandle := lWnd;
FDefListProc :=Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
SetWindowLong(FListHandle, GWL_WNDPROC,Longint(FListInstance));
end;
end;
end;
inherited;
end;
initialization
GetCheckSize;
end.
问题修正后的源码:
Re: TCheckComboBox: Komponente überarbeiten???
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
76procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
rcBitmap, rcText: Trect;
nCheck:integer;// 0 - No check, 1 - Empty check, 2 - Checked
nState:integer;
strText:string;
ItId:Integer;
dc: HDC;
begin
with Message.DrawItemStruct^do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
dc := hDC;
rcBitmap := rcItem;
rcText := rcItem;
ItId := itemID;
end;
// Check if we are drawing the static portion of the combobox
if (itID <0)then
begin
RecalcText();
strText := m_strText;
nCheck :=0;
end
else
begin
strtext := Items[ItId];
rcBitmap.Left :=2;
rcBitmap.Top := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth)div 2;
rcBitmap.Right := rcBitmap.Left + FCheckWidth;
rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;
rcText.left := rcBitmap.right;
nCheck :=1;
if IsChecked(ItId)then
inc(nCheck);
end;
if (nCheck >0)then
begin
SetBkColor(dc, GetSysColor(COLOR_WINDOW));
SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));
nState := DFCS_BUTTONCHECK;
if (nCheck >1)then
nState := nStateor DFCS_CHECKED;
DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);
end;
if (odSelectedin State)then
begin
SetBkColor(dc,$0091622F);
SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));
end
else
begin
if (nCheck =0)then
begin
SetTextColor(dc, ColorToRGB(Font.Color));
SetBkColor(dc, ColorToRGB(FColorNotFocus));
end
else
begin
SetTextColor(dc, ColorToRGB(Font.Color));
if ncheck =1 then
SetBkColor(dc, ColorToRGB(Brush.Color))
else
SetBkColor(dc, clRed);// <
end;
end;
if itID >=0 then
strText :=' ' + strtext;
ExtTextOut(dc,0,0, ETO_OPAQUE, @rcText,nil,0,nil);
DrawText(dc,pchar(strText), Length(strText), rcText, DT_SINGLELINEor DT_VCENTERor DT_END_ELLIPSIS);
if odFocusedin Statethen DrawFocusRect(dc, rcText);
end;