Author: Jonas Bilinkevicius
How to reorder the items of a TCheckListBox by using drag and drop
Answer:
1 unit PBReorderCheckListBox;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls,
8 Checklst;
9
10 type
11 TPBReorderCheckListBox = class(TCheckListBox)
12 private
13 FDragIndex: Integer;
14 FDragImage: TDragImagelist;
15 protected
16 procedure DoStartDrag(var DragObject: TDragObject); override;
17 procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
18 var Accept: Boolean); override;
19 public
20 procedure DefaultDragOver(Source: TObject; X, Y: Integer; State: TDragState;
21 var Accept: Boolean); virtual;
22 procedure DefaultStartDrag(var DragObject: TDragObject); virtual;
23 procedure DefaultDragDrop(Source: TObject; X, Y: Integer); virtual;
24 procedure CreateDragImage(const S: string);
25 procedure DragDrop(Source: TObject; X, Y: Integer); override;
26 function GetDragImages: TDragImagelist; override;
27 property DragIndex: Integer read FDragIndex;
28 property DragImages: TDragImageList read GetDragImages;
29 end;
30
31 procedure register;
32
33 implementation
34
35 procedure register;
36 begin
37 RegisterComponents('PBGoodies', [TPBReorderCheckListBox]);
38 end;
39
40 procedure TPBReorderCheckListBox.CreateDragImage(const S: string);
41 var
42 size: TSize;
43 bmp: TBitmap;
44 begin
45 if not Assigned(FDragImage) then
46 FDragImage := TDragImagelist.Create(self)
47 else
48 FDragImage.Clear;
49 Canvas.Font := Font;
50 size := Canvas.TextExtent(S);
51 FDragImage.Width := size.cx;
52 FDragImage.Height := size.cy;
53 bmp := TBitmap.Create;
54 try
55 bmp.Width := size.cx;
56 bmp.Height := size.cy;
57 bmp.Canvas.Font := Font;
58 bmp.Canvas.Font.Color := clBlack;
59 bmp.Canvas.Brush.Color := clWhite;
60 bmp.Canvas.Brush.Style := bsSolid;
61 bmp.Canvas.TextOut(0, 0, S);
62 FDragImage.AddMasked(bmp, clWhite);
63 finally
64 bmp.free
65 end;
66 ControlStyle := ControlStyle + [csDisplayDragImage];
67 end;
68
69 procedure TPBReorderCheckListBox.DefaultDragDrop(Source: TObject; X, Y: Integer);
70 var
71 dropindex, ti: Integer;
72 S: string;
73 obj: TObject;
74 checkedstate: Boolean;
75 begin
76 if Source = Self then
77 begin
78 S := Items[FDragIndex];
79 obj := Items.Objects[FDragIndex];
80 checkedstate := Checked[FDragIndex];
81 dropIndex := ItemAtPos(Point(X, Y), True);
82 ti := TopIndex;
83 if dropIndex > FDragIndex then
84 Dec(dropIndex);
85 Items.Delete(FDragIndex);
86 if dropIndex < 0 then
87 dropindex := items.AddObject(S, obj)
88 else
89 items.InsertObject(dropIndex, S, obj);
90 Checked[dropindex] := checkedstate;
91 TopIndex := ti;
92 end;
93 end;
94
95 procedure TPBReorderCheckListBox.DefaultDragOver(Source: TObject; X, Y: Integer;
96 State: TDragState; var Accept: Boolean);
97 begin
98 Accept := Source = Self;
99 if Accept then
100 begin
101 {Handle autoscroll in the "hot zone" 5 pixels from top or bottom of client area}
102 if (Y < 5) or ((ClientHeight - Y) <= 5) then
103 begin
104 FDragImage.HideDragImage;
105 try
106 if Y < 5 then
107 begin
108 Perform(WM_VSCROLL, SB_LINEUP, 0);
109 Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
110 end
111 else if (ClientHeight - Y) <= 5 then
112 begin
113 Perform(WM_VSCROLL, SB_LINEDOWN, 0);
114 Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
115 end
116 finally
117 FDragImage.ShowDragImage;
118 end;
119 end;
120 end;
121 end;
122
123 procedure TPBReorderCheckListBox.DefaultStartDrag(var DragObject: TDragObject);
124 begin
125 FDragIndex := ItemIndex;
126 if FDragIndex >= 0 then
127 CreateDragImage(Items[FDragIndex])
128 else
129 CancelDrag;
130 end;
131
132 procedure TPBReorderCheckListBox.DoStartDrag(var DragObject: TDragObject);
133 begin
134 if Assigned(OnStartDrag) then
135 inherited
136 else
137 DefaultStartDrag(DragObject);
138 end;
139
140 procedure TPBReorderCheckListBox.DragDrop(Source: TObject; X, Y: Integer);
141 begin
142 if Assigned(OnDragDrop) then
143 inherited
144 else
145 DefaultDragDrop(Source, X, Y);
146 end;
147
148 procedure TPBReorderCheckListBox.DragOver(Source: TObject; X, Y: Integer;
149 State: TDragState; var Accept: Boolean);
150 begin
151 if Assigned(OnDragOver) then
152 inherited
153 else
154 DefaultDragOver(Source, X, Y, State, Accept);
155 end;
156
157 function TPBReorderCheckListBox.GetDragImages: TDragImagelist;
158 begin
159 Result := FDragImage;
160 end;
161
162 end.
|
