2006. december 19., kedd
How to create a non-rectangular TShape that accepts mouse clicks only in the shape's region itself
Problem/Question/Abstract:
How to create a non-rectangular TShape that accepts mouse clicks only in the shape's region itself
Answer:
This will show you how to do a TShape that has mouse clicks only in the shape itself and not it's surrounding box.
unit NoMouseShape;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TNoMouseShape = class(TShape)
private
{ Private declarations }
protected
{ Protected declarations }
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
function ValidPoint(pt: TPoint): Boolean;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('EXS', [TNoMouseShape]);
end;
constructor TNoMouseShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Shape := stCircle;
end;
function TNoMouseShape.ValidPoint(pt: TPoint): Boolean;
var
i, j: Integer;
begin
Result := False;
for i := 0 to Width do
for j := 0 to Height do
if (Self.Canvas.Pixels[pt.x, pt.y] = clWhite) or (Self.Canvas.Pixels[pt.x, pt.y] = clBlack) then
Result := True;
end;
procedure TNoMouseShape.CMHitTest(var Message: TCMHitTest);
begin
if ValidPoint(SmallPointToPoint(Message.Pos)) then
Message.Result := HTCLIENT {Handle the message}
else
Message.Result := HTNOWHERE; {pass on to parent}
end;
end.
Now, if you want a real non-rectangular area, using SetWindowRgn would be the way to go. You do not have to derive from TWinControl, drive it from TCustomControl as TCustomControl provides a canvas and handles paint messages. Then you will need to re-write the ValidPoint function to use the PtInRegion API function.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése