1{%MainUnit ../controls.pp} 2 3{****************************************************************************** 4 TDragObject 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15type 16 17 { TDockImageWindow - used if widgetset supports hints with alphablend } 18 19 TDockImageWindow = class(THintWindow) 20 public 21 constructor Create(AOwner: TComponent); override; 22 end; 23 24constructor TDockImageWindow.Create(AOwner: TComponent); 25begin 26 inherited Create(AOwner); 27 Color := clHighlight; 28 Width := 100; 29 Height := 100; 30 AlphaBlend := True; 31 AlphaBlendValue := 100; 32end; 33 34var 35 DockImageWindow: TDockImageWindow; 36 37procedure HintDockImage(Sender: TObject; AOldRect, ANewRect: TRect; 38 AOperation: TDockImageOperation); 39begin 40 if DockImageWindow = nil then 41 DockImageWindow := TDockImageWindow.Create(Application); 42 DockImageWindow.BoundsRect := ANewRect; 43 if AOperation = disShow then 44 DockImageWindow.Show 45 else if AOperation = disHide then 46 DockImageWindow.Hide; 47end; 48 49{ TDragObject } 50 51constructor TDragObject.Create(AControl : TControl); 52begin 53 FControl := AControl; 54end; 55 56constructor TDragObject.AutoCreate(AControl: TControl); 57begin 58 Create(AControl); 59 FAutoCreated := True; 60 FAutoFree := True; 61end; 62 63procedure TDragObject.EndDrag(Target: TObject; X, Y: Integer); 64begin 65 if FControl <> nil then 66 FControl.DoEndDrag(Target, X, Y); 67end; 68 69function TDragObject.GetDragImages: TDragImageList; 70begin 71 Result := nil; 72end; 73 74function TDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; 75begin 76 if Accepted then 77 Result := crDrag 78 else 79 Result := crNoDrop; 80end; 81 82procedure TDragObject.HideDragImage; 83begin 84 if GetDragImages <> nil then 85 GetDragImages.HideDragImage; 86end; 87 88procedure TDragObject.ShowDragImage; 89begin 90 if GetDragImages <> nil then 91 GetDragImages.ShowDragImage; 92end; 93 94{ TDragObjectEx } 95 96constructor TDragObjectEx.Create(AControl: TControl); 97begin 98 inherited Create(AControl); 99 FAutoFree := True; 100end; 101 102{ TDragControlObject } 103 104function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; 105begin 106 if Accepted then 107 Result := Control.DragCursor 108 else 109 Result := crNoDrop; 110end; 111 112function TDragControlObject.GetDragImages: TDragImageList; 113begin 114 Result := Control.GetDragImages; 115end; 116 117{ TDragControlObjectEx } 118 119constructor TDragControlObjectEx.Create(AControl: TControl); 120begin 121 inherited Create(AControl); 122 FAutoFree := True; 123end; 124 125{ TDragDockObject } 126 127procedure TDragDockObject.AdjustDockRect(ARect: TRect); 128begin 129 with DockOffset do 130 OffsetRect(FDockRect, -X, -Y); 131end; 132 133function TDragDockObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; 134begin 135 Result := crDefault; 136end; 137 138procedure TDragDockObject.EndDrag(Target: TObject; X, Y: Integer); 139begin 140 if FControl <> nil then 141 FControl.DoEndDock(Target, X, Y); 142end; 143 144procedure TDragDockObject.InitDock(APosition: TPoint); 145begin 146 // Determine hotspot scale for adjusting the undocked rectangle. 147 // Since the undocked extent of the control doesn't change, we fix the hotspot offset. 148 // Usage: OffsetRect(DockRect, FDockOffset); 149 150 DragPos := APosition; //should have been done before 151 Control.CalculateDockSizes; 152 // mouse click offset from control TopLeft in screen coordinates 153 with FDockRect do 154 begin 155 TopLeft := Control.ClientToScreen(Point(0, 0)); 156 Right := Left + Control.Width; 157 Bottom := Top + Control.Height; 158 end; 159 if Control.Width > 0 then 160 FDockOffset.x := Round((APosition.x - FDockRect.Left) / Control.Width * Control.UndockWidth) 161 else 162 FDockOffset.X := 0; 163 if Control.Height > 0 then 164 FDockOffset.Y := Round((APosition.y - FDockRect.Top) / Control.Height * Control.UndockHeight) 165 else 166 FDockOffset.Y := 0; 167 FEraseDockRect := Rect(MaxInt, 0, MaxInt, 0); 168end; 169 170procedure TDragDockObject.ShowDockImage; 171begin 172 if HasOnDrawImage then 173 OnDrawDockImage(Self, EraseDockRect, DockRect, disShow) 174 else 175 WidgetSet.DrawDefaultDockImage(EraseDockRect, DockRect, disShow); 176 EraseDockRect := DockRect; 177end; 178 179procedure TDragDockObject.HideDockImage; 180begin 181 if FEraseDockRect.Left<MaxInt then 182 if HasOnDrawImage then 183 OnDrawDockImage(Self, EraseDockRect, DockRect, disHide) 184 else 185 WidgetSet.DrawDefaultDockImage(EraseDockRect, DockRect, disHide); 186 FEraseDockRect := Rect(MaxInt, 0, MaxInt, 0); 187end; 188 189procedure TDragDockObject.MoveDockImage; 190begin 191 //Draw the form outlines when the position has changed 192 if not CompareRect(@DockRect, @EraseDockRect) then 193 begin 194 if HasOnDrawImage then 195 OnDrawDockImage(Self, EraseDockRect, DockRect, disMove) 196 else 197 WidgetSet.DrawDefaultDockImage(EraseDockRect, DockRect, disMove); 198 EraseDockRect := DockRect; 199 end; 200end; 201 202function TDragDockObject.HasOnDrawImage: boolean; 203begin 204 if Assigned(OnDrawDockImage) then 205 exit(true); 206 if WidgetSet.GetSystemMetrics(SM_LCLHasFormAlphaBlend)=0 then 207 exit(false); 208 OnDrawDockImage := @HintDockImage; 209 Result:=true; 210end; 211 212{ TDragDockObjectEx } 213 214constructor TDragDockObjectEx.Create(AControl: TControl); 215begin 216 inherited Create(AControl); 217 FAutoFree := True; 218end; 219 220// included by controls.pp 221