lcl: formatting, move some exception texts to lclstrconsts, use EInvliadOperation instead Exception class for raising various controls related exceptions

git-svn-id: trunk@26659 -
This commit is contained in:
paul 2010-07-15 03:37:24 +00:00
parent c7463d7343
commit 80c3026e14
3 changed files with 62 additions and 74 deletions

View File

@ -1013,22 +1013,12 @@ end;
TControl.GetClientOrigin
------------------------------------------------------------------------------}
function TControl.GetClientOrigin: TPoint;
procedure RaiseParentNil;
begin
raise Exception.Create('TControl.GetClientOrigin: Parent=nil for '
+Name+':'+ClassName);
end;
begin
//Assert(False, Format('Trace:[TControl.GetClientOrigin] %s', [Classname]));
if Parent = nil then
RaiseParentNil;
//raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]);
Result := Parent.ClientOrigin;
Inc(Result.X, FLeft);
Inc(Result.Y, FTop);
//Assert(False, Format('Trace:[TControl.GetClientOrigin] %s --> (%d, %d)', [Classname, Result.X, Result.Y]));
end;
{------------------------------------------------------------------------------
@ -2269,18 +2259,11 @@ end;
Checks if this control can be the parent of a control of class ChildClass.
------------------------------------------------------------------------------}
function TControl.CheckChildClassAllowed(ChildClass: TClass;
ExceptionOnInvalid: boolean): boolean;
procedure RaiseInvalidChild;
begin
raise Exception.Create(ClassName+' can not have '+ChildClass.ClassName+' as child');
end;
function TControl.CheckChildClassAllowed(ChildClass: TClass; ExceptionOnInvalid: boolean): boolean;
begin
Result := ChildClassAllowed(ChildClass);
if (not Result) and ExceptionOnInvalid then
RaiseInvalidChild;
raise EInvalidOperation.CreateFmt(rsControlClassCantContainChildClass, [ClassName, ChildClass.ClassName]);
end;
{------------------------------------------------------------------------------
@ -2291,10 +2274,10 @@ end;
------------------------------------------------------------------------------}
procedure TControl.CheckNewParent(AParent: TWinControl);
begin
if (AParent<>nil) then AParent.CheckChildClassAllowed(ClassType,true);
if AParent = Self then begin
raise EInvalidOperation.Create('A control can not have itself as parent');
end;
if (AParent <> nil) then
AParent.CheckChildClassAllowed(ClassType, True);
if AParent = Self then
raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent);
end;
{------------------------------------------------------------------------------
@ -2396,7 +2379,8 @@ procedure TControl.DoAllAutoSize;
end;
begin
if Parent <> nil then raise Exception.Create('TControl.DoAllAutoSize Parent<>nil');
if Parent <> nil then
raise EInvalidOperation.Create('TControl.DoAllAutoSize Parent <> nil');
if AutoSizingAll then exit;
FAutoSizingAll := True;
if not (Self is TWinControl) then exit;
@ -3343,11 +3327,11 @@ procedure TControl.SetWidth(Value: Integer);
begin
// the user changed the width
if Value<0 then
raise Exception.Create(
raise EInvalidOperation.Create(
'TWinControl.SetBounds ('+DbgSName(Self)+'): Negative width '
+dbgs(Value)+' not allowed.');
if Value>=10000 then
raise Exception.Create(
raise EInvalidOperation.Create(
'TWinControl.SetBounds ('+DbgSName(Self)+'): Width '
+dbgs(Value)+' not allowed.');
end;
@ -3389,11 +3373,11 @@ procedure TControl.SetHeight(Value: Integer);
begin
// the user changed the height
if Value<0 then
raise Exception.Create(
raise EInvalidOperation.Create(
'TWinControl.SetHeight ('+DbgSName(Self)+'): Negative height '
+dbgs(Value)+' not allowed.');
if Value>=10000 then
raise Exception.Create(
raise EInvalidOperation.Create(
'TWinControl.SetBounds ('+DbgSName(Self)+'): Height '
+dbgs(Value)+' not allowed.');
end;
@ -4258,8 +4242,8 @@ end;
------------------------------------------------------------------------------}
function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
if Parent = nil
then raise EInvalidOperation.CreateFmt('Control ''%s'' has no parent window', [Name]);
if Parent = nil then
raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]);
Result := Parent.GetDeviceContext(WindowHandle);
MoveWindowOrgEx(Result, Left, Top);
@ -4749,7 +4733,7 @@ begin
{$ENDIF}
if FAutoSizingLockCount<=0 then
raise Exception.Create('TControl.EnableAutoSizing '+DbgSName(Self)+': missing DisableAutoSizing');
raise EInvalidOperation.Create('TControl.EnableAutoSizing '+DbgSName(Self)+': missing DisableAutoSizing');
dec(FAutoSizingLockCount);
//DebugLn([Space(FAutoSizingLockCount*2),'TControl.EnableAutoSizing ',DbgSName(Self),' ',FAutoSizingLockCount]);

View File

@ -4867,10 +4867,9 @@ end;
Searches a child (not grand child) control, which client area contains Pos.
Pos is relative to the ClientOrigin.
------------------------------------------------------------------------------}
function TWinControl.ControlAtPos(const Pos : TPoint;
AllowDisabled : Boolean): TControl;
function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl;
begin
Result := ControlAtPos(Pos,AllowDisabled,false);
Result := ControlAtPos(Pos, AllowDisabled, False);
end;
{------------------------------------------------------------------------------
@ -4921,9 +4920,10 @@ var
// not always at 0,0, so I guess this is a bug in the VCL.
ControlPos := Point(P.X - Left, P.Y - Top);
Result:=(ControlPos.X>=0) and (ControlPos.Y>=0)
and (ControlPos.X<Width) and (ControlPos.Y<Height);
if Result and (capfOnlyClientAreas in Flags) then begin
Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and
(ControlPos.X < Width) and (ControlPos.Y < Height);
if Result and (capfOnlyClientAreas in Flags) then
begin
ControlClientBounds := GetChildsRect(false);
Result:=PtInRect(ControlClientBounds, ControlPos);
end;
@ -4983,7 +4983,8 @@ begin
inc(ClientBounds.Bottom, ScrolledOffset.y);
end;
if not PtInRect(ClientBounds,Pos) then begin
if not PtInRect(ClientBounds, Pos) then
begin
//debugln(['TWinControl.ControlAtPos OUT OF CLIENTBOUNDS ',DbgSName(Self),' P=',dbgs(Pos),' ClientBounds=',dbgs(ClientBounds)]);
Result := nil;
exit;
@ -4991,7 +4992,8 @@ begin
// map Pos to logical client area
P := Pos;
if not (capfHasScrollOffset in Flags) then begin
if not (capfHasScrollOffset in Flags) then
begin
inc(P.X, ScrolledOffset.X);
inc(P.Y, ScrolledOffset.Y);
end;
@ -5015,8 +5017,9 @@ begin
Result := LControl;
// check recursive sub childs
if (capfRecursive in Flags) and (Result is TWinControl)
and (TWinControl(Result).ControlCount>0) then begin
if (capfRecursive in Flags) and (Result is TWinControl) and
(TWinControl(Result).ControlCount > 0) then
begin
OldClientOrigin := ClientOrigin;
NewClientOrigin := TWinControl(Result).ClientOrigin;
NewPos := Pos;
@ -7131,7 +7134,7 @@ begin
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('Control ''%s'' has no parent window', [Name]);
raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]);
end;
end;
@ -7891,9 +7894,8 @@ function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
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]);
if Result = 0 then
raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]);
WindowHandle := Handle;
end;

View File

@ -250,7 +250,9 @@ resourceString
rsGridIndexOutOfRange = 'Grid index out of range.';
rsERRORInLCL = 'ERROR in LCL: ';
rsCreatingGdbCatchableError = 'Creating gdb catchable error:';
rsAControlCanNotHaveItselfAsParent = 'A control can''t have itself as parent';
rsAControlCanNotHaveItselfAsParent = 'A control can''t have itself as a parent';
rsControlHasNoParentWindow = 'Control ''%s'' has no parent window';
rsControlClassCantContainChildClass = 'Control of class ''%s'' can''t have control of class ''%s'' as a child';
lisLCLResourceSNotFound = 'Resource %s not found';
rsErrorCreatingDeviceContext = 'Error creating device context for %s.%s';
rsIndexOutOfBounds = '%s Index %d out of bounds 0 .. %d';