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