View Issue Details

IDProjectCategoryView StatusLast Update
0034415LazarusLCLpublic2018-10-14 20:07
ReporterSerge AnvarovAssigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version2.1 (SVN)Product Buildr59294 
Target VersionFixed in Version 
Summary0034415: Optimize raise exception in WinControls.inc
DescriptionContinue 0034362 issue

Because creating an exception is a rare case and calling "raise Exception.Create(...)" creates a large call context (that is, a lot of code is always called, and rarely used), it is better to put the raise exception code to a separate local procedure

Also some messages are made more descriptive
TagsNo tags attached.
Fixed in Revision
LazTarget
Widgetset
Attached Files
  • WinControls.diff (12,505 bytes)
    Index: lcl/include/wincontrol.inc
    ===================================================================
    --- lcl/include/wincontrol.inc	(revision 59294)
    +++ lcl/include/wincontrol.inc	(working copy)
    @@ -436,6 +436,11 @@
         crFixedCircled
         );
     
    +  procedure RaiseComputePositionsError(const ErrorMsg: string);
    +  begin
    +    raise ELayoutException.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition ' + ErrorMsg);
    +  end;
    +
       function ComputePosition(ChildData: TAutoSizeCtrlData; Side: TAnchorKind;
         Direction: TAutoSizeSideDistDirection): TComputeResult;
       var
    @@ -462,7 +467,7 @@
           exit(crCircle); // there is a circle
         end;
         if ChildData.Sides[Side].DistanceState[Direction]<>assdfInvalid then
    -      raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition <>assdfInvalid');
    +      RaiseComputePositionsError('<> assdfInvalid');
           
         // mark as computing
         ChildData.Sides[Side].DistanceState[Direction]:=assdfComputing;
    @@ -693,7 +698,7 @@
                 end;
               assdfUncomputable: ; // no problem, there is already a value
               else
    -            raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
    +            RaiseComputePositionsError('assdfValid,assdfUncomputable');
               end;
             end;
           end;
    @@ -723,7 +728,7 @@
           assdfUncomputable:
             ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable;
           else
    -        raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
    +        RaiseComputePositionsError('assdfValid,assdfUncomputable');
           end;
         end else begin
           // not anchored
    @@ -742,7 +747,7 @@
           {$IFNDEF DisableChecks}
           DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' Direction=',AutoSizeSideDistDirectionNames[Direction]]);
           {$ENDIF}
    -      raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
    +      RaiseComputePositionsError('assdfValid,assdfUncomputable');
         end;
         Result:=crSuccess;
       end;
    @@ -1515,6 +1520,12 @@
     
     procedure TAutoSizeBox.SetTableControls(ListOfControls: TFPList;
       ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode);
    +
    +  procedure RaiseUnsupportedLayoutError;
    +  begin
    +    raise ENotImplemented.CreateFmt('TAutoSizeBox.SetTableControls: ChildSizing.Layout Ord=%d is unsupported ', [Ord(ChildSizing.Layout)]);
    +  end;
    +
     var
       i: Integer;
       Row: LongInt;
    @@ -1538,7 +1549,7 @@
           ColCount:=((ListOfControls.Count-1) div RowCount)+1;
         end;
       else
    -    raise Exception.Create('TAutoSizeBox.SetTableControls TODO');
    +    RaiseUnsupportedLayoutError;
       end;
       AllocateTable(ColCount,RowCount);
     
    @@ -1780,7 +1791,12 @@
           inc(Result,s);
         end;
       end;
    -  
    +
    +  procedure RaiseUnsupportedResizeStyle(Style: TChildControlResizeStyle);
    +  begin
    +    raise ENotImplemented.CreateFmt('TAutoSizeBox.ResizeChilds: TChildControlResizeStyle Ord=%d is unsupported', [Ord(Style)]);
    +  end;
    +
       procedure GetChildMaxResize(out Factor: TResizeFactor;
         out ResizeableCount: integer);
       // returns the number of children/gaps, that can grow (ResizeableCount)
    @@ -1810,27 +1826,19 @@
               continue;
             end;
             inc(ResizeableCount);
    -
    -        case EnlargeStyle of
    -
    -        crsScaleChilds, crsHomogenousChildResize:
    -          begin
    -            if Child.MaximumSize[Orientation]=0 then begin
    -              CurScale:=double(TargetSize);
    -              CurOffset:=TargetSize;
    -            end else begin
    -              CurScale:=double(Child.MaximumSize[Orientation])
    -                          /Child.PreferredSize[Orientation];
    -              CurOffset:=Child.MaximumSize[Orientation]
    -                         -Child.PreferredSize[Orientation];
    -            end;
    -            if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
    -              Factor.Scale:=CurScale;
    -              Factor.Offset:=CurOffset;
    -            end;
    -          end;
    -
    +        if Child.MaximumSize[Orientation]=0 then begin
    +          CurScale:=double(TargetSize);
    +          CurOffset:=TargetSize;
    +        end else begin
    +          CurScale:=double(Child.MaximumSize[Orientation])
    +                      /Child.PreferredSize[Orientation];
    +          CurOffset:=Child.MaximumSize[Orientation]
    +                     -Child.PreferredSize[Orientation];
             end;
    +        if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
    +          Factor.Scale:=CurScale;
    +          Factor.Offset:=CurOffset;
    +        end;
           end;
           
         crsHomogenousSpaceResize:
    @@ -1841,8 +1849,7 @@
           end;
     
         else
    -      raise Exception.Create('TAutoSizeBox.ResizeChilds');
    -      
    +      RaiseUnsupportedResizeStyle(EnlargeStyle);
         end;
       end;
       
    @@ -1941,32 +1948,25 @@
             end;
             inc(ResizeableCount);
     
    +        CurScale:=double(Child.MinimumSize[Orientation])
    +                  /Child.PreferredSize[Orientation];
    +        CurOffset:=Child.PreferredSize[Orientation]
    +                   -Child.MinimumSize[Orientation];
             case ShrinkStyle of
    -
             crsScaleChilds:
               begin
    -            CurScale:=double(Child.MinimumSize[Orientation])
    -                      /Child.PreferredSize[Orientation];
    -            CurOffset:=Child.PreferredSize[Orientation]
    -                       -Child.MinimumSize[Orientation];
                 if (Factor.Offset=0) or (Factor.Scale<CurScale) then begin
                   Factor.Scale:=CurScale;
                   Factor.Offset:=CurOffset;
                 end;
               end;
    -
             crsHomogenousChildResize:
               begin
    -            CurScale:=double(Child.MinimumSize[Orientation])
    -                      /Child.PreferredSize[Orientation];
    -            CurOffset:=Child.PreferredSize[Orientation]
    -                       -Child.MinimumSize[Orientation];
                 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
                   Factor.Scale:=CurScale;
                   Factor.Offset:=CurOffset;
                 end;
               end;
    -
             end;
           end;
     
    @@ -1996,8 +1996,7 @@
           end;
     
         else
    -      raise Exception.Create('TAutoSizeBox.ResizeChilds');
    -
    +      RaiseUnsupportedResizeStyle(ShrinkStyle)
         end;
       end;
     
    @@ -4314,6 +4313,12 @@
       VCL behaviour and has no real effect.
     -------------------------------------------------------------------------------}
     procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
    +
    +  procedure RaiseLayoutError(const Error: string; Param1, Param2: Integer);
    +  begin
    +    raise ELayoutException.CreateFmt(Error, [Name, '.SendMoveSizeMessages:', Param1, Param2]);
    +  end;
    +
     var
       SizeMsg : TLMSize;
       MoveMsg : TLMMove;
    @@ -4332,8 +4337,7 @@
           SizeType := 6; // force realign
           if (FWidth  < Low(Word)) or (FWidth  > High(Word))
           or (FHeight < Low(Word)) or (FHeight > High(Word)) then
    -        raise ELayoutException.CreateFmt('Size range overflow in %s.SendMoveSizeMessages:'
    -                                 +' Width=%d, Height=%d.', [Name, FWidth, FHeight]);
    +        RaiseLayoutError('Size range overflow in %s%s Width=%d, Height=%d.', FWidth, FHeight);
           Width := FWidth;
           Height := FHeight;
           {$IFDEF CHECK_POSITION}
    @@ -4352,8 +4356,7 @@
           MoveType:= 1;
           if (FLeft < Low(Smallint)) or (FLeft > High(Smallint))
           or (FTop  < Low(Smallint)) or (FTop  > High(Smallint)) then
    -        raise ELayoutException.CreateFmt('Position range overflow in %s.SendMoveSizeMessages:'
    -                                 +' Left=%d, Top=%d.', [Name, FLeft, FTop]);
    +        RaiseLayoutError('Position range overflow in %s%s Left=%d, Top=%d.', FLeft, FTop);
           XPos := FLeft;
           YPos := FTop;
           {$IFDEF CHECK_POSITION}
    @@ -6152,13 +6155,19 @@
       procedure TWinControl.Insert(AControl: TControl; Index: integer);
     ------------------------------------------------------------------------------}
     procedure TWinControl.Insert(AControl: TControl; Index: integer);
    +
    +  procedure RaiseInvalidOperation(const Error: string);
    +  begin
    +    raise EInvalidOperation.Create(Error);
    +  end;
    +
     begin
       if AControl = nil then exit;
       if AControl.FParent<>nil then
    -    raise EInvalidOperation.Create('control has already a parent');
    +    RaiseInvalidOperation('control has already a parent');
       
       if AControl = Self then
    -    raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent);
    +    RaiseInvalidOperation(rsAControlCanNotHaveItselfAsParent);
     
       ListInsert(FControls, Index, AControl);
       if AControl is TWinControl then
    @@ -6190,11 +6199,16 @@
     end;
     
     procedure TWinControl.ScrollBy_WS(DeltaX, DeltaY: Integer);
    +
    +  procedure Error;
    +  begin
    +    raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated');
    +  end;
    +
     begin
    -  if HandleAllocated then
    -    TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY)
    -  else
    -    raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated');
    +  if not HandleAllocated then
    +    Error;
    +  TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
     end;
     
     procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
    @@ -7469,6 +7483,12 @@
       Creates the interface object and assigns the handle
      ------------------------------------------------------------------------------}
     procedure TWinControl.CreateWnd;
    +
    +  procedure RaiseControlHasNoParentWindow(const AName: string);
    +  begin
    +    raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [AName]);
    +  end;
    +
     var
       Params: TCreateParams;
       i: Integer;
    @@ -7543,7 +7563,7 @@
             if (WndParent = 0) and (Style and WS_CHILD <> 0) then
             begin
               DebugLn(['TWinControl.CreateWnd ',DbgSName(Self),' Parent=',DbgSName(Parent),' ERROR WndParent=0']);
    -          raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]);
    +          RaiseControlHasNoParentWindow(Name);
             end;
           end;
     
    @@ -7945,10 +7965,16 @@
       decreases the BoundsLockCount
      ------------------------------------------------------------------------------}
     procedure TWinControl.EndUpdateBounds;
    +
    +  procedure ErrorTooManyCalls;
    +  begin
    +    raise ELayoutException.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.',
    +                                     [DbgSName(Self)]);
    +  end;
    +
     begin
       if FBoundsLockCount <= 0 then
    -    raise ELayoutException.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.',
    -                                     [DbgSName(Self)]);
    +    ErrorTooManyCalls;
       dec(FBoundsLockCount);
       if FBoundsLockCount = 0 then
         SetBounds(Left, Top, Width, Height);
    @@ -8106,16 +8132,20 @@
      ------------------------------------------------------------------------------}
     procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
     
    +  procedure RaiseSetBoundsError(const What: string; Value: Integer);
    +  begin
    +    raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): %s %d not allowed.',
    +                                     [DbgSName(Self), What, Value]);
    +  end;
    +
       procedure CheckDesignBounds;
       begin
         if FRealizeBoundsLockCount > 0 then Exit;
         // the user changed the bounds
         if AWidth < 0 then
    -      raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative width %d not allowed.',
    -                                       [DbgSName(Self), AWidth]);
    +      RaiseSetBoundsError('Negative width', AWidth);
         if AHeight < 0 then
    -      raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative height %d not allowed.',
    -                                       [DbgSName(Self), AHeight]);
    +      RaiseSetBoundsError('Negative height', AHeight);
       end;
     
     var
    @@ -8368,12 +8398,17 @@
       Get the devicecontext for this WinControl.
      ------------------------------------------------------------------------------}
     function TWinControl.GetDeviceContext(var WindowHandle: HWND): HDC;
    +
    +  procedure RaiseErrorCreatingDeviceContext;
    +  begin
    +    raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]);
    +  end;
    +
     begin
       Result := GetDC(Handle);
       //DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',DbgS(Result,8),' Handle=',DbgS(FHandle));
       if Result = 0 then
    -     raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]);
    -
    +    RaiseErrorCreatingDeviceContext;
       WindowHandle := Handle;
     end;
     
    
    WinControls.diff (12,505 bytes)

