1{
2 ***************************************************************************
3 *                                                                         *
4 *   This source is free software; you can redistribute it and/or modify   *
5 *   it under the terms of the GNU General Public License as published by  *
6 *   the Free Software Foundation; either version 2 of the License, or     *
7 *   (at your option) any later version.                                   *
8 *                                                                         *
9 *   This code is distributed in the hope that it will be useful, but      *
10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12 *   General Public License for more details.                              *
13 *                                                                         *
14 *   A copy of the GNU General Public License is available on the World    *
15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16 *   obtain it by writing to the Free Software Foundation,                 *
17 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18 *                                                                         *
19 ***************************************************************************
20}
21unit SelectionForm;
22
23interface
24
25{$mode objfpc}{$H+}
26
27uses
28  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
29  ControlSelection, StdCtrls, Buttons;
30
31type
32  TForm1 = class(TForm)
33    Button1: TButton;
34    Button2: TButton;
35    Button3: TButton;
36    Button4: TButton;
37    Button5: TButton;
38    Button6: TButton;
39    Button7: TButton;
40    Button8: TButton;
41    procedure AddSelClick(Sender: TObject);
42    procedure Button8MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
43    procedure Button8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
44    procedure Button8MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
45  private
46    FSelection: TControlSelection;
47    FDown:  Boolean;
48    FStart: TPoint;
49    procedure SelChange(Sender: TObject);
50  public
51    constructor Create(Owner: TComponent); override;
52  end;
53
54var
55  Form1: TForm1;
56
57implementation
58
59
60constructor TForm1.Create(Owner: TComponent);
61begin
62  inherited CreateNew(Owner, 1);
63
64  Left := 154;
65  Top := 117;
66  Width := 500;
67  Height := 400;
68  Caption := 'Selection Test';
69
70  Button1 := TButton.Create(Self);
71  with Button1 do
72  begin
73    Parent := Self;
74    Visible := True;
75    Left := 44;
76    Top := 128;
77    Width := 265;
78    Height := 25;
79    Caption := 'Button1';
80    TabOrder := 0;
81    OnClick := AddSelClick;
82  end;
83
84  Button2 := TButton.Create(Self);
85  with Button2 do
86  begin
87    Parent := Self;
88    Visible := True;
89    Left := 212;
90    Top := 184;
91    Width := 221;
92    Height := 105;
93    Caption := 'Button2 (Allways selected)';
94    TabOrder := 1;
95  end;
96
97  Button3 := TButton.Create(Self);
98  with Button3 do
99  begin
100    Parent := Self;
101    Visible := True;
102    Left := 148;
103    Top := 92;
104    Width := 75;
105    Height := 25;
106    Caption := 'Button3';
107    TabOrder := 2;
108    OnClick := AddSelClick;
109  end;
110
111  Button4 := TButton.Create(Self);
112  with Button4 do
113  begin
114    Parent := Self;
115    Visible := True;
116    Left := 264;
117    Top := 80;
118    Width := 217;
119    Height := 25;
120    Caption := 'Button4';
121    TabOrder := 3;
122    OnClick := AddSelClick;
123  end;
124
125  Button5 := TButton.Create(Self);
126  with Button5 do
127  begin
128    Parent := Self;
129    Visible := True;
130    Left := 96;
131    Top := 56;
132    Width := 75;
133    Height := 25;
134    Caption := 'Button5';
135    TabOrder := 4;
136    OnClick := AddSelClick;
137  end;
138
139  Button6 := TButton.Create(Self);
140  with Button6 do
141  begin
142    Parent := Self;
143    Visible := True;
144    Left := 112;
145    Top := 212;
146    Width := 75;
147    Height := 105;
148    Caption := 'Button6';
149    TabOrder := 5;
150    OnClick := AddSelClick;
151  end;
152
153  Button7 := TButton.Create(Self);
154  with Button7 do
155  begin
156    Parent := Self;
157    Visible := True;
158    Left := 324;
159    Top := 48;
160    Width := 75;
161    Height := 165;
162    Caption := 'Button7';
163    TabOrder := 6;
164    OnClick := AddSelClick;
165  end;
166
167  Button8 := TButton.Create(Self);
168  with Button8 do
169  begin
170    Parent := Self;
171    Visible := True;
172    Left := 32;
173    Top := 36;
174    Width := 105;
175    Height := 85;
176    Caption := 'Drag test';
177    TabOrder := 7;
178    OnMouseDown := Button8MouseDown;
179    OnMouseMove := Button8MouseMove;
180    OnMouseUp := Button8MouseUp;
181  end;
182
183  FDown := False;
184
185  FSelection := TControlSelection.Create(Self);
186  FSelection.OnChange := SelChange;
187  FSelection.Add(Button2);
188end;
189
190procedure TForm1.AddSelClick(Sender: TObject);
191begin
192  if FSelection.IsSelected(TControl(Sender))
193  then FSelection.Remove(TControl(Sender))
194  else FSelection.Add(TControl(Sender));
195end;
196
197procedure TForm1.SelChange(Sender: TObject);
198begin
199  beep;
200end;
201
202procedure TForm1.Button8MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
203begin
204  Button8.Caption := Format('X:%d, Y:%d', [X,  Y]);
205  if FDown then
206  begin
207    Button8.Left := Button8.Left + X - FStart.X;
208    Button8.Top := Button8.Top + Y - FStart.Y;
209  end;
210end;
211
212procedure TForm1.Button8MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
213begin
214  FDown := True;
215  FStart := Point(X, Y);
216end;
217
218procedure TForm1.Button8MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
219begin
220  FDown := False;
221end;
222
223end.
224