1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356:
| unit DockingSizeGrip;
interface
uses SysUtils, Classes, Controls, Messages, Types, Graphics, TB2Dock, TB2ToolWindow;
type TSizeGripCorner=(sgc_northwest,sgc_northeast,sgc_southwest,sgc_southeast);
TDockingSizeGrip=class;
TTBSizeGripToolWindow=class(TTBToolWindow) private FSizeGrip:TDockingSizeGrip; FOnDockChanged:TNotifyEvent; procedure DockChanged(Sender:TObject); protected procedure CreateWnd; override; procedure CreateParams(var Params: TCreateParams); override; procedure DestroyWnd; override; public published property OnDockChanged:TNotifyEvent read FOnDockChanged write FOnDockChanged; end;
TDockingSizeGrip = class(TCustomControl) private FStartX: Integer; FStartY: Integer; FMoving: Boolean; FTargetControl:TWinControl; FOwner:TWinControl; FRegion:THandle; FCorner:TSizeGripCorner; FBasepoints:array[TSizeGripCorner] of TPoint; procedure Adjust; procedure AdjustParent(diffx,diffy:integer); procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure SetTargetControl(value:TWinControl); procedure SetCorner(value:TSizeGripCorner); procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure EnableRegion; procedure DisableRegion; procedure CalculateBasePoints; protected procedure CreateWnd; override; procedure DestroyWnd; override; procedure SelectCursor(X, Y: Integer); procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property TargetControl:TWinControl read FTargetControl write SetTargetControl; property Corner:TSizeGripCorner read FCorner write SetCorner; property Color; property Visible; end;
procedure Register;
implementation
uses Windows, Forms, Math;
const gripcorners:array[TSizeGripCorner,0..2] of TSizeGripCorner= ((sgc_northwest,sgc_northeast,sgc_southwest), (sgc_northwest,sgc_northeast,sgc_southeast), (sgc_northwest,sgc_southwest,sgc_southeast), (sgc_northeast,sgc_southeast,sgc_southwest));
procedure Register; begin RegisterComponents('Eigene', [TDockingSizeGrip,TTBSizeGripToolWindow]); end;
procedure TTBSizeGripToolWindow.CreateWnd; begin inherited CreateWnd; FSizeGrip:=TDockingSizeGrip.Create(self); FSizeGrip.TargetControl:=self; end;
procedure TTBSizeGripToolWindow.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); inherited OnDockChanged:=DockChanged; end;
procedure TTBSizeGripToolWindow.DestroyWnd; begin FSizeGrip.Free; FsizeGrip:=nil; inherited DestroyWnd; end;
procedure TTBSizeGripToolWindow.DockChanged(Sender: TObject); begin if assigned(FSizeGrip) then begin if floating then FSizeGrip.Visible:=false else begin FSizeGrip.Visible:=true; if Assigned(CurrentDock) then begin case CurrentDock.position of dpRight: FSizeGrip.Corner:=sgc_southwest; dpLeft: FSizeGrip.Corner:=sgc_southeast; dpTop: FSizeGrip.Corner:=sgc_southeast; dpBottom:FSizeGrip.Corner:=sgc_northeast; end; end; end; end; if assigned(FOnDockChanged) then FOnDockChanged(sender); end;
constructor TDockingSizeGrip.Create(AOwner: TComponent); begin inherited Create(AOwner); FCorner:=sgc_southeast; anchors:=[akRight,akBottom]; FOwner:=TWinControl(AOwner); Width:=16; Height:=16; if AOwner is TWinControl then TargetControl:=TWinControl(AOwner); end;
procedure TDockingSizeGrip.SetTargetControl(value: TWinControl); begin if value<>FTargetControl then begin FTargetControl:=value; if value<>nil then parent:=value else parent:=FOwner; end; Adjust; end;
procedure TDockingSizeGrip.SetCorner(value:TSizeGripCorner); begin if value<>Fcorner then begin disableregion; Fcorner:=value; enableregion; case FCorner of sgc_northwest:anchors:=[akLeft,akTop]; sgc_northeast:anchors:=[akRight,akTop]; sgc_southwest:anchors:=[akLeft,akBottom]; sgc_southeast:anchors:=[akRight,akBottom]; end; Adjust; end; end;
procedure TDockingSizeGrip.CalculateBasePoints; var c:TSizeGripCorner; xx,yy:integer; begin c:=low(TSizeGripCorner); for yy := 0 to 1 do for xx := 0 to 1 do with FBasePoints[c] do begin x:=xx*width; y:=yy*height; inc(c); end; end;
procedure TDockingSizeGrip.EnableRegion; var pt:array[0..2] of TPoint; i:integer; begin CalculateBasePoints; for i:=0 to 2 do pt[i]:=FBasePoints[gripcorners[FCorner,i]]; FRegion:=CreatePolygonRgn(pt,3,WINDING); SetWindowRgn(handle,FRegion,true); end;
procedure TDockingSizeGrip.DisableRegion; begin if FRegion<>0 then begin SetWindowRgn(handle,0,true); DeleteObject(FRegion); FRegion:=0; end; end;
procedure TDockingSizeGrip.CreateWnd; begin inherited CreateWnd; EnableRegion; Adjust; end;
procedure TDockingSizeGrip.DestroyWnd; begin DisableRegion; inherited DestroyWnd; end;
destructor TDockingSizeGrip.Destroy; begin inherited Destroy; end;
procedure TDockingSizeGrip.Notification(AComponent: TComponent; Operation: TOperation); begin if (Operation = opRemove) and (AComponent=FTargetControl) then begin FTargetControl:=nil; end; inherited Notification(AComponent, Operation); end;
procedure TDockingSizeGrip.WMSize(var Msg: TWMSize); begin DisableRegion; EnableRegion; Invalidate; end;
procedure TDockingSizeGrip.Adjust; begin if assigned(FTargetControl) then begin if FCorner in [sgc_northeast,sgc_southeast] then left:=FTargetControl.ClientWidth-width else left:=0; if FCorner in [sgc_southwest,sgc_southeast] then top:=FTargetControl.ClientHeight-height else top:=0; Invalidate; end; end;
procedure TDockingSizeGrip.AdjustParent(diffx,diffy:integer); begin if assigned(FTargetControl) then begin if FCorner in [sgc_northeast,sgc_southeast] then FTargetControl.ClientWidth:=FTargetControl.ClientWidth+diffx else begin FTargetControl.Left:=FTargetControl.Left+diffx; FTargetControl.ClientWidth:=FTargetControl.ClientWidth-diffx; end; if FCorner in [sgc_southwest,sgc_southeast] then FTargetControl.ClientHeight:=FTargetControl.ClientHeight+diffy else begin FTargetControl.Top:=FTargetControl.Top+diffy; FTargetControl.ClientHeight:=FTargetControl.ClientHeight-diffy; end; end; end;
procedure TDockingSizeGrip.Paint; var r:TRect; diff,i:integer; begin r:=bounds(0,0,width,height); with canvas do begin brush.Style:=bsSolid; brush.Color:=Color; fillrect(r); pen.Style:=psSolid; for i := 0 to max(width,height) div 4 do for diff := 0 to 2 do begin if diff=2 then pen.Color:=clWindow else pen.Color:=clBtnShadow; case FCorner of sgc_northwest:begin moveto(r.Left,r.Top+i*4+diff); lineto(r.Left+i*4+diff,r.Top); end; sgc_northeast:begin moveto(r.Right,r.Top+i*4+diff); lineto(r.Right-i*4-diff,r.Top); end; sgc_southwest:begin moveto(r.Left,r.Bottom-i*4-diff); lineto(r.Left+i*4+diff,r.Bottom); end; sgc_southeast:begin moveto(r.Right,r.Bottom-i*4-diff); lineto(r.Right-i*4-diff,r.Bottom); end; end; end; end; end;
procedure TDockingSizeGrip.SelectCursor(X, Y: longint); begin if (y>0) and (y<=height) and (x>0) and (x<=width) then begin if FCorner in [sgc_southeast,sgc_northwest] then screen.Cursor:=crSizeNWSE else screen.Cursor:=crSizeNESW; end else Screen.Cursor:=crDefault; end;
procedure TDockingSizeGrip.MouseMove(Shift: TShiftState; X, Y: Integer); begin if FMoving then begin AdjustParent(X-FStartX,Y-FStartY); Adjust; end else SelectCursor(X, Y); inherited MouseMove(Shift, X, Y); end;
procedure TDockingSizeGrip.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FMoving := True; FStartX := X; FStartY := Y; inherited MouseDown(Button, Shift, X, Y); end;
procedure TDockingSizeGrip.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin SelectCursor(X, Y); FStartX := 0; FStartY := 0; inherited MouseUp(Button, Shift, X, Y); FMoving := False; Adjust; end;
procedure TDockingSizeGrip.CMMouseEnter(var Message: TMessage); var Pos: TPoint; begin if not (csDesigning in ComponentState) then begin Pos := ScreenToClient(Mouse.CursorPos); SelectCursor(Pos.X, Pos.Y); end; end;
procedure TDockingSizeGrip.CMMouseLeave(var Message: TMessage); begin if not (csDesigning in ComponentState) then begin if not FMoving then Screen.Cursor := crDefault; end; end;
end. |