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.

Nincsenek megjegyzések:

Megjegyzés küldése