source: trunk/Components/CustomCheckListBox.PAS@ 91

Last change on this file since 91 was 15, checked in by RBRi, 19 years ago

+ components stuff

  • Property svn:eol-style set to native
File size: 14.2 KB
Line 
1Unit CustomCheckListBox;
2
3Interface
4
5{$ifdef win32}
6Uses
7 StdCtrls, ExtCtrls;
8
9Type
10 TCheckListBoxType = TCheckListBox;
11
12{$else}
13Uses
14 Classes,Forms,Graphics,StdCtrls, SysUtils;
15
16Type
17 ECheckListException = class( Exception );
18
19 TCheckListBoxData = class
20 Data: TObject;
21 Checked: boolean;
22 end;
23
24 TCustomCheckListBox=Class(TListBox)
25 Protected
26 FBitmapList: TBitmapList;
27 FOnCheckboxChanged: TNotifyEvent;
28 Protected
29 Function GetChecked( Index: LongInt ): boolean;
30 Procedure SetChecked( Index: LongInt; Value:boolean );
31
32 Function GetString( Index: LongInt ): string;
33 Procedure SetString( Index: LongInt; Value: string );
34 Function GetObject( Index: LongInt ): TObject;
35 Procedure SetObject( Index: LongInt; Value: TObject );
36
37 Function GetItemCount: longint;
38
39 Function GetSelectedObject: TObject;
40 Procedure SetSelectedObject( Value: TObject );
41 Function GetSelectedString: string;
42 Function GetCheckedCount: longint;
43 Protected
44 Procedure SetupComponent; Override;
45 Destructor Destroy; Override;
46 Procedure MouseClick( Button: TMouseButton;
47 ShiftState: TShiftState;
48 X, Y: longint ); override;
49 Procedure MouseDblClick( Button: TMouseButton;
50 ShiftState: TShiftState;
51 X, Y: longint ); override;
52 Procedure DrawItem( Index: LongInt;
53 rec: TRect;
54 State: TOwnerDrawState ); Override;
55 Procedure CharEvent( Var key: Char;
56 RepeatCount: Byte ); Override;
57
58 Procedure CheckCheckboxHit( X, Y: longint );
59 Property Style;
60 Public
61 property ItemCount: longint read GetItemCount;
62 Property Checked[ Index: LongInt ]: boolean Read GetChecked Write SetChecked;
63 Property Objects[ Index: longint ]: TObject read GetObject Write SetObject;
64
65 Function AddItemObject( TheString: string;
66 TheObject: TObject;
67 Checked: boolean ): longint;
68 Procedure Clear; override;
69 Property CheckedCount: longint read GetCheckedCount;
70
71 // get the checked items (and objects) to dest
72 Procedure GetCheckedItems( Dest: TStrings );
73 // same as above, but don't clear dest beforehand
74 Procedure AddCheckedItems( Dest: TStrings );
75 Property SelectedObject: TObject read GetSelectedObject write SetSelectedObject;
76 Property SelectedString: string read GetSelectedString;
77
78 Published
79 Property OnCheckBoxChanged:TNotifyEvent Read FOnCheckboxChanged Write FOnCheckboxChanged;
80 End;
81
82 TCheckListBoxType = TCustomCheckListBox;
83
84Exports
85 TCustomCheckListBox, 'User', 'CustomCheckListBox.bmp';
86{$endif}
87
88Procedure GetCheckedItems( CheckListBox: TCheckListBoxType;
89 Items: TStrings );
90Procedure GetCheckedObjects( CheckListBox: TCheckListBoxType;
91 Objects: TList );
92Procedure AddCheckedItems( CheckListBox: TCheckListBoxType;
93 Items: TStrings );
94Procedure AddCheckedObjects( CheckListBox: TCheckListBoxType;
95 Objects: TList );
96Procedure AddCheckListItemObject( CheckListBox: TCheckListBoxType;
97 Text: String;
98 TheObject: TObject;
99 Checked: boolean );
100Procedure SetAllCheckListItems( CheckListBox: TCheckListBoxType;
101 Value: boolean );
102Function CheckListItemCount( CheckListBox: TCheckListBoxType ): integer;
103Function CheckListObject( CheckListBox: TCheckListBoxType;
104 Index: integer ): TObject;
105Function SelectedCheckListObject( CheckListBox: TCheckListBoxType ): TObject;
106Function SelectedCheckListItem( CheckListBox: TCheckListBoxType ): string;
107Function CheckedCount( CheckListBox: TCheckListBoxType ): integer;
108
109Implementation
110
111{$ifdef os232}
112Uses
113 PMWin, OS2Def;
114{$R CustomCheckListBox}
115{$endif}
116
117{$ifdef win32}
118Procedure AddCheckedItems( CheckListBox: TCheckListBoxType;
119 Items: TStrings );
120var
121 i: integer;
122begin
123 for i:= 0 to CheckListBox.Items.Count - 1 do
124 if CheckListBox.Checked[ i ] then
125 Items.AddObject( CheckListBox.Items[ i ],
126 CheckListBox.Items.Objects[ i ] );
127end;
128
129Procedure AddCheckedObjects( CheckListBox: TCheckListBoxType;
130 Objects: TList );
131var
132 i: integer;
133begin
134 for i:= 0 to CheckListBox.Items.Count - 1 do
135 if CheckListBox.Checked[ i ] then
136 Objects.Add( CheckListBox.Items.Objects[ i ] );
137end;
138
139Procedure GetCheckedItems( CheckListBox: TCheckListBoxType;
140 Items: TStrings );
141begin
142 Items.Clear;
143 AddCheckedItems( CheckListBox, Items );
144end;
145
146Procedure GetCheckedObjects( CheckListBox: TCheckListBoxType;
147 Objects: TList );
148begin
149 Objects.Clear;
150 AddCheckedObjects( CheckListBox, Objects );
151end;
152
153Procedure AddCheckListItemObject( CheckListBox: TCheckListBoxType;
154 Text: String;
155 TheObject: TObject;
156 Checked: boolean );
157var
158 AddPosition: integer;
159begin
160 AddPosition:= CheckListBox.Items.AddObject( Text, TheObject );
161 CheckListBox.Checked[ AddPosition ]:= Checked;
162end;
163
164Procedure SetAllCheckListItems( CheckListBox: TCheckListBoxType;
165 Value: boolean );
166var
167 i: integer;
168begin
169 for i:= 0 to CheckListBox.Items.Count - 1 do
170 CheckListBox.Checked[ i ] := Value;
171end;
172
173Function CheckListItemCount( CheckListBox: TCheckListBoxType ): integer;
174begin
175 Result:= CheckListBox.Items.Count;
176end;
177
178Function CheckListObject( CheckListBox: TCheckListBoxType;
179 Index: integer ): TObject;
180begin
181 Result:= CheckListBox.Items.Objects[ Index ];
182end;
183
184Function SelectedCheckListObject( CheckListBox: TCheckListBoxType ): TObject;
185begin
186 if CheckListBox.ItemIndex <> -1 then
187 Result:= CheckListBox.Items.Objects[ CheckListBox.ItemIndex ]
188 else
189 Result:= nil;
190end;
191
192Function SelectedCheckListItem( CheckListBox: TCheckListBoxType ): string;
193begin
194 if CheckListBox.ItemIndex <> -1 then
195 Result:= CheckListBox.Items[ CheckListBox.ItemIndex ]
196 else
197 Result:= '';
198end;
199
200Function CheckedCount( CheckListBox: TCheckListBoxType ): integer;
201var
202 i: integer;
203begin
204 Result:= 0;
205 for i:= 0 to CheckListBox.Items.Count - 1 do
206 if CheckListBox.Checked[ i ] then
207 inc( Result );
208end;
209
210{$else}
211Procedure AddCheckedItems( CheckListBox: TCustomCheckListBox;
212 Items: TStrings );
213begin
214 CheckListBox.AddCheckedItems( Items );
215end;
216
217Procedure GetCheckedObjects( CheckListBox: TCheckListBoxType;
218 Objects: TList );
219var
220 i: integer;
221begin
222 for i:= 0 to CheckListBox.Items.Count - 1 do
223 if CheckListBox.Checked[ i ] then
224 Objects.Add( CheckListBox.Objects[ i ] );
225end;
226
227Procedure GetCheckedItems( CheckListBox: TCustomCheckListBox;
228 Items: TStrings );
229begin
230 Items.Clear;
231 AddCheckedItems( CheckListBox, Items );
232end;
233
234Procedure AddCheckedObjects( CheckListBox: TCheckListBoxType;
235 Objects: TList );
236begin
237 Objects.Clear;
238 AddCheckedObjects( CheckListBox, Objects );
239end;
240
241Procedure AddCheckListItemObject( CheckListBox: TCustomCheckListBox;
242 Text: String;
243 TheObject: TObject;
244 Checked: boolean );
245begin
246 CheckListBox.AddItemObject( Text, TheObject, Checked );
247end;
248
249Procedure SetAllCheckListItems( CheckListBox: TCustomCheckListBox;
250 Value: boolean );
251var
252 i: integer;
253begin
254 CheckListBox.BeginUpdate;
255 for i:= 0 to CheckListBox.Items.Count - 1 do
256 CheckListBox.Checked[ i ] := Value;
257 CheckListBox.EndUpdate;
258end;
259
260Function CheckListItemCount( CheckListBox: TCustomCheckListBox ): integer;
261begin
262 Result:= CheckListBox.ItemCount;
263end;
264
265Function CheckListObject( CheckListBox: TCustomCheckListBox;
266 Index: integer ): TObject;
267begin
268 Result:= CheckListBox.Objects[ Index ];
269end;
270
271Function SelectedCheckListObject( CheckListBox: TCustomCheckListBox ): TObject;
272begin
273 Result:= CheckListBox.SelectedObject;
274end;
275
276Function SelectedCheckListItem( CheckListBox: TCustomCheckListBox ): string;
277begin
278 Result:= CheckListBox.SelectedString;
279end;
280
281Function CheckedCount( CheckListBox: TCustomCheckListBox ): integer;
282begin
283 Result:= CheckListBox.CheckedCount;
284end;
285
286{$endif}
287
288{$ifdef os2}
289
290Procedure TCustomCheckListBox.SetupComponent;
291Begin
292 Inherited SetupComponent;
293
294 Name := 'CustomCheckListBox';
295 Style := lbOwnerdrawFixed;
296 ItemHeight := 20;
297 FBitmapList:= TBitmapList.Create;
298 FBitmapList.AddResourceName('BmpLBUnChecked');
299 FBitmapList.AddResourceName('BmpLBChecked');
300End;
301
302
303Destructor TCustomCheckListBox.Destroy;
304Begin
305 Inherited Destroy;
306 FBitmapList.Destroy;
307End;
308
309Procedure TCustomCheckListBox.DrawItem( Index: LongInt;
310 rec: TRect;
311 State: TOwnerDrawState );
312var
313 textWidth, textHeight: longint;
314 destWidth, destHeight: longint;
315 textY: Longint;
316 s: string;
317 Dest: Trect;
318 X: longint;
319 Bitmap: TBitmap;
320 idx: longint;
321 Item: TCheckListBoxData;
322Begin
323
324 Dest:= rec;
325 dec( Dest.top ); // minor adjustments since we seem to get a slightly
326 inc( Dest.left ); // incorrect area to draw on...
327 destWidth:= Dest.Right - Dest.left;
328 destHeight:= Dest.Top - Dest.Bottom;
329
330 // First draw the item background, in highlight colour if needed
331 IF State * [odSelected] <> [] THEN
332 Canvas.Brush.Color := clHighLight
333 ELSE
334 Canvas.Brush.Color := Color;
335 Canvas.FillRect( Dest, Canvas.Brush.Color );
336
337 X:= Dest.left;
338
339 // I don't know why but the bitmap colour is affected by the pen colour ?!
340 Canvas.Pen.Color := clBlack;
341
342 Item:= Items.Objects[ Index ] as TCheckListBoxData;
343
344 idx:= longint( Item.Checked );
345 Bitmap:= FBitmapList.Bitmaps[ idx ];
346 Canvas.Draw( X + 2,
347 Dest.bottom + ( ItemHeight - Bitmap.Height ) div 2,
348 Bitmap );
349
350 inc( X, 20 );
351 // Draw string
352 s := Items[Index];
353
354 Canvas.GetTextExtent( s, textWidth, textHeight);
355
356 // Centre the text vertically in the available space
357 textY:= Dest.Bottom + ((destHeight - textHeight) DIV 2);
358 IF textY < Dest.Bottom THEN
359 textY:= Dest.Bottom;
360
361 Canvas.Pen.Color := PenColor;
362 Canvas.TextOut( X, TextY, s);
363
364End;
365
366Procedure TCustomCheckListBox.CharEvent( Var key:Char;
367 RepeatCount:Byte);
368Begin
369 If key= ' ' Then
370 Checked[ ItemIndex ]:= not Checked[ ItemIndex ];
371 Inherited CharEvent( key, RepeatCount );
372End;
373
374Function TCustomCheckListBox.GetChecked(Index:LongInt):boolean;
375var
376 Item: TCheckListBoxData;
377Begin
378 Item:= Items.Objects[ Index ] as TCheckListBoxData;
379 Result:= Item.Checked;
380End;
381
382Procedure TCustomCheckListBox.SetChecked(Index:LongInt;Value:boolean);
383var
384 Item: TCheckListBoxData;
385Begin
386 Item:= Items.Objects[ Index ] as TCheckListBoxData;
387 Item.Checked:= Value;
388 Invalidate;
389End;
390
391Procedure TCustomCheckListBox.CheckCheckboxHit( X, Y: longint );
392Var
393 index: longint;
394 p: TPoint;
395Begin
396 if X < 20 then
397 begin
398 p.X:= X;
399 p.Y:= Y;
400 index:= ItemAtPos( p, true );
401 if index<>-1 then
402 Checked[ index ]:= not Checked[ index ];
403 end;
404end;
405
406Procedure TCustomCheckListBox.MouseClick( Button: TMouseButton;
407 ShiftState: TShiftState;
408 X, Y: longint );
409Begin
410 CheckCheckboxHit( X, Y );
411 Inherited MouseClick( Button, ShiftState, X, Y );
412End;
413
414Procedure TCustomCheckListBox.MouseDblClick( Button: TMouseButton;
415 ShiftState: TShiftState;
416 X, Y: longint );
417Begin
418 CheckCheckboxHit( X, Y );
419 Inherited MouseDblClick( Button, ShiftState, X, Y );
420End;
421
422Function TCustomCheckListBox.GetString( index: longint ): string;
423Begin
424 Result:= Items[ index ];
425End;
426
427Procedure TCustomCheckListBox.SetString( Index: LongInt; Value: string );
428Begin
429 Items[ index ]:= Value;
430End;
431
432Function TCustomCheckListBox.GetObject( Index: LongInt ): TObject;
433var
434 Item: TCheckListBoxData;
435Begin
436 Item:= Items.Objects[ Index ] as TCheckListBoxData;
437 Result:= Item.Data;
438End;
439
440Procedure TCustomCheckListBox.SetObject( Index: LongInt; Value: TObject );
441var
442 Item: TCheckListBoxData;
443Begin
444 Item:= Items.Objects[ Index ] as TCheckListBoxData;
445 Item.Data:= Value;
446End;
447
448Function TCustomCheckListBox.AddItemObject( TheString: string;
449 TheObject: TObject;
450 Checked: boolean ): longint;
451var
452 Item: TCheckListBoxData;
453Begin
454 Item:= TCheckListBoxData.Create;
455 Item.Data:= TheObject;
456 Item.Checked:= Checked;
457 Result:= Items.AddObject( TheString, Item );
458End;
459
460Procedure TCustomCheckListBox.Clear;
461var
462 i: longint;
463 Item: TCheckListBoxData;
464Begin
465 for i:= 0 to Items.Count - 1 do
466 begin
467 Item:= Items.Objects[ i ] as TCheckListBoxData;
468 Item.Destroy;
469 end;
470 Inherited Clear;
471End;
472
473Function TCustomCheckListBox.GetItemCount: longint;
474Begin
475 Result:= Items.Count;
476End;
477
478Function TCustomCheckListBox.GetSelectedObject: TObject;
479Begin
480 if ItemIndex<>-1 then
481 Result:= Objects[ ItemIndex ]
482 else
483 Result:= nil;
484End;
485
486Procedure TCustomCheckListBox.SetSelectedObject( Value: TObject );
487Var
488 Index: longint;
489Begin
490 Index:= Items.IndexOfObject( Value );
491 if Index <> -1 then
492 ItemIndex:= Index;
493End;
494
495Function TCustomCheckListBox.GetSelectedString: string;
496Begin
497 if ItemIndex<>-1 then
498 Result:= Items[ ItemIndex ]
499 else
500 Result:= '';
501End;
502
503Function TCustomCheckListBox.GetCheckedCount: longint;
504var
505 i: longint;
506 Item: TCheckListBoxData;
507Begin
508 Result:= 0;
509 for i:= 0 to Items.Count - 1 do
510 begin
511 Item:= Items.Objects[ i ] as TCheckListBoxData;
512 if Item.Checked then
513 inc( Result );
514 end;
515end;
516
517Procedure TCustomCheckListBox.AddCheckedItems( Dest: TStrings );
518var
519 i: longint;
520 Item: TCheckListBoxData;
521Begin
522 for i:= 0 to Items.Count - 1 do
523 begin
524 Item:= Items.Objects[ i ] as TCheckListBoxData;
525 if Item.Checked then
526 Dest.AddObject( Items[ i ],
527 Item.Data );
528 end;
529end;
530
531Procedure TCustomCheckListBox.GetCheckedItems( Dest: TStrings );
532begin
533 Dest.Clear;
534 AddCheckedItems( Dest );
535end;
536
537Initialization
538 {Register classes}
539 RegisterClasses([TCustomCheckListBox]);
540{$endif}
541
542End.
Note: See TracBrowser for help on using the repository browser.