mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-03 14:58:19 +02:00
implemented OnIdle checking for controlselection bounds
git-svn-id: trunk@6749 -
This commit is contained in:
parent
221f748871
commit
e25e3db111
@ -100,6 +100,8 @@ type
|
|||||||
);
|
);
|
||||||
TSelectedControlFlags = set of TSelectedControlFlag;
|
TSelectedControlFlags = set of TSelectedControlFlag;
|
||||||
|
|
||||||
|
{ TSelectedControl }
|
||||||
|
|
||||||
TSelectedControl = class
|
TSelectedControl = class
|
||||||
private
|
private
|
||||||
FCachedFormRelativeLeftTop: TPoint;
|
FCachedFormRelativeLeftTop: TPoint;
|
||||||
@ -123,6 +125,10 @@ type
|
|||||||
FOwner: TControlSelection;
|
FOwner: TControlSelection;
|
||||||
FPersistent: TPersistent;
|
FPersistent: TPersistent;
|
||||||
FUseCache: boolean;
|
FUseCache: boolean;
|
||||||
|
FUsedHeight: integer;
|
||||||
|
FUsedLeft: integer;
|
||||||
|
FUsedTop: integer;
|
||||||
|
FUsedWidth: integer;
|
||||||
function GetLeft: integer;
|
function GetLeft: integer;
|
||||||
procedure SetLeft(ALeft: integer);
|
procedure SetLeft(ALeft: integer);
|
||||||
function GetTop: integer;
|
function GetTop: integer;
|
||||||
@ -139,6 +145,9 @@ type
|
|||||||
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
|
||||||
procedure SetFormRelativeBounds(ALeft, ATop, AWidth, AHeight: integer);
|
procedure SetFormRelativeBounds(ALeft, ATop, AWidth, AHeight: integer);
|
||||||
procedure GetFormRelativeBounds(var ALeft, ATop, AWidth, AHeight: integer);
|
procedure GetFormRelativeBounds(var ALeft, ATop, AWidth, AHeight: integer);
|
||||||
|
procedure GetFormRelativeBounds(var ALeft, ATop, AWidth, AHeight: integer;
|
||||||
|
StoreAsUsed: boolean);
|
||||||
|
procedure SetUsedBounds(ALeft, ATop, AWidth, AHeight: integer);
|
||||||
procedure SaveBounds;
|
procedure SaveBounds;
|
||||||
procedure UpdateCache;
|
procedure UpdateCache;
|
||||||
function IsTopLvl: boolean;
|
function IsTopLvl: boolean;
|
||||||
@ -156,8 +165,12 @@ type
|
|||||||
property OldTop:integer read FOldTop write FOldTop;
|
property OldTop:integer read FOldTop write FOldTop;
|
||||||
property OldWidth:integer read FOldWidth write FOldWidth;
|
property OldWidth:integer read FOldWidth write FOldWidth;
|
||||||
property OldHeight:integer read FOldHeight write FOldHeight;
|
property OldHeight:integer read FOldHeight write FOldHeight;
|
||||||
property OldFormRelativeLeftTop: TPoint
|
property OldFormRelativeLeftTop: TPoint read FOldFormRelativeLeftTop
|
||||||
read FOldFormRelativeLeftTop write FOldFormRelativeLeftTop;
|
write FOldFormRelativeLeftTop;
|
||||||
|
property UsedLeft: integer read FUsedLeft write FUsedLeft;
|
||||||
|
property UsedTop: integer read FUsedTop write FUsedTop;
|
||||||
|
property UsedWidth: integer read FUsedWidth write FUsedWidth;
|
||||||
|
property UsedHeight: integer read FUsedHeight write FUsedHeight;
|
||||||
property Flags: TSelectedControlFlags read FFlags write FFlags;
|
property Flags: TSelectedControlFlags read FFlags write FFlags;
|
||||||
property UseCache: boolean read FUseCache write SetUseCache;
|
property UseCache: boolean read FUseCache write SetUseCache;
|
||||||
property IsVisible: boolean read FIsVisible;
|
property IsVisible: boolean read FIsVisible;
|
||||||
@ -359,6 +372,7 @@ type
|
|||||||
public
|
public
|
||||||
constructor Create;
|
constructor Create;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
procedure OnIdle(Sender: TObject);
|
||||||
|
|
||||||
// items
|
// items
|
||||||
property Items[Index:integer]:TSelectedControl
|
property Items[Index:integer]:TSelectedControl
|
||||||
@ -405,6 +419,7 @@ type
|
|||||||
procedure SizeComponents(HorizSizing: TComponentSizing; AWidth: integer;
|
procedure SizeComponents(HorizSizing: TComponentSizing; AWidth: integer;
|
||||||
VertSizing: TComponentSizing; AHeight: integer);
|
VertSizing: TComponentSizing; AHeight: integer);
|
||||||
procedure ScaleComponents(Percent: integer);
|
procedure ScaleComponents(Percent: integer);
|
||||||
|
function CheckForLCLChanges(Update: boolean): boolean;
|
||||||
|
|
||||||
// snapping
|
// snapping
|
||||||
function FindNearestSnapLeft(ALeft, AWidth: integer): integer;
|
function FindNearestSnapLeft(ALeft, AWidth: integer): integer;
|
||||||
@ -610,6 +625,23 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSelectedControl.GetFormRelativeBounds(var ALeft, ATop, AWidth,
|
||||||
|
AHeight: integer; StoreAsUsed: boolean);
|
||||||
|
begin
|
||||||
|
GetFormRelativeBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
if StoreAsUsed then
|
||||||
|
SetUsedBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSelectedControl.SetUsedBounds(ALeft, ATop, AWidth, AHeight: integer
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
FUsedLeft:=ALeft;
|
||||||
|
FUsedTop:=ATop;
|
||||||
|
FUsedWidth:=AWidth;
|
||||||
|
FUsedHeight:=AHeight;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSelectedControl.SaveBounds;
|
procedure TSelectedControl.SaveBounds;
|
||||||
begin
|
begin
|
||||||
if not FIsTComponent then exit;
|
if not FIsTComponent then exit;
|
||||||
@ -782,17 +814,24 @@ begin
|
|||||||
FRubberbandType:=rbtSelection;
|
FRubberbandType:=rbtSelection;
|
||||||
FRubberbandCreationColor:=clMaroon;
|
FRubberbandCreationColor:=clMaroon;
|
||||||
FRubberbandSelectionColor:=clNavy;
|
FRubberbandSelectionColor:=clNavy;
|
||||||
|
Application.AddOnIdleHandler(@OnIdle);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TControlSelection.Destroy;
|
destructor TControlSelection.Destroy;
|
||||||
var g:TGrabIndex;
|
var g:TGrabIndex;
|
||||||
begin
|
begin
|
||||||
|
Application.RemoveAllHandlersOfObject(Self);
|
||||||
Clear;
|
Clear;
|
||||||
FControls.Free;
|
FControls.Free;
|
||||||
for g:=Low(TGrabIndex) to High(TGrabIndex) do FGrabbers[g].Free;
|
for g:=Low(TGrabIndex) to High(TGrabIndex) do FGrabbers[g].Free;
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TControlSelection.OnIdle(Sender: TObject);
|
||||||
|
begin
|
||||||
|
CheckForLCLChanges(true);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TControlSelection.BeginUpdate;
|
procedure TControlSelection.BeginUpdate;
|
||||||
begin
|
begin
|
||||||
inc(FUpdateLock);
|
inc(FUpdateLock);
|
||||||
@ -1070,10 +1109,11 @@ var
|
|||||||
NextRealLeft, NextRealTop, NextRealHeight, NextRealWidth: integer;
|
NextRealLeft, NextRealTop, NextRealHeight, NextRealWidth: integer;
|
||||||
begin
|
begin
|
||||||
if FControls.Count>=1 then begin
|
if FControls.Count>=1 then begin
|
||||||
Items[0].GetFormRelativeBounds(FRealLeft,FRealTop,FRealWidth,FRealHeight);
|
Items[0].GetFormRelativeBounds(FRealLeft,FRealTop,FRealWidth,FRealHeight,
|
||||||
|
true);
|
||||||
for i:=1 to FControls.Count-1 do begin
|
for i:=1 to FControls.Count-1 do begin
|
||||||
Items[i].GetFormRelativeBounds(
|
Items[i].GetFormRelativeBounds(
|
||||||
NextRealLeft,NextRealTop,NextRealWidth,NextRealHeight);
|
NextRealLeft,NextRealTop,NextRealWidth,NextRealHeight,true);
|
||||||
if FRealLeft>NextRealLeft then begin
|
if FRealLeft>NextRealLeft then begin
|
||||||
inc(FRealWidth,FRealLeft-NextRealLeft);
|
inc(FRealWidth,FRealLeft-NextRealLeft);
|
||||||
FRealLeft:=NextRealLeft;
|
FRealLeft:=NextRealLeft;
|
||||||
@ -2780,6 +2820,43 @@ begin
|
|||||||
EndResizing(false);
|
EndResizing(false);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TControlSelection.CheckForLCLChanges(Update: boolean): boolean;
|
||||||
|
|
||||||
|
function BoundsChanged(CurItem: TSelectedControl): boolean;
|
||||||
|
var CurLeft, CurTop, CurWidth, CurHeight: integer;
|
||||||
|
begin
|
||||||
|
CurItem.GetFormRelativeBounds(CurLeft,CurTop,CurWidth,CurHeight);
|
||||||
|
Result:=(CurLeft<>CurItem.UsedLeft)
|
||||||
|
or (CurTop<>CurItem.UsedTop)
|
||||||
|
or (CurWidth<>CurItem.UsedWidth)
|
||||||
|
or (CurHeight<>CurItem.UsedHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Result:=false;
|
||||||
|
if FControls.Count>=1 then begin
|
||||||
|
for i:=0 to FControls.Count-1 do begin
|
||||||
|
if BoundsChanged(Items[i]) then begin
|
||||||
|
Result:=true;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Result and Update then begin
|
||||||
|
//debugln('TControlSelection.CheckForLCLChanges');
|
||||||
|
for i:=0 to FControls.Count-1 do
|
||||||
|
if Items[i].IsTComponent and BoundsChanged(Items[i]) then
|
||||||
|
InvalidateMarkersForComponent(TComponent(Items[i].Persistent));
|
||||||
|
if not IsResizing then begin
|
||||||
|
UpdateBounds;
|
||||||
|
DoChangeProperties;
|
||||||
|
end;
|
||||||
|
InvalidateGuideLinesCache;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TControlSelection.DrawGuideLines(DC: TDesignerDeviceContext);
|
procedure TControlSelection.DrawGuideLines(DC: TDesignerDeviceContext);
|
||||||
var
|
var
|
||||||
DCOrigin: TPoint;
|
DCOrigin: TPoint;
|
||||||
|
@ -218,7 +218,7 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure Modified; override;
|
procedure Modified; override;
|
||||||
Procedure SelectOnlyThisComponent(AComponent:TComponent); override;
|
procedure SelectOnlyThisComponent(AComponent:TComponent); override;
|
||||||
function CopySelection: boolean; override;
|
function CopySelection: boolean; override;
|
||||||
function CutSelection: boolean; override;
|
function CutSelection: boolean; override;
|
||||||
function CanPaste: Boolean; override;
|
function CanPaste: Boolean; override;
|
||||||
@ -997,17 +997,7 @@ begin
|
|||||||
Result:=true;
|
Result:=true;
|
||||||
Sender.Dispatch(TheMessage);
|
Sender.Dispatch(TheMessage);
|
||||||
if ControlSelection.SelectionForm=Form then begin
|
if ControlSelection.SelectionForm=Form then begin
|
||||||
if not ControlSelection.IsResizing then begin
|
ControlSelection.CheckForLCLChanges(true);
|
||||||
{debugln('### TDesigner.SizeControl ',Sender.Name,':',Sender.ClassName,
|
|
||||||
' ',Sender.Width,',',Sender.Height,
|
|
||||||
' Type=',TheMessage.SizeType
|
|
||||||
,' ',TheMessage.Width,',',TheMessage.Height,' Pos=',Sender.Left,',',Sender.Top);}
|
|
||||||
ControlSelection.UpdateBounds;
|
|
||||||
if Assigned(FOnPropertiesChanged) then
|
|
||||||
FOnPropertiesChanged(Self);
|
|
||||||
end;
|
|
||||||
ControlSelection.InvalidateGuideLinesCache;
|
|
||||||
ControlSelection.InvalidateMarkersForComponent(Sender);
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1017,14 +1007,7 @@ begin
|
|||||||
Sender.Dispatch(TheMessage);
|
Sender.Dispatch(TheMessage);
|
||||||
//debugln('*** TDesigner.MoveControl A ',Sender.Name,':',Sender.ClassName,' ',ControlSelection.SelectionForm=Form,' ',not ControlSelection.IsResizing,' ',ControlSelection.IsSelected(Sender));
|
//debugln('*** TDesigner.MoveControl A ',Sender.Name,':',Sender.ClassName,' ',ControlSelection.SelectionForm=Form,' ',not ControlSelection.IsResizing,' ',ControlSelection.IsSelected(Sender));
|
||||||
if ControlSelection.SelectionForm=Form then begin
|
if ControlSelection.SelectionForm=Form then begin
|
||||||
if not ControlSelection.IsResizing then begin
|
ControlSelection.CheckForLCLChanges(true);
|
||||||
//debugln('*** TDesigner.MoveControl ',Sender.Name,':',Sender.ClassName,' ',Assigned(FOnPropertiesChanged));
|
|
||||||
ControlSelection.UpdateBounds;
|
|
||||||
if Assigned(FOnPropertiesChanged) then
|
|
||||||
FOnPropertiesChanged(Self);
|
|
||||||
end;
|
|
||||||
ControlSelection.InvalidateGuideLinesCache;
|
|
||||||
ControlSelection.InvalidateMarkersForComponent(Sender);
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user