paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 10:16:04 +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; exit;
if csNoDesignSelectable in Control.ControlStyle then if csNoDesignSelectable in Control.ControlStyle then
exit; 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; exit;
end end
else else

4
lcl/extctrls.pp
View File

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

2
lcl/include/controlconsts.inc
View File

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

14
lcl/include/shape.inc
View File

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