How to create a non-rectangular TShape that accepts mouse clicks only in the shape's region itself (Views: 28)
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. |