paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-03 12:17:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: accelerated calculating guidelines

Browse Source 
git-svn-id: trunk@3468 -
This commit is contained in:
lazarus 2002-10-05 14:03:58 +00:00
parent d11861c864
commit 199076ab2f
2 changed files with 276 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
components/codetools/laz_xmlread.pas
View File

@ -147,6 +147,7 @@ type
procedure ExpectWhitespace; procedure ExpectWhitespace;
procedure ExpectString(const s: String); procedure ExpectString(const s: String);
function CheckFor(s: PChar): Boolean; function CheckFor(s: PChar): Boolean;
function CheckForChar(c: Char): Boolean;
procedure SkipString(const ValidChars: TSetOfChar); procedure SkipString(const ValidChars: TSetOfChar);
function GetString(const ValidChars: TSetOfChar): String; function GetString(const ValidChars: TSetOfChar): String;
function GetString(BufPos: PChar; Len: integer): String; function GetString(BufPos: PChar; Len: integer): String;
@ -261,15 +262,25 @@ end;
function TXMLReader.CheckFor(s: PChar): Boolean; function TXMLReader.CheckFor(s: PChar): Boolean;
begin begin
if buf[0] = #0 then begin if buf[0] <> #0 then begin
if (buf[0]=s[0]) and (StrLComp(buf, s, StrLen(s)) = 0) then begin
Inc(buf, StrLen(s));
Result := True;
end else
Result := False;
end else begin
Result := False; Result := False;
exit;
end; end;
if StrLComp(buf, s, StrLen(s)) = 0 then begin end;
Inc(buf, StrLen(s));
Result := True; function TXMLReader.CheckForChar(c: Char): Boolean;
end else begin
Result := False; if (buf[0]=c) and (c<>#0) then begin
inc(buf);
Result:=true;
end else begin
Result:=false;
end;
end; end;
procedure TXMLReader.SkipString(const ValidChars: TSetOfChar); procedure TXMLReader.SkipString(const ValidChars: TSetOfChar);
@ -352,8 +363,8 @@ end;
function TXMLReader.GetName(var s: String): Boolean; // [5] function TXMLReader.GetName(var s: String): Boolean; // [5]
var OldBuf: PChar; var OldBuf: PChar;
begin begin
SetLength(s, 0);
if not (buf[0] in (Letter + ['_', ':'])) then begin if not (buf[0] in (Letter + ['_', ':'])) then begin
SetLength(s, 0);
Result := False; Result := False;
exit; exit;
end; end;
@ -415,25 +426,23 @@ var
end; end;
var var
StrDel: array[0..1] of Char; // String delimiter StrDel: char;
begin begin
if (buf[0] <> '''') and (buf[0] <> '"') then if (buf[0] <> '''') and (buf[0] <> '"') then
RaiseExc('Expected quotation marks'); RaiseExc('Expected quotation marks');
StrDel[0] := buf[0]; StrDel:=buf[0];
StrDel[1] := #0;
Inc(buf); Inc(buf);
OldBuf := buf; OldBuf := buf;
while not CheckFor(StrDel) do while (buf[0]<>StrDel) and (buf[0]<>#0) do begin
if buf[0] = '&' then if buf[0] <> '&' then begin
Inc(buf);
end else
begin begin
if OldBuf<>buf then FlushStringBuffer; if OldBuf<>buf then FlushStringBuffer;
ParseReference(attr); ParseReference(attr);
OldBuf := buf; OldBuf := buf;
end else
begin
Inc(buf);
end; end;
dec(buf); end;
if OldBuf<>buf then FlushStringBuffer; if OldBuf<>buf then FlushStringBuffer;
inc(buf); inc(buf);
ResolveEntities(Attr); ResolveEntities(Attr);
@ -442,10 +451,10 @@ end;
function TXMLReader.ExpectPubidLiteral: String; function TXMLReader.ExpectPubidLiteral: String;
begin begin
SetLength(Result, 0); SetLength(Result, 0);
if CheckFor('''') then begin if CheckForChar('''') then begin
SkipString(PubidChars - ['''']); SkipString(PubidChars - ['''']);
ExpectString(''''); ExpectString('''');
end else if CheckFor('"') then begin end else if CheckForChar('"') then begin
SkipString(PubidChars - ['"']); SkipString(PubidChars - ['"']);
ExpectString('"'); ExpectString('"');
end else end else
@ -454,10 +463,10 @@ end;
procedure TXMLReader.SkipPubidLiteral; procedure TXMLReader.SkipPubidLiteral;
begin begin
if CheckFor('''') then begin if CheckForChar('''') then begin
SkipString(PubidChars - ['''']); SkipString(PubidChars - ['''']);
ExpectString(''''); ExpectString('''');
end else if CheckFor('"') then begin end else if CheckForChar('"') then begin
SkipString(PubidChars - ['"']); SkipString(PubidChars - ['"']);
ExpectString('"'); ExpectString('"');
end else end else
@ -576,16 +585,16 @@ begin
SkipWhitespace; SkipWhitespace;
DocType.Name := ExpectName; DocType.Name := ExpectName;
SkipWhitespace; SkipWhitespace;
if CheckFor('[') then if CheckForChar('[') then
begin begin
ParseDoctypeDecls; ParseDoctypeDecls;
SkipWhitespace; SkipWhitespace;
ExpectString('>'); ExpectString('>');
end else if not CheckFor('>') then end else if not CheckForChar('>') then
begin begin
ParseExternalID; ParseExternalID;
SkipWhitespace; SkipWhitespace;
if CheckFor('[') then if CheckForChar('[') then
begin begin
ParseDoctypeDecls; ParseDoctypeDecls;
SkipWhitespace; SkipWhitespace;
@ -637,13 +646,13 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
procedure ExpectCP; // [48] procedure ExpectCP; // [48]
begin begin
if CheckFor('(') then if CheckForChar('(') then
ExpectChoiceOrSeq ExpectChoiceOrSeq
else else
SkipName; SkipName;
if CheckFor('?') then if CheckForChar('?') then
else if CheckFor('*') then else if CheckForChar('*') then
else if CheckFor('+') then; else if CheckForChar('+') then;
end; end;
var var
@ -653,7 +662,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
ExpectCP; ExpectCP;
SkipWhitespace; SkipWhitespace;
delimiter := #0; delimiter := #0;
while not CheckFor(')') do begin while not CheckForChar(')') do begin
if delimiter = #0 then begin if delimiter = #0 then begin
if (buf[0] = '|') or (buf[0] = ',') then if (buf[0] = '|') or (buf[0] = ',') then
delimiter := buf[0] delimiter := buf[0]
@ -677,12 +686,12 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
if CheckFor('EMPTY') then if CheckFor('EMPTY') then
else if CheckFor('ANY') then else if CheckFor('ANY') then
else if CheckFor('(') then begin else if CheckForChar('(') then begin
SkipWhitespace; SkipWhitespace;
if CheckFor('#PCDATA') then begin if CheckFor('#PCDATA') then begin
// Parse Mixed section [51] // Parse Mixed section [51]
SkipWhitespace; SkipWhitespace;
if not CheckFor(')') then if not CheckForChar(')') then
repeat repeat
ExpectString('|'); ExpectString('|');
SkipWhitespace; SkipWhitespace;
@ -693,9 +702,9 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
ExpectChoiceOrSeq; ExpectChoiceOrSeq;
if CheckFor('?') then if CheckForChar('?') then
else if CheckFor('*') then else if CheckForChar('*') then
else if CheckFor('+') then; else if CheckForChar('+') then;
end; end;
end else end else
RaiseExc('Invalid content specification'); RaiseExc('Invalid content specification');
@ -715,7 +724,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
ExpectWhitespace; ExpectWhitespace;
SkipName; SkipName;
SkipWhitespace; SkipWhitespace;
while not CheckFor('>') do begin while not CheckForChar('>') do begin
SkipName; SkipName;
ExpectWhitespace; ExpectWhitespace;
@ -734,17 +743,17 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
SkipWhitespace; SkipWhitespace;
SkipName; SkipName;
SkipWhitespace; SkipWhitespace;
while not CheckFor(')') do begin while not CheckForChar(')') do begin
ExpectString('|'); ExpectString('|');
SkipWhitespace; SkipWhitespace;
SkipName; SkipName;
SkipWhitespace; SkipWhitespace;
end; end;
end else if CheckFor('(') then begin // [59] end else if CheckForChar('(') then begin // [59]
SkipWhitespace; SkipWhitespace;
SkipString(Nmtoken); SkipString(Nmtoken);
SkipWhitespace; SkipWhitespace;
while not CheckFor(')') do begin while not CheckForChar(')') do begin
ExpectString('|'); ExpectString('|');
SkipWhitespace; SkipWhitespace;
SkipString(Nmtoken); SkipString(Nmtoken);
@ -778,16 +787,15 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
function ParseEntityValue: Boolean; // [9] function ParseEntityValue: Boolean; // [9]
var var
strdel: array[0..1] of Char; strdel: Char;
begin begin
if (buf[0] <> '''') and (buf[0] <> '"') then begin if (buf[0] <> '''') and (buf[0] <> '"') then begin
Result := False; Result := False;
exit; exit;
end; end;
strdel[0] := buf[0]; strdel := buf[0];
strdel[1] := #0;
Inc(buf); Inc(buf);
while not CheckFor(strdel) do while not CheckForChar(strdel) do
if ParsePEReference then if ParsePEReference then
else if ParseReference(NewEntity) then else if ParseReference(NewEntity) then
else begin else begin
@ -799,7 +807,7 @@ function TXMLReader.ParseMarkupDecl: Boolean; // [29]
begin begin
if CheckFor('<!ENTITY') then begin if CheckFor('<!ENTITY') then begin
ExpectWhitespace; ExpectWhitespace;
if CheckFor('%') then begin // [72] if CheckForChar('%') then begin // [72]
ExpectWhitespace; ExpectWhitespace;
NewEntity := doc.CreateEntity(ExpectName); NewEntity := doc.CreateEntity(ExpectName);
ExpectWhitespace; ExpectWhitespace;
@ -952,7 +960,7 @@ var
IsEmpty := True; IsEmpty := True;
break; break;
end; end;
if CheckFor('>') then if CheckForChar('>') then
break; break;
// Get Attribute [41] // Get Attribute [41]
@ -988,7 +996,7 @@ var
OldBuf: PChar; OldBuf: PChar;
begin begin
OldBuf := Buf; OldBuf := Buf;
if CheckFor('<') then if CheckForChar('<') then
begin begin
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement A');{$ENDIF} {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement A');{$ENDIF}
if not CheckName then if not CheckName then
@ -1012,7 +1020,7 @@ end;
function TXMLReader.ParsePEReference: Boolean; // [69] function TXMLReader.ParsePEReference: Boolean; // [69]
begin begin
if CheckFor('%') then begin if CheckForChar('%') then begin
SkipName; SkipName;
ExpectString(';'); ExpectString(';');
Result := True; Result := True;
@ -1022,12 +1030,12 @@ end;
function TXMLReader.ParseReference(AOwner: TDOMNode): Boolean; // [67] [68] function TXMLReader.ParseReference(AOwner: TDOMNode): Boolean; // [67] [68]
begin begin
if not CheckFor('&') then begin if not CheckForChar('&') then begin
Result := False; Result := False;
exit; exit;
end; end;
if CheckFor('#') then begin // Test for CharRef [66] if CheckForChar('#') then begin // Test for CharRef [66]
if CheckFor('x') then begin if CheckForChar('x') then begin
// !!!: there must be at least one digit // !!!: there must be at least one digit
while buf[0] in ['0'..'9', 'a'..'f', 'A'..'F'] do Inc(buf); while buf[0] in ['0'..'9', 'a'..'f', 'A'..'F'] do Inc(buf);
end else end else
@ -1052,7 +1060,6 @@ function TXMLReader.ParseExternalID: Boolean; // [75]
var var
OldBuf: PChar; OldBuf: PChar;
begin begin
SetLength(Result, 0);
if buf[0] = '''' then begin if buf[0] = '''' then begin
Inc(buf); Inc(buf);
OldBuf := buf; OldBuf := buf;
@ -1069,7 +1076,8 @@ function TXMLReader.ParseExternalID: Boolean; // [75]
end; end;
Result := GetString(OldBuf,buf-OldBuf); Result := GetString(OldBuf,buf-OldBuf);
ExpectString('"'); ExpectString('"');
end; end else
Result:='';
end; end;
procedure SkipSystemLiteral; procedure SkipSystemLiteral;
@ -1343,6 +1351,9 @@ end.
{ {
$Log$ $Log$
Revision 1.6 2002/10/05 14:03:58 lazarus
MG: accelerated calculating guidelines
Revision 1.5 2002/10/01 08:27:35 lazarus Revision 1.5 2002/10/01 08:27:35 lazarus
MG: fixed parsing textnodes MG: fixed parsing textnodes

315
designer/controlselection.pp
View File

@ -89,17 +89,31 @@ type
FOldWidth: integer; FOldWidth: integer;
FOldHeight: integer; FOldHeight: integer;
FOldFormRelativeLeftTop: TPoint; FOldFormRelativeLeftTop: TPoint;
FCachedLeft: integer;
FCachedTop: integer;
FCachedWidth: integer;
FCachedHeight: integer;
FCachedFormRelativeLeftTop: TPoint;
FUseCache: boolean;
function GetLeft: integer; function GetLeft: integer;
procedure SetLeft(ALeft: integer); procedure SetLeft(ALeft: integer);
function GetTop: integer; function GetTop: integer;
procedure SetTop(ATop: integer); procedure SetTop(ATop: integer);
function GetWidth: integer; function GetWidth: integer;
procedure SetUseCache(const AValue: boolean);
procedure SetWidth(AWidth: integer); procedure SetWidth(AWidth: integer);
function GetHeight: integer; function GetHeight: integer;
procedure SetHeight(AHeight: integer); procedure SetHeight(AHeight: integer);
public public
constructor Create(AComponent:TComponent); constructor Create(AComponent:TComponent);
destructor Destroy; override; destructor Destroy; override;
function ParentForm: TCustomForm;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SetFormRelativeBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SaveBounds;
procedure UpdateCache;
function IsTopLvl: boolean;
property Component:TComponent read FComponent write FComponent; property Component:TComponent read FComponent write FComponent;
property Left: integer read GetLeft write SetLeft; property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop; property Top: integer read GetTop write SetTop;
@ -111,11 +125,7 @@ type
property OldHeight:integer read FOldHeight write FOldHeight; property OldHeight:integer read FOldHeight write FOldHeight;
property OldFormRelativeLeftTop: TPoint property OldFormRelativeLeftTop: TPoint
read FOldFormRelativeLeftTop write FOldFormRelativeLeftTop; read FOldFormRelativeLeftTop write FOldFormRelativeLeftTop;
function ParentForm: TCustomForm; property UseCache: boolean read FUseCache write SetUseCache;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SetFormRelativeBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SaveBounds;
function IsTopLvl: boolean;
end; end;
TComponentAlignment = (csaNone, csaSides1, csaCenters, csaSides2, TComponentAlignment = (csaNone, csaSides1, csaCenters, csaSides2,
@ -129,7 +139,8 @@ type
TControlSelState = (cssOnlyNonVisualNeedsUpdate, TControlSelState = (cssOnlyNonVisualNeedsUpdate,
cssOnlyVisualNeedsUpdate, cssOnlyVisualNeedsUpdate,
cssBoundsNeedsUpdate, cssBoundsNeedsUpdate,
cssBoundsNeedsSaving); cssBoundsNeedsSaving
);
TControlSelStates = set of TControlSelState; TControlSelStates = set of TControlSelState;
TNearestInt = record TNearestInt = record
@ -138,6 +149,14 @@ type
Valid: boolean; Valid: boolean;
end; end;
TGuideLineCache = record
CacheValid: boolean;
LineValid: boolean;
Line: TRect;
end;
TGuideLineType = (glLeft, glTop, glRight, glBottom);
TControlSelection = class(TObject) TControlSelection = class(TObject)
private private
FControls: TList; // list of TSelectedComponent FControls: TList; // list of TSelectedComponent
@ -165,6 +184,9 @@ type
FOldTop: integer; FOldTop: integer;
FOldWidth: integer; FOldWidth: integer;
FOldHeight: integer; FOldHeight: integer;
// caches
FCacheGuideLines: boolean;
FGuideLinesCache: array[TGuideLineType] of TGuideLineCache;
FCustomForm: TCustomForm; FCustomForm: TCustomForm;
FGrabbers: array[TGrabIndex] of TGrabber; FGrabbers: array[TGrabIndex] of TGrabber;
@ -186,6 +208,7 @@ type
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
procedure SetCacheGuideLines(const AValue: boolean);
procedure SetCustomForm; procedure SetCustomForm;
function GetGrabbers(AGrabIndex:TGrabIndex): TGrabber; function GetGrabbers(AGrabIndex:TGrabIndex): TGrabber;
procedure SetGrabbers(AGrabIndex:TGrabIndex; const AGrabber: TGrabber); procedure SetGrabbers(AGrabIndex:TGrabIndex; const AGrabber: TGrabber);
@ -270,6 +293,8 @@ type
procedure ScaleComponents(Percent: integer); procedure ScaleComponents(Percent: integer);
property Snapping: boolean read FSnapping write SetSnapping; property Snapping: boolean read FSnapping write SetSnapping;
procedure DrawGuideLines(DC: TDesignerDeviceContext); procedure DrawGuideLines(DC: TDesignerDeviceContext);
property CacheGuideLines: boolean read FCacheGuideLines write SetCacheGuideLines;
procedure InvalidGuideLinesCache;
property GrabberSize:integer read FGrabberSize write SetGrabberSize; property GrabberSize:integer read FGrabberSize write SetGrabberSize;
property GrabberColor: TColor read FGrabberColor write FGrabberColor; property GrabberColor: TColor read FGrabberColor write FGrabberColor;
@ -404,6 +429,12 @@ begin
// ,' ',FOldLeft,',',FOldTop); // ,' ',FOldLeft,',',FOldTop);
end; end;
procedure TSelectedControl.UpdateCache;
begin
GetComponentBounds(FComponent,FCachedLeft,FCachedTop,FCachedWidth,FCachedHeight);
FCachedFormRelativeLeftTop:=GetParentFormRelativeTopLeft(FComponent);
end;
function TSelectedControl.IsTopLvl: boolean; function TSelectedControl.IsTopLvl: boolean;
begin begin
Result:=(FComponent is TControl) and (TControl(FComponent).Parent=nil); Result:=(FComponent is TControl) and (TControl(FComponent).Parent=nil);
@ -411,7 +442,10 @@ end;
function TSelectedControl.GetLeft: integer; function TSelectedControl.GetLeft: integer;
begin begin
Result:=GetComponentLeft(FComponent); if FUseCache then
Result:=FCachedLeft
else
Result:=GetComponentLeft(FComponent);
end; end;
procedure TSelectedControl.SetLeft(ALeft: integer); procedure TSelectedControl.SetLeft(ALeft: integer);
@ -420,11 +454,15 @@ begin
TControl(FComponent).Left:=Aleft TControl(FComponent).Left:=Aleft
else else
LongRec(FComponent.DesignInfo).Lo:=ALeft; LongRec(FComponent.DesignInfo).Lo:=ALeft;
FCachedLeft:=ALeft;
end; end;
function TSelectedControl.GetTop: integer; function TSelectedControl.GetTop: integer;
begin begin
Result:=GetComponentTop(FComponent); if FUseCache then
Result:=FCachedTop
else
Result:=GetComponentTop(FComponent);
end; end;
procedure TSelectedControl.SetTop(ATop: integer); procedure TSelectedControl.SetTop(ATop: integer);
@ -433,11 +471,22 @@ begin
TControl(FComponent).Top:=ATop TControl(FComponent).Top:=ATop
else else
LongRec(FComponent.DesignInfo).Hi:=ATop; LongRec(FComponent.DesignInfo).Hi:=ATop;
FCachedTop:=ATop;
end; end;
function TSelectedControl.GetWidth: integer; function TSelectedControl.GetWidth: integer;
begin begin
Result:=GetComponentWidth(FComponent); if FUseCache then
Result:=FCachedWidth
else
Result:=GetComponentWidth(FComponent);
end;
procedure TSelectedControl.SetUseCache(const AValue: boolean);
begin
if FUseCache=AValue then exit;
FUseCache:=AValue;
if FUseCache then UpdateCache;
end; end;
procedure TSelectedControl.SetWidth(AWidth: integer); procedure TSelectedControl.SetWidth(AWidth: integer);
@ -446,6 +495,7 @@ begin
TControl(FComponent).Width:=AWidth TControl(FComponent).Width:=AWidth
else else
; ;
FCachedWidth:=AWidth;
end; end;
function TSelectedControl.GetHeight: integer; function TSelectedControl.GetHeight: integer;
@ -459,6 +509,7 @@ begin
TControl(FComponent).Height:=AHeight TControl(FComponent).Height:=AHeight
else else
; ;
FCachedHeight:=AHeight;
end; end;
@ -486,6 +537,7 @@ begin
FRubberbandActive:=false; FRubberbandActive:=false;
FNotSaveBounds:=false; FNotSaveBounds:=false;
FStates:=[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate]; FStates:=[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate];
fCacheGuideLines:=true;
end; end;
destructor TControlSelection.Destroy; destructor TControlSelection.Destroy;
@ -529,6 +581,13 @@ begin
EndUpdate; EndUpdate;
end; end;
procedure TControlSelection.SetCacheGuideLines(const AValue: boolean);
begin
if FCacheGuideLines=AValue then exit;
FCacheGuideLines:=AValue;
InvalidGuideLinesCache;
end;
procedure TControlSelection.SetCustomForm; procedure TControlSelection.SetCustomForm;
var var
OldCustomForm, NewCustomForm: TCustomForm; OldCustomForm, NewCustomForm: TCustomForm;
@ -622,6 +681,7 @@ begin
Abs(FWidth), Abs(FWidth),
Abs(FHeight) Abs(FHeight)
); );
InvalidGuideLinesCache;
end else if Count>1 then begin end else if Count>1 then begin
// multi selection // multi selection
{$IFDEF VerboseDesigner} {$IFDEF VerboseDesigner}
@ -654,6 +714,7 @@ begin
' ',Items[i].Left,',',Items[i].Top,',',Items[i].Width,',',Items[i].Height); ' ',Items[i].Left,',',Items[i].Top,',',Items[i].Width,',',Items[i].Height);
{$ENDIF} {$ENDIF}
end; end;
InvalidGuideLinesCache;
end; end;
end; end;
UpdateRealBounds; UpdateRealBounds;
@ -915,29 +976,40 @@ function TControlSelection.GetLeftGuideLine(var ALine: TRect): boolean;
var i, LineTop, LineBottom: integer; var i, LineTop, LineBottom: integer;
CRect: TRect; CRect: TRect;
begin begin
Result:=false; if CacheGuideLines and FGuideLinesCache[glLeft].CacheValid then begin
if FCustomForm=nil then exit; Result:=FGuideLinesCache[glLeft].LineValid;
for i:=0 to FCustomForm.ComponentCount-1 do begin if Result then
if IsSelected(FCustomForm.Components[i]) then continue; ALine:=FGuideLinesCache[glLeft].Line;
CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]); end else begin
if CRect.Left=FRealLeft then begin Result:=false;
ALine.Left:=FRealLeft; if FCustomForm=nil then exit;
ALine.Right:=ALine.Left; for i:=0 to FCustomForm.ComponentCount-1 do begin
LineTop:=Min(Min(Min(FRealTop, if IsSelected(FCustomForm.Components[i]) then continue;
FRealTop+FRealHeight), CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]);
CRect.Top), if CRect.Left=FRealLeft then begin
CRect.Bottom); ALine.Left:=FRealLeft;
LineBottom:=Max(Max(Max(FRealTop, ALine.Right:=ALine.Left;
FRealTop+FRealHeight), LineTop:=Min(Min(Min(FRealTop,
CRect.Top), FRealTop+FRealHeight),
CRect.Bottom); CRect.Top),
if Result then begin CRect.Bottom);
LineTop:=Min(ALine.Top,LineTop); LineBottom:=Max(Max(Max(FRealTop,
LineBottom:=Max(ALine.Bottom,LineBottom); FRealTop+FRealHeight),
end else CRect.Top),
Result:=true; CRect.Bottom);
ALine.Top:=LineTop; if Result then begin
ALine.Bottom:=LineBottom; LineTop:=Min(ALine.Top,LineTop);
LineBottom:=Max(ALine.Bottom,LineBottom);
end else
Result:=true;
ALine.Top:=LineTop;
ALine.Bottom:=LineBottom;
end;
end;
if CacheGuideLines then begin
FGuideLinesCache[glLeft].LineValid:=Result;
FGuideLinesCache[glLeft].Line:=ALine;
FGuideLinesCache[glLeft].CacheValid:=true;
end; end;
end; end;
end; end;
@ -946,29 +1018,40 @@ function TControlSelection.GetRightGuideLine(var ALine: TRect): boolean;
var i, LineTop, LineBottom: integer; var i, LineTop, LineBottom: integer;
CRect: TRect; CRect: TRect;
begin begin
Result:=false; if CacheGuideLines and FGuideLinesCache[glRight].CacheValid then begin
if FCustomForm=nil then exit; Result:=FGuideLinesCache[glRight].LineValid;
for i:=0 to FCustomForm.ComponentCount-1 do begin if Result then
if IsSelected(FCustomForm.Components[i]) then continue; ALine:=FGuideLinesCache[glRight].Line;
CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]); end else begin
if (CRect.Right=FRealLeft+FRealWidth) then begin Result:=false;
ALine.Left:=CRect.Right; if FCustomForm=nil then exit;
ALine.Right:=ALine.Left; for i:=0 to FCustomForm.ComponentCount-1 do begin
LineTop:=Min(Min(Min(FRealTop, if IsSelected(FCustomForm.Components[i]) then continue;
FRealTop+FRealHeight), CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]);
CRect.Top), if (CRect.Right=FRealLeft+FRealWidth) then begin
CRect.Bottom); ALine.Left:=CRect.Right;
LineBottom:=Max(Max(Max(FRealTop, ALine.Right:=ALine.Left;
FRealTop+FRealHeight), LineTop:=Min(Min(Min(FRealTop,
CRect.Top), FRealTop+FRealHeight),
CRect.Bottom); CRect.Top),
if Result then begin CRect.Bottom);
LineTop:=Min(ALine.Top,LineTop); LineBottom:=Max(Max(Max(FRealTop,
LineBottom:=Max(ALine.Bottom,LineBottom); FRealTop+FRealHeight),
end else CRect.Top),
Result:=true; CRect.Bottom);
ALine.Top:=LineTop; if Result then begin
ALine.Bottom:=LineBottom; LineTop:=Min(ALine.Top,LineTop);
LineBottom:=Max(ALine.Bottom,LineBottom);
end else
Result:=true;
ALine.Top:=LineTop;
ALine.Bottom:=LineBottom;
end;
end;
if CacheGuideLines then begin
FGuideLinesCache[glRight].LineValid:=Result;
FGuideLinesCache[glRight].Line:=ALine;
FGuideLinesCache[glRight].CacheValid:=true;
end; end;
end; end;
end; end;
@ -977,29 +1060,40 @@ function TControlSelection.GetTopGuideLine(var ALine: TRect): boolean;
var i, LineLeft, LineRight: integer; var i, LineLeft, LineRight: integer;
CRect: TRect; CRect: TRect;
begin begin
Result:=false; if CacheGuideLines and FGuideLinesCache[glTop].CacheValid then begin
if FCustomForm=nil then exit; Result:=FGuideLinesCache[glTop].LineValid;
for i:=0 to FCustomForm.ComponentCount-1 do begin if Result then
if IsSelected(FCustomForm.Components[i]) then continue; ALine:=FGuideLinesCache[glTop].Line;
CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]); end else begin
if CRect.Top=FRealTop then begin Result:=false;
ALine.Top:=FRealTop; if FCustomForm=nil then exit;
ALine.Bottom:=ALine.Top; for i:=0 to FCustomForm.ComponentCount-1 do begin
LineLeft:=Min(Min(Min(FRealLeft, if IsSelected(FCustomForm.Components[i]) then continue;
FRealLeft+FRealWidth), CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]);
CRect.Left), if CRect.Top=FRealTop then begin
CRect.Right); ALine.Top:=FRealTop;
LineRight:=Max(Max(Max(FRealLeft, ALine.Bottom:=ALine.Top;
FRealLeft+FRealWidth), LineLeft:=Min(Min(Min(FRealLeft,
CRect.Left), FRealLeft+FRealWidth),
CRect.Right); CRect.Left),
if Result then begin CRect.Right);
LineLeft:=Min(ALine.Left,LineLeft); LineRight:=Max(Max(Max(FRealLeft,
LineRight:=Max(ALine.Right,LineRight); FRealLeft+FRealWidth),
end else CRect.Left),
Result:=true; CRect.Right);
ALine.Left:=LineLeft; if Result then begin
ALine.Right:=LineRight; LineLeft:=Min(ALine.Left,LineLeft);
LineRight:=Max(ALine.Right,LineRight);
end else
Result:=true;
ALine.Left:=LineLeft;
ALine.Right:=LineRight;
end;
end;
if CacheGuideLines then begin
FGuideLinesCache[glTop].LineValid:=Result;
FGuideLinesCache[glTop].Line:=ALine;
FGuideLinesCache[glTop].CacheValid:=true;
end; end;
end; end;
end; end;
@ -1008,33 +1102,52 @@ function TControlSelection.GetBottomGuideLine(var ALine: TRect): boolean;
var i, LineLeft, LineRight: integer; var i, LineLeft, LineRight: integer;
CRect: TRect; CRect: TRect;
begin begin
Result:=false; if CacheGuideLines and FGuideLinesCache[glBottom].CacheValid then begin
if FCustomForm=nil then exit; Result:=FGuideLinesCache[glBottom].LineValid;
for i:=0 to FCustomForm.ComponentCount-1 do begin if Result then
if IsSelected(FCustomForm.Components[i]) then continue; ALine:=FGuideLinesCache[glBottom].Line;
CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]); end else begin
if CRect.Bottom=FRealTop+FRealHeight then begin Result:=false;
ALine.Top:=CRect.Bottom; if FCustomForm=nil then exit;
ALine.Bottom:=ALine.Top; for i:=0 to FCustomForm.ComponentCount-1 do begin
LineLeft:=Min(Min(Min(FRealLeft, if IsSelected(FCustomForm.Components[i]) then continue;
FRealLeft+FRealWidth), CRect:=GetParentFormRelativeBounds(FCustomForm.Components[i]);
CRect.Left), if CRect.Bottom=FRealTop+FRealHeight then begin
CRect.Right); ALine.Top:=CRect.Bottom;
LineRight:=Max(Max(Max(FRealLeft, ALine.Bottom:=ALine.Top;
FRealLeft+FRealWidth), LineLeft:=Min(Min(Min(FRealLeft,
CRect.Left), FRealLeft+FRealWidth),
CRect.Right); CRect.Left),
if Result then begin CRect.Right);
LineLeft:=Min(ALine.Left,LineLeft); LineRight:=Max(Max(Max(FRealLeft,
LineRight:=Max(ALine.Right,LineRight); FRealLeft+FRealWidth),
end else CRect.Left),
Result:=true; CRect.Right);
ALine.Left:=LineLeft; if Result then begin
ALine.Right:=LineRight; LineLeft:=Min(ALine.Left,LineLeft);
LineRight:=Max(ALine.Right,LineRight);
end else
Result:=true;
ALine.Left:=LineLeft;
ALine.Right:=LineRight;
end;
end;
if CacheGuideLines then begin
FGuideLinesCache[glBottom].LineValid:=Result;
FGuideLinesCache[glBottom].Line:=ALine;
FGuideLinesCache[glBottom].CacheValid:=true;
end; end;
end; end;
end; end;
procedure TControlSelection.InvalidGuideLinesCache;
var
t: TGuideLineType;
begin
for t:=Low(TGuideLineType) to High(TGuideLineType) do
FGuideLinesCache[t].CacheValid:=false;
end;
procedure TControlSelection.FindNearestGridX(var NearestInt: TNearestInt); procedure TControlSelection.FindNearestGridX(var NearestInt: TNearestInt);
var GridSizeX, NearestGridX: integer; var GridSizeX, NearestGridX: integer;
begin begin