Relationships

related to 0034362 resolvedJuha Manninen [patch] Raise a specialized exception if move/size loop is detected 

Activities

Serge Anvarov

2018-10-14 10:27

reporter  

WinControls.diff (12,505 bytes)
Index: lcl/include/wincontrol.inc
===================================================================
--- lcl/include/wincontrol.inc	(revision 59294)
+++ lcl/include/wincontrol.inc	(working copy)
@@ -436,6 +436,11 @@
     crFixedCircled
     );
 
+  procedure RaiseComputePositionsError(const ErrorMsg: string);
+  begin
+    raise ELayoutException.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition ' + ErrorMsg);
+  end;
+
   function ComputePosition(ChildData: TAutoSizeCtrlData; Side: TAnchorKind;
     Direction: TAutoSizeSideDistDirection): TComputeResult;
   var
@@ -462,7 +467,7 @@
       exit(crCircle); // there is a circle
     end;
     if ChildData.Sides[Side].DistanceState[Direction]<>assdfInvalid then
-      raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition <>assdfInvalid');
+      RaiseComputePositionsError('<> assdfInvalid');
       
     // mark as computing
     ChildData.Sides[Side].DistanceState[Direction]:=assdfComputing;
@@ -693,7 +698,7 @@
             end;
           assdfUncomputable: ; // no problem, there is already a value
           else
