paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Rename msg CM_IRREGULARSHAPEHITTEST->CM_MASKHITTEST and TShape.HitTest->TShape.PtInShape. Issue #40483.

Browse Source
This commit is contained in:
Juha 2023-09-11 09:22:29 +03:00
parent 6ae07c2413
commit e13451a5ab
4 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
designer/designer.pp
View File

@ -489,7 +489,7 @@ begin
exit;
if csNoDesignSelectable in Control.ControlStyle then
exit;
if Control.Perform(CM_IRREGULARSHAPEHITTEST,0,Longint(SmallPoint(AtPos.X, AtPos.Y)))>0 then
if Control.Perform(CM_MASKHITTEST,0,Longint(SmallPoint(AtPos.X, AtPos.Y)))>0 then
exit;
end
else

4
lcl/extctrls.pp
View File

@ -282,11 +282,11 @@ type
class procedure WSRegisterClass; override;
class function GetControlClassDefaultSize: TSize; override;
procedure Click; override;
procedure CMShapeHitTest(var Message: TCMHittest); message CM_IRREGULARSHAPEHITTEST;
procedure CMShapeHitTest(var Message: TCMHittest); message CM_MASKHITTEST;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function HitTest(const P: TPoint): Boolean;
function PtInShape(const P: TPoint): Boolean;
procedure Paint; override;
procedure StyleChanged(Sender: TObject);
published

2
lcl/include/controlconsts.inc
View File

@ -101,7 +101,7 @@ const
CM_TABLETOPTIONSCHANGED = CM_BASE + 87 unimplemented;
CM_PARENTTABLETOPTIONSCHANGED = CM_BASE + 88 unimplemented;
// implemented by controls with an irregular shape to check if a point belongs to a shape
CM_IRREGULARSHAPEHITTEST = CM_BASE + 89;
CM_MASKHITTEST = CM_BASE + 89;
// LCL only
CM_APPSHOWBTNGLYPHCHANGED = CM_BASE + CM_LCLOFFSET + 68;
CM_APPSHOWMENUGLYPHCHANGED = CM_BASE + CM_LCLOFFSET + 69;

14
lcl/include/shape.inc
View File

@ -30,7 +30,7 @@ begin
inherited Destroy;
end;
function TShape.HitTest(const P: TPoint): Boolean;
function TShape.PtInShape(const P: TPoint): Boolean;
// Return True if point P is inside the actual shape.
begin
Assert(Assigned(FBitmapCopy), 'FBitmapCopy=Nil');
@ -83,12 +83,12 @@ var
PCenter: TPoint;
begin
FBitmapCopy.SetSize(Width, Height);
FBitmapCopy.Canvas.Brush.Style:=bsSolid;
FBitmapCopy.Canvas.Brush.Color:=clWhite;
FBitmapCopy.Canvas.Brush.Style := bsSolid;
FBitmapCopy.Canvas.Brush.Color := clWhite;
FBitmapCopy.Canvas.FillRect(0,0,Width,Height);
FBitmapCopy.Canvas.Brush.Color:=clBlack;
FBitmapCopy.Canvas.Brush.Color := clBlack;
FBitmapCopy.Canvas.Pen := Pen;
FBitmapCopy.Canvas.Pen.Color:=clBlack;
FBitmapCopy.Canvas.Pen.Color := clBlack;
Canvas.Pen := FPen;
Canvas.Brush := FBrush;
@ -283,7 +283,7 @@ procedure TShape.Click;
begin
inherited Click;
if Assigned(OnShapeClick)
and HitTest(ScreenToClient(Mouse.CursorPos)) then
and PtInShape(ScreenToClient(Mouse.CursorPos)) then
OnShapeClick(Self);
end;
@ -292,7 +292,7 @@ var
p: TPoint;
begin
p := ParentToClient(Point(Message.XPos, Message.YPos),GetDesignerForm(Self));
if HitTest(p) then
if PtInShape(p) then
Message.Result := 0
else
Message.Result := 1;