MG: accelerated calculating guidelines

git-svn-id: trunk@3468 -

components/codetools/laz_xmlread.pas

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

designer/controlselection.pp

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