-            raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
+            RaiseComputePositionsError('assdfValid,assdfUncomputable');
           end;
         end;
       end;
@@ -723,7 +728,7 @@
       assdfUncomputable:
         ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable;
       else
-        raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
+        RaiseComputePositionsError('assdfValid,assdfUncomputable');
       end;
     end else begin
       // not anchored
@@ -742,7 +747,7 @@
       {$IFNDEF DisableChecks}
       DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' Direction=',AutoSizeSideDistDirectionNames[Direction]]);
       {$ENDIF}
-      raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable');
+      RaiseComputePositionsError('assdfValid,assdfUncomputable');
     end;
     Result:=crSuccess;
   end;
@@ -1515,6 +1520,12 @@
 
 procedure TAutoSizeBox.SetTableControls(ListOfControls: TFPList;
   ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode);
+
+  procedure RaiseUnsupportedLayoutError;
+  begin
+    raise ENotImplemented.CreateFmt('TAutoSizeBox.SetTableControls: ChildSizing.Layout Ord=%d is unsupported ', [Ord(ChildSizing.Layout)]);
+  end;
+
 var
   i: Integer;
   Row: LongInt;
@@ -1538,7 +1549,7 @@
       ColCount:=((ListOfControls.Count-1) div RowCount)+1;
     end;
   else
