Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to Reorder the items of a TCheckListBox by using drag and drop Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
03-Dec-02
Category
VCL-General
Language
Delphi 2.x
Views
169
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC