mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 16:19:36 +02:00
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
parent
c7463d7343
commit
80c3026e14
@ -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);
|
||||
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]);
|
||||
|
||||
@ -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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -4882,15 +4881,15 @@ 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;
|
||||
function TWinControl.ControlAtPos(const Pos: TPoint;
|
||||
AllowDisabled, AllowWinControls: Boolean): TControl;
|
||||
var
|
||||
Flags: TControlAtPosFlags;
|
||||
begin
|
||||
Flags:=[capfOnlyClientAreas];
|
||||
if AllowDisabled then Include(Flags,capfAllowDisabled);
|
||||
if AllowWinControls then Include(Flags,capfAllowWinControls);
|
||||
Result := ControlAtPos(Pos,Flags);
|
||||
Flags := [capfOnlyClientAreas];
|
||||
if AllowDisabled then Include(Flags, capfAllowDisabled);
|
||||
if AllowWinControls then Include(Flags, capfAllowWinControls);
|
||||
Result := ControlAtPos(Pos, Flags);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -4920,15 +4919,16 @@ var
|
||||
// MG: Delphi checks for PtInRect(ClientRect,P). But the client area is
|
||||
// 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
|
||||
ControlClientBounds:=GetChildsRect(false);
|
||||
Result:=PtInRect(ControlClientBounds,ControlPos);
|
||||
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
|
||||
ControlClientBounds := GetChildsRect(false);
|
||||
Result:=PtInRect(ControlClientBounds, ControlPos);
|
||||
end;
|
||||
|
||||
Result:= Result
|
||||
Result := Result
|
||||
and (
|
||||
(
|
||||
(csDesigning in ComponentState)
|
||||
@ -4972,8 +4972,8 @@ begin
|
||||
//debugln(['TWinControl.ControlAtPos START ',DbgSName(Self),' P=',dbgs(Pos)]);
|
||||
|
||||
// check if Pos in visible client area
|
||||
ClientBounds:=GetClientRect;
|
||||
ScrolledOffset:=GetClientScrollOffset;
|
||||
ClientBounds := GetClientRect;
|
||||
ScrolledOffset := GetClientScrollOffset;
|
||||
if capfHasScrollOffset in Flags then
|
||||
begin
|
||||
{ ClientBounds do not include scrolling offset }
|
||||
@ -4983,17 +4983,19 @@ 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;
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// map Pos to logical client area
|
||||
P:=Pos;
|
||||
if not (capfHasScrollOffset in Flags) then begin
|
||||
inc(P.X,ScrolledOffset.X);
|
||||
inc(P.Y,ScrolledOffset.Y);
|
||||
P := Pos;
|
||||
if not (capfHasScrollOffset in Flags) then
|
||||
begin
|
||||
inc(P.X, ScrolledOffset.X);
|
||||
inc(P.Y, ScrolledOffset.Y);
|
||||
end;
|
||||
|
||||
LControl := nil;
|
||||
@ -5015,17 +5017,18 @@ begin
|
||||
Result := LControl;
|
||||
|
||||
// check recursive sub childs
|
||||
if (capfRecursive in Flags) and (Result is TWinControl)
|
||||
and (TWinControl(Result).ControlCount>0) then begin
|
||||
OldClientOrigin:=ClientOrigin;
|
||||
NewClientOrigin:=TWinControl(Result).ClientOrigin;
|
||||
NewPos:=Pos;
|
||||
NewPos.X:=NewPos.X-NewClientOrigin.X+OldClientOrigin.X;
|
||||
NewPos.Y:=NewPos.Y-NewClientOrigin.Y+OldClientOrigin.Y;
|
||||
LControl:=TWinControl(Result).ControlAtPos(NewPos,Flags-[capfHasScrollOffset]);
|
||||
if (capfRecursive in Flags) and (Result is TWinControl) and
|
||||
(TWinControl(Result).ControlCount > 0) then
|
||||
begin
|
||||
OldClientOrigin := ClientOrigin;
|
||||
NewClientOrigin := TWinControl(Result).ClientOrigin;
|
||||
NewPos := Pos;
|
||||
NewPos.X := NewPos.X - NewClientOrigin.X + OldClientOrigin.X;
|
||||
NewPos.Y := NewPos.Y - NewClientOrigin.Y + OldClientOrigin.Y;
|
||||
LControl := TWinControl(Result).ControlAtPos(NewPos, Flags - [capfHasScrollOffset]);
|
||||
//debugln(['TWinControl.RECURSED ControlAtPos Result=',DbgSName(Result),' LControl=',DbgSName(LControl),' ',dbgs(NewPos),' AllowDisabled=',AllowDisabled,' OnlyClientAreas=',OnlyClientAreas]);
|
||||
if LControl<>nil then
|
||||
Result:=LControl;
|
||||
if LControl <> nil then
|
||||
Result := LControl;
|
||||
end;
|
||||
//debugln(['TWinControl.ControlAtPos END ',DbgSName(Self),' P=',dbgs(Pos),' Result=',DbgSName(Result)]);
|
||||
end;
|
||||
@ -5037,10 +5040,10 @@ end;
|
||||
-------------------------------------------------------------------------------}
|
||||
function TWinControl.GetControlIndex(AControl: TControl): integer;
|
||||
begin
|
||||
if FControls<>nil then
|
||||
Result:=FControls.IndexOf(AControl)
|
||||
if FControls <> nil then
|
||||
Result := FControls.IndexOf(AControl)
|
||||
else
|
||||
Result:=-1;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
@ -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;
|
||||
|
||||
@ -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';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user