-    raise Exception.Create('TAutoSizeBox.SetTableControls TODO');
+    RaiseUnsupportedLayoutError;
   end;
   AllocateTable(ColCount,RowCount);
 
@@ -1780,7 +1791,12 @@
       inc(Result,s);
     end;
   end;
-  
+
+  procedure RaiseUnsupportedResizeStyle(Style: TChildControlResizeStyle);
+  begin
+    raise ENotImplemented.CreateFmt('TAutoSizeBox.ResizeChilds: TChildControlResizeStyle Ord=%d is unsupported', [Ord(Style)]);
+  end;
+
   procedure GetChildMaxResize(out Factor: TResizeFactor;
     out ResizeableCount: integer);
   // returns the number of children/gaps, that can grow (ResizeableCount)
@@ -1810,27 +1826,19 @@
           continue;
         end;
         inc(ResizeableCount);
-
-        case EnlargeStyle of
-
-        crsScaleChilds, crsHomogenousChildResize:
-          begin
-            if Child.MaximumSize[Orientation]=0 then begin
-              CurScale:=double(TargetSize);
-              CurOffset:=TargetSize;
-            end else begin
-              CurScale:=double(Child.MaximumSize[Orientation])
-                          /Child.PreferredSize[Orientation];
-              CurOffset:=Child.MaximumSize[Orientation]
-                         -Child.PreferredSize[Orientation];
-            end;
-            if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
-              Factor.Scale:=CurScale;
-              Factor.Offset:=CurOffset;
-            end;
-          end;
-
+        if Child.MaximumSize[Orientation]=0 then begin
+          CurScale:=double(TargetSize);
+          CurOffset:=TargetSize;
+        end else begin
+          CurScale:=double(Child.MaximumSize[Orientation])
+                      /Child.PreferredSize[Orientation];
+          CurOffset:=Child.MaximumSize[Orientation]
+                     -Child.PreferredSize[Orientation];
         end;
