paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 08:10:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: improved TControl.GetDockEdge

Browse Source 
git-svn-id: trunk@25794 -
This commit is contained in:
mattias 2010-05-31 06:55:03 +00:00
parent 9094e47382
commit 08af96e2f0
2 changed files with 13 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/controls.pp
View File

@ -509,7 +509,7 @@ type
procedure InsertControl(Control: TControl; InsertAt: TAlign; procedure InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl); virtual; abstract; overload; DropCtl: TControl); virtual; abstract; overload;
procedure LoadFromStream(Stream: TStream); virtual; abstract; procedure LoadFromStream(Stream: TStream); virtual; abstract;
procedure PaintSite(DC: HDC); virtual; abstract; procedure PaintSite(DC: HDC); virtual;
procedure MessageHandler(Sender: TControl; var Message: TLMessage); virtual; procedure MessageHandler(Sender: TControl; var Message: TLMessage); virtual;
procedure PositionDockRect(ADockObject: TDragDockObject); virtual; overload; procedure PositionDockRect(ADockObject: TDragDockObject); virtual; overload;
procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign; procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
@ -3792,6 +3792,11 @@ begin
ADockObject.DropOnControl); ADockObject.DropOnControl);
end; end;
procedure TDockManager.PaintSite(DC: HDC);
begin
end;
procedure TDockManager.MessageHandler(Sender: TControl; var Message: TLMessage procedure TDockManager.MessageHandler(Sender: TControl; var Message: TLMessage
); );
begin begin

18
lcl/include/control.inc
View File

@ -167,30 +167,20 @@ var
procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer); procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer);
begin begin
if CurDistance<0 then
CurDistance:=-CurDistance;
if CurDistance>=BestDistance then exit; if CurDistance>=BestDistance then exit;
Result:=CurAlign; Result:=CurAlign;
BestDistance:=CurDistance; BestDistance:=CurDistance;
end; end;
begin begin
// check if MousePos outside the control BestDistance:=High(Integer);
if MousePos.X<=0 then FindMinDistance(alLeft,MousePos.X);
Result:=alLeft
else if MousePos.Y<=0 then
Result:=alTop
else if MousePos.X>=Width then
Result:=alRight
else if MousePos.Y>=Height then
Result:=alBottom
else begin
// MousePos is inside the control -> find nearest edge
BestDistance:=MousePos.X;
Result:=alLeft;
FindMinDistance(alRight,Width-MousePos.X); FindMinDistance(alRight,Width-MousePos.X);
FindMinDistance(alTop,MousePos.Y); FindMinDistance(alTop,MousePos.Y);
FindMinDistance(alBottom,Height-MousePos.Y); FindMinDistance(alBottom,Height-MousePos.Y);
end; end;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TControl.GetDragImages: TDragImageList; function TControl.GetDragImages: TDragImageList;