├── main.dfm ├── SizeControl.pas ├── SizeControl.res ├── DemoSizeCtrl.dof ├── DemoSizeCtrl.exe ├── DemoSizeCtrl.res ├── DemoSizeCtrl.dpr ├── LICENSE ├── .gitignore ├── README.md └── main.pas /main.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/main.dfm -------------------------------------------------------------------------------- /SizeControl.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/SizeControl.pas -------------------------------------------------------------------------------- /SizeControl.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/SizeControl.res -------------------------------------------------------------------------------- /DemoSizeCtrl.dof: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/DemoSizeCtrl.dof -------------------------------------------------------------------------------- /DemoSizeCtrl.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/DemoSizeCtrl.exe -------------------------------------------------------------------------------- /DemoSizeCtrl.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BakasuraRCE/TSizeCtrl/HEAD/DemoSizeCtrl.res -------------------------------------------------------------------------------- /DemoSizeCtrl.dpr: -------------------------------------------------------------------------------- 1 | program DemoSizeCtrl; 2 | 3 | uses 4 | Forms, 5 | main in 'main.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 BakasuraRCE 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TSizeCtrl 2 | Non-visual Delphi component to enable runtime moving and resizing of controls. 3 | 4 | ## Original author: Angus Johnson 5 | http://angusj.com/delphi/ 6 | 7 | http://angusj.com/delphi/sizectrl.html 8 | 9 | ## Tested on: 10 | Delphi 3, 4, 5, 6, 7, 10.1 Berlin, 10.2 Tokyo 11 | 12 | ## Version: 13 | This is a fork since the last version of the author (7.2 - 3 September 2006) 14 | 15 | ## TSizeCtrl Component Screenshots: 16 | 17 | ### Sizing: 18 | ![sizectrl_1](https://user-images.githubusercontent.com/26231582/54495198-9c5db200-48d9-11e9-80a5-c484ee7b0749.png) ![sizectrl_2](https://user-images.githubusercontent.com/26231582/54495202-abdcfb00-48d9-11e9-96cb-4b3d33730ccd.png) 19 | 20 | ### Moving: 21 | ![sizectrl_3](https://user-images.githubusercontent.com/26231582/54495211-c1522500-48d9-11e9-843a-3ec0083aeae6.png) ![sizectrl_4](https://user-images.githubusercontent.com/26231582/54495210-c0b98e80-48d9-11e9-8147-b01c402814e2.png) 22 | 23 | ### Aligned Controls have disabled "grab button" handles along fixed borders: 24 | ![sizectrl_7](https://user-images.githubusercontent.com/26231582/54495216-d2029b00-48d9-11e9-8772-bb429591bddc.png) 25 | 26 | ### Multiple controls can be moved or resized together: 27 | ![sizectrl_5](https://user-images.githubusercontent.com/26231582/54495219-dcbd3000-48d9-11e9-99e7-ed1cf485636a.png) ![sizectrl_6](https://user-images.githubusercontent.com/26231582/54495218-dc249980-48d9-11e9-9726-fd9162f51098.png) 28 | 29 | ## BASIC USAGE: 30 | 1. Add a TSizeCtrl component (SizeCtrl1) to your form. 31 | 2. Set SizeCtrl1 properties (button colors etc) as desired. 32 | 3. Assign event methods (start, during & end size/move events) as desired. 33 | 4. In the form's OnCreate method, SizeCtrl1.RegisterControl() all possible targets. 34 | 5. In an assigned menuitem method, toggle the SizeCtrl1.Enabled property. 35 | 6. Once enabled: 36 | * Click or Tab to select targets. 37 | * Hold the Shift key down to select multiple targets. 38 | * Resize targets by click & dragging a target's resize buttons or by holding the Shift key down while use the arrow keys. 39 | * Move controls by click & dragging a target or by using the arrow keys. 40 | 41 | ## MISCELLANEOUS NOTES: 42 | Capturing the WM_SETCURSOR messages of Listview headers requires hooking the header's message handler too. I don't think this minor improvement in cursor management justifies the considerable extra programming effort. 43 | -------------------------------------------------------------------------------- /main.pas: -------------------------------------------------------------------------------- 1 | unit main; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 7 | Dialogs, SizeControl, ExtCtrls, ComCtrls, StdCtrls, Menus, CommCtrl; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | Memo1: TMemo; 12 | MainMenu1: TMainMenu; 13 | File1: TMenuItem; 14 | EnableSizeControl1: TMenuItem; 15 | N1: TMenuItem; 16 | Exit1: TMenuItem; 17 | cbSizeMove: TCheckBox; 18 | Label2: TLabel; 19 | PageControl1: TPageControl; 20 | TabSheet1: TTabSheet; 21 | Edit1: TEdit; 22 | GroupBox1: TGroupBox; 23 | RadioButton1: TRadioButton; 24 | RadioButton2: TRadioButton; 25 | Panel2: TPanel; 26 | Label1: TLabel; 27 | Label3: TLabel; 28 | ComboBox1: TComboBox; 29 | Panel1: TPanel; 30 | ListView1: TListView; 31 | StatusBar1: TStatusBar; 32 | Label4: TLabel; 33 | TabSheet2: TTabSheet; 34 | CheckBox1: TCheckBox; 35 | Label5: TLabel; 36 | Button1: TButton; 37 | PopupMenu2: TPopupMenu; 38 | MenuItem1: TMenuItem; 39 | procedure FormCreate(Sender: TObject); 40 | procedure Exit1Click(Sender: TObject); 41 | procedure Button1Click(Sender: TObject); 42 | procedure FormPaint(Sender: TObject); 43 | procedure FormDestroy(Sender: TObject); 44 | procedure FormResize(Sender: TObject); 45 | procedure EnableSizeControl1Click(Sender: TObject); 46 | procedure cbSizeMoveClick(Sender: TObject); 47 | procedure MenuItem1Click(Sender: TObject); 48 | procedure PopupMenu2Popup(Sender: TObject); 49 | private 50 | SizeCtrl: TSizeCtrl; 51 | procedure SizeCtrlDuring(Sender: TObject; dx, dy: integer; State: TSCState); 52 | procedure SizeCtrlEnd(Sender: TObject; State: TSCState); 53 | procedure SizeCtrlTargetChange(Sender: TObject); 54 | procedure SizeCtrlMouseDown(Sender: TObject; 55 | Target: TControl; TargetPt: TPoint; var handled: boolean); 56 | procedure SizeCtrlSetCursor(Sender: TObject; 57 | Target: TControl; TargetPt: TPoint; var handled: boolean); 58 | procedure SizeCtrlKeyDown(Sender: TObject; var Key: Word; 59 | Shift: TShiftState); 60 | protected 61 | public 62 | { Public declarations } 63 | end; 64 | 65 | var 66 | Form1: TForm1; 67 | 68 | GRIDSIZE: integer = 10; //try changing this too. 69 | 70 | implementation 71 | 72 | {$R *.dfm} 73 | 74 | //RegComponents: A simple recursive procedure which registers with SizeCtrl1 75 | //all the visible controls contained by aParent except 'tagged' controls ... 76 | procedure RegComponents(aParent: TWinControl; SizeCtrl: TSizeCtrl); 77 | var 78 | i: integer; 79 | begin 80 | for i := 0 to aParent.ControlCount -1 do 81 | begin 82 | //In this demo, Tag <> 0 prevents a control becoming a SizeCtrl target ... 83 | if aParent.Controls[i].Tag = 0 then 84 | SizeCtrl.RegisterControl(aParent.Controls[i]); 85 | if aParent.Controls[i] is TWinControl then 86 | RegComponents(TWinControl(aParent.Controls[i]), SizeCtrl); 87 | end; 88 | end; 89 | //------------------------------------------------------------------------------ 90 | 91 | procedure UnregComponents(aParent: TWinControl; SizeCtrl: TSizeCtrl); 92 | var 93 | i: integer; 94 | begin 95 | for i := 0 to aParent.ControlCount -1 do 96 | begin 97 | SizeCtrl.UnRegisterControl(aParent.Controls[i]); 98 | if aParent.Controls[i] is TWinControl then 99 | UnregComponents(TWinControl(aParent.Controls[i]), SizeCtrl); 100 | end; 101 | end; 102 | //------------------------------------------------------------------------------ 103 | 104 | procedure TForm1.FormCreate(Sender: TObject); 105 | begin 106 | //All of this would normally be done in the IDE's Object Inspector 107 | //if SizeCtrl was installed into the IDE. 108 | SizeCtrl := TSizeCtrl.Create(self); 109 | SizeCtrl.OnTargetChange := SizeCtrlTargetChange; 110 | SizeCtrl.OnDuringSizeMove := SizeCtrlDuring; 111 | SizeCtrl.OnEndSizeMove := SizeCtrlEnd; 112 | SizeCtrl.GridSize := GRIDSIZE; 113 | SizeCtrl.PopupMenu := PopupMenu2; 114 | //to override behaviour of Pagecontrols so new pages can be selected ... 115 | SizeCtrl.OnMouseDown := SizeCtrlMouseDown; 116 | SizeCtrl.OnSetCursor := SizeCtrlSetCursor; 117 | SizeCtrl.OnKeyDown := SizeCtrlKeyDown; 118 | 119 | RegComponents(self, SizeCtrl); 120 | SizeCtrl.Enabled := true; 121 | 122 | //ALSO, TRY OUT EACH OF THESE OPTIONS ... 123 | SizeCtrl.BtnColor := $CC; 124 | //SizeCtrl.MultiTargetResize := false; 125 | //SizeCtrl.MoveOnly := true; 126 | end; 127 | //------------------------------------------------------------------------------ 128 | 129 | procedure TForm1.FormDestroy(Sender: TObject); 130 | begin 131 | //it's important to disable SizeCtrl before destroying the form 132 | //because any SizeCtrl registered controls need to be 'unhooked' ... 133 | SizeCtrl.Enabled := false; 134 | end; 135 | //------------------------------------------------------------------------------ 136 | 137 | procedure TForm1.Exit1Click(Sender: TObject); 138 | begin 139 | close; 140 | end; 141 | //------------------------------------------------------------------------------ 142 | 143 | procedure TForm1.EnableSizeControl1Click(Sender: TObject); 144 | begin 145 | cbSizeMove.Checked := not cbSizeMove.Checked; 146 | end; 147 | //------------------------------------------------------------------------------ 148 | 149 | procedure TForm1.cbSizeMoveClick(Sender: TObject); 150 | begin 151 | SizeCtrl.Enabled := cbSizeMove.Checked; 152 | EnableSizeControl1.Checked := cbSizeMove.Checked; 153 | 154 | //Now, just in case the visible controls have changed (ie a new Tabsheet was 155 | //made visible) while SizeCtrl was disabled ... 156 | if cbSizeMove.Checked then 157 | begin 158 | //make sure the right controls on the PageControl are registered ... 159 | UnRegComponents(PageControl1, SizeCtrl); 160 | RegComponents(PageControl1, SizeCtrl); 161 | end; 162 | ActiveControl := nil; 163 | invalidate; //fixup grid painting on the form 164 | end; 165 | //------------------------------------------------------------------------------ 166 | 167 | procedure TForm1.FormResize(Sender: TObject); 168 | begin 169 | //if SizeCtrl has targets selected, and they are moved or resized 170 | //independently of SizeCtrl, then SizeCtrl must be 'updated' ... 171 | SizeCtrl.Update; 172 | end; 173 | 174 | //------------------------------------------------------------------------------ 175 | // Pretty much everything below demonstrates optional features . 176 | //------------------------------------------------------------------------------ 177 | 178 | 179 | //Button1Click() demonstrates that OnClick events of SizeCtrl 'registered' 180 | //controls are disabled when SizeCtrl is enabled. 181 | 182 | //(nb: This doesn't work in Delphi 3 so OnClick events would have to be 183 | //blocked manually to prevent Alt+Key shortcuts responding). 184 | procedure TForm1.Button1Click(Sender: TObject); 185 | begin 186 | ShowMessage('Button1 pressed.'); 187 | end; 188 | //------------------------------------------------------------------------------ 189 | 190 | //Paints a grid on the form (if GRIDSIZE > 1) ... 191 | procedure TForm1.FormPaint(Sender: TObject); 192 | var 193 | i,j: integer; 194 | begin 195 | if (GRIDSIZE > 1) and SizeCtrl.Enabled then 196 | for i := 0 to width div GRIDSIZE do 197 | for j := 0 to height div GRIDSIZE do 198 | canvas.Pixels[i*GRIDSIZE, j*GRIDSIZE] := clGray; 199 | end; 200 | 201 | //------------------------------------------------------------------------------ 202 | // Give some basic feedback as to Size/Move changes ... 203 | // (nb: While this demo only displays one target's properties, there may be 204 | // any number of targets.) 205 | //------------------------------------------------------------------------------ 206 | 207 | //1. Whenever a target changes ... 208 | procedure TForm1.SizeCtrlTargetChange(Sender: TObject); 209 | begin 210 | if SizeCtrl.TargetCount = 0 then 211 | StatusBar1.SimpleText := '' 212 | else with SizeCtrl.Targets[0] do StatusBar1.SimpleText := 213 | format(' %s - left:%d top:%d, width:%d height:%d', 214 | [Name,left,top,width,height]); 215 | end; 216 | //------------------------------------------------------------------------------ 217 | 218 | //2. During target resizing or moving ... 219 | procedure TForm1.SizeCtrlDuring(Sender: TObject; dx,dy: integer; State: TSCState); 220 | begin 221 | with SizeCtrl.Targets[0] do 222 | if State = scsMoving then 223 | StatusBar1.SimpleText := format(' %s - left:%d top:%d, width:%d height:%d', 224 | [Name, left+dx, top+dy, width, height]) 225 | else {State = scsSizing} 226 | StatusBar1.SimpleText := format(' %s - left:%d top:%d, width:%d height:%d', 227 | [Name,left, top, width+dx, height+dy]); 228 | end; 229 | //------------------------------------------------------------------------------ 230 | 231 | //3. Once target resizing or moving has finished ... 232 | procedure TForm1.SizeCtrlEnd(Sender: TObject; State: TSCState); 233 | begin 234 | with SizeCtrl do 235 | if TargetCount = 0 then StatusBar1.SimpleText := '' 236 | else with Targets[0] do StatusBar1.SimpleText := 237 | format(' %s - left:%d top:%d, width:%d height:%d', 238 | [Name,left,top,width,height]); 239 | end; 240 | 241 | //------------------------------------------------------------------------------ 242 | //------------------------------------------------------------------------------ 243 | 244 | //The TPageControl.IndexOfTabAt() method is not available in older Delphi 245 | //compilers. Therefore, I've included the following function 246 | //so this demo works all the way back to Delphi 3 ... 247 | 248 | function My_IndexOfTabAt(PageControl: TPageControl; X, Y: Integer): Integer; 249 | var 250 | HitTest: TTCHitTestInfo; 251 | begin 252 | Result := -1; 253 | if PtInRect(PageControl.ClientRect, Point(X, Y)) then 254 | with HitTest do 255 | begin 256 | pt.X := X; 257 | pt.Y := Y; 258 | {$WARNINGS OFF} 259 | Result := SendMessage(PageControl.Handle, TCM_HITTEST, 0, LPARAM(@HitTest)); 260 | {$WARNINGS ON} 261 | end; 262 | end; 263 | 264 | //------------------------------------------------------------------------------ 265 | 266 | procedure TForm1.SizeCtrlMouseDown(Sender: TObject; 267 | Target: TControl; TargetPt: TPoint; var handled: boolean); 268 | var 269 | i: integer; 270 | begin 271 | //When clicking the PageControl, it's kind of nice to be able to change pages. 272 | //So, let's see if a new page needs to be displayed ... 273 | if (Target is TPageControl) then 274 | with TPageControl(Target) do 275 | begin 276 | 277 | //We need the PageIndex of the tab being clicked. The following line 278 | //is fine in Delphi 7 but isn't available with older compilers ... 279 | // with TargetPt do i := PageControl1.IndexOfTabAt(X, Y); 280 | //Therefore, this is my workaround which works back to Delphi 3 ... 281 | with TargetPt do i := My_IndexOfTabAt(TPageControl(Target), X, Y); 282 | 283 | if (i >= 0) and ( ActivePage.PageIndex <> i) then 284 | begin 285 | //since further mouse handling stuff is not required ... 286 | handled := true; 287 | //Unregister from SizeCtrl all controls on the current page ... 288 | UnregComponents(PageControl1, SizeCtrl); 289 | //select the new page ... 290 | ActivePage := Pages[i]; 291 | //finally, register controls on the new page... 292 | RegComponents(PageControl1, SizeCtrl); 293 | end; 294 | end; 295 | end; 296 | //------------------------------------------------------------------------------ 297 | 298 | procedure TForm1.SizeCtrlSetCursor(Sender: TObject; 299 | Target: TControl; TargetPt: TPoint; var handled: boolean); 300 | var 301 | i: integer; 302 | begin 303 | //when clicking the PageControl, it's kind of nice to show an appropriate 304 | //cursor if we're clicking a new tab ... 305 | if (Target is TPageControl) then 306 | with TPageControl(Target) do 307 | begin 308 | with TargetPt do i := My_IndexOfTabAt(TPageControl(Target), X, Y); 309 | if (i >= 0) and (ActivePage.PageIndex <> i) then 310 | begin 311 | //OK, we'll manage things from here ... 312 | handled := true; 313 | //assign the cursor directly ... 314 | windows.SetCursor(screen.Cursors[crDefault]); 315 | end; 316 | end; 317 | end; 318 | //------------------------------------------------------------------------------ 319 | 320 | var 321 | popupMousePos: TPoint; //A workaround for older versions of Delphi (see below) 322 | 323 | procedure TForm1.PopupMenu2Popup(Sender: TObject); 324 | begin 325 | GetCursorPos(popupMousePos); 326 | end; 327 | //------------------------------------------------------------------------------ 328 | 329 | procedure TForm1.MenuItem1Click(Sender: TObject); 330 | var 331 | ctrl: TControl; 332 | begin 333 | //The following line doesn't compile with older versions of Delphi ... 334 | // ctrl := SizeCtrl.TargetCtrlFromPt(PopupMenu2.PopupPoint); 335 | //because the TPopupMenu.PopupPoint method isn't defined. 336 | //Therefore, this demo uses a slightly more cumbersome route ... 337 | ctrl := SizeCtrl.TargetCtrlFromPt(popupMousePos); 338 | if not assigned(ctrl) then 339 | ShowMessage('oops!!!') else //should never happen! 340 | ShowMessage('You just clicked - '+ ctrl.Name); 341 | end; 342 | //------------------------------------------------------------------------------ 343 | 344 | procedure TForm1.SizeCtrlKeyDown(Sender: TObject; var Key: Word; 345 | Shift: TShiftState); 346 | begin 347 | if key > VK_HELP then beep; 348 | end; 349 | //------------------------------------------------------------------------------ 350 | 351 | end. 352 | --------------------------------------------------------------------------------