+        if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
+          Factor.Scale:=CurScale;
+          Factor.Offset:=CurOffset;
+        end;
       end;
       
     crsHomogenousSpaceResize:
@@ -1841,8 +1849,7 @@
       end;
 
     else
-      raise Exception.Create('TAutoSizeBox.ResizeChilds');
-      
+      RaiseUnsupportedResizeStyle(EnlargeStyle);
     end;
   end;
   
@@ -1941,32 +1948,25 @@
         end;
         inc(ResizeableCount);
 
+        CurScale:=double(Child.MinimumSize[Orientation])
+                  /Child.PreferredSize[Orientation];
+        CurOffset:=Child.PreferredSize[Orientation]
+                   -Child.MinimumSize[Orientation];
         case ShrinkStyle of
-
         crsScaleChilds:
           begin
-            CurScale:=double(Child.MinimumSize[Orientation])
-                      /Child.PreferredSize[Orientation];
-            CurOffset:=Child.PreferredSize[Orientation]
-                       -Child.MinimumSize[Orientation];
             if (Factor.Offset=0) or (Factor.Scale<CurScale) then begin
               Factor.Scale:=CurScale;
               Factor.Offset:=CurOffset;
             end;
           end;
-
         crsHomogenousChildResize:
           begin
-            CurScale:=double(Child.MinimumSize[Orientation])
-                      /Child.PreferredSize[Orientation];
-            CurOffset:=Child.PreferredSize[Orientation]
-                       -Child.MinimumSize[Orientation];
             if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin
               Factor.Scale:=CurScale;
               Factor.Offset:=CurOffset;
             end;
           end;
-
         end;
       end;
 
@@ -1996,8 +1996,7 @@
       end;
 
     else
-      raise Exception.Create('TAutoSizeBox.ResizeChilds');
-
+      RaiseUnsupportedResizeStyle(ShrinkStyle)
     end;
   end;
 
@@ -4314,6 +4313,12 @@
   VCL behaviour and has no real effect.
 -------------------------------------------------------------------------------}
 procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
+
+  procedure RaiseLayoutError(const Error: string; Param1, Param2: Integer);
+  begin
+    raise ELayoutException.CreateFmt(Error, [Name, '.SendMoveSizeMessages:', Param1, Param2]);
+  end;
+
 var
   SizeMsg : TLMSize;
   MoveMsg : TLMMove;
@@ -4332,8 +4337,7 @@
       SizeType := 6; // force realign
       if (FWidth  < Low(Word)) or (FWidth  > High(Word))
       or (FHeight < Low(Word)) or (FHeight > High(Word)) then
-        raise ELayoutException.CreateFmt('Size range overflow in %s.SendMoveSizeMessages:'
-                                 +' Width=%d, Height=%d.', [Name, FWidth, FHeight]);
+        RaiseLayoutError('Size range overflow in %s%s Width=%d, Height=%d.', FWidth, FHeight);
       Width := FWidth;
       Height := FHeight;
       {$IFDEF CHECK_POSITION}
@@ -4352,8 +4356,7 @@
       MoveType:= 1;
       if (FLeft < Low(Smallint)) or (FLeft > High(Smallint))
       or (FTop  < Low(Smallint)) or (FTop  > High(Smallint)) then
-        raise ELayoutException.CreateFmt('Position range overflow in %s.SendMoveSizeMessages:'
-                                 +' Left=%d, Top=%d.', [Name, FLeft, FTop]);
+        RaiseLayoutError('Position range overflow in %s%s Left=%d, Top=%d.', FLeft, FTop);
       XPos := FLeft;
       YPos := FTop;
       {$IFDEF CHECK_POSITION}
@@ -6152,13 +6155,19 @@
   procedure TWinControl.Insert(AControl: TControl; Index: integer);
 ------------------------------------------------------------------------------}
 procedure TWinControl.Insert(AControl: TControl; Index: integer);
+
+  procedure RaiseInvalidOperation(const Error: string);
+  begin
+    raise EInvalidOperation.Create(Error);
+  end;
+
 begin
   if AControl = nil then exit;
   if AControl.FParent<>nil then
-    raise EInvalidOperation.Create('control has already a parent');
+    RaiseInvalidOperation('control has already a parent');
   
   if AControl = Self then
-    raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent);
+    RaiseInvalidOperation(rsAControlCanNotHaveItselfAsParent);
 
   ListInsert(FControls, Index, AControl);
   if AControl is TWinControl then
@@ -6190,11 +6199,16 @@
 end;
 
 procedure TWinControl.ScrollBy_WS(DeltaX, DeltaY: Integer);
+
+  procedure Error;
+  begin
+    raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated');
+  end;
+
 begin
-  if HandleAllocated then
-    TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY)
-  else
-    raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated');
+  if not HandleAllocated then
+    Error;
+  TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
 end;
 
 procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
@@ -7469,6 +7483,12 @@
   Creates the interface object and assigns the handle
  ------------------------------------------------------------------------------}
 procedure TWinControl.CreateWnd;
+
+  procedure RaiseControlHasNoParentWindow(const AName: string);
+  begin
+    raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [AName]);
+  end;
+
 var
   Params: TCreateParams;
   i: Integer;
@@ -7543,7 +7563,7 @@
         if (WndParent = 0) and (Style and WS_CHILD <> 0) then
         begin
           DebugLn(['TWinControl.CreateWnd ',DbgSName(Self),' Parent=',DbgSName(Parent),' ERROR WndParent=0']);
-          raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]);
+          RaiseControlHasNoParentWindow(Name);
         end;
       end;
 
@@ -7945,10 +7965,16 @@
   decreases the BoundsLockCount
  ------------------------------------------------------------------------------}
 procedure TWinControl.EndUpdateBounds;
+
+  procedure ErrorTooManyCalls;
+  begin
+    raise ELayoutException.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.',
+                                     [DbgSName(Self)]);
+  end;
+
 begin
   if FBoundsLockCount <= 0 then
-    raise ELayoutException.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.',
-                                     [DbgSName(Self)]);
+    ErrorTooManyCalls;
   dec(FBoundsLockCount);
   if FBoundsLockCount = 0 then
     SetBounds(Left, Top, Width, Height);
@@ -8106,16 +8132,20 @@
  ------------------------------------------------------------------------------}
 procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
 
+  procedure RaiseSetBoundsError(const What: string; Value: Integer);
+  begin
+    raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): %s %d not allowed.',
+                                     [DbgSName(Self), What, Value]);
+  end;
+
   procedure CheckDesignBounds;
   begin
     if FRealizeBoundsLockCount > 0 then Exit;
     // the user changed the bounds
     if AWidth < 0 then
-      raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative width %d not allowed.',
-                                       [DbgSName(Self), AWidth]);
+      RaiseSetBoundsError('Negative width', AWidth);
     if AHeight < 0 then
-      raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative height %d not allowed.',
-                                       [DbgSName(Self), AHeight]);
+      RaiseSetBoundsError('Negative height', AHeight);
   end;
 
 var
@@ -8368,12 +8398,17 @@
   Get the devicecontext for this WinControl.
  ------------------------------------------------------------------------------}
 function TWinControl.GetDeviceContext(var WindowHandle: HWND): HDC;
+
+  procedure RaiseErrorCreatingDeviceContext;
+  begin
+    raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]);
+  end;
+
 begin
   Result := GetDC(Handle);
   //DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',DbgS(Result,8),' Handle=',DbgS(FHandle));
   if Result = 0 then
-     raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]);
-
+    RaiseErrorCreatingDeviceContext;
   WindowHandle := Handle;
 end;
 
WinControls.diff (12,505 bytes)

Issue History

Date Modified Username Field Change
2018-10-14 10:27 Serge Anvarov New Issue
2018-10-14 10:27 Serge Anvarov File Added: WinControls.diff
2018-10-14 20:07 Juha Manninen Relationship added related to 0034362