From: "Eddie Shipman" <Eddie@acadsoft.com>
Subject: Re: coordinate sensitive Shape comp. ?
Date: 20 Dec 1999 00:00:00 GMT
Message-ID: <83m2ko$16018@forums.borland.com>
References: <837fbh$83j10@forums.borland.com> <838847$gat7@forums.borland.com> <838dpt$g4730@forums.borland.com> <838hev$itn8@forums.borland.com> <838i04$j4n7@forums.borland.com> <838kq6$j077@forums.borland.com>
X-Priority: 3
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2314.1300
Organization: Another Netscape Collabra Server User
X-MSMail-Priority: Normal
Newsgroups: borland.public.delphi.graphics


Eddie Shipman <Eddie@acadsoft.com> wrote in message
news:838kq6$j077@forums.borland.com...
> Then, like I said before, you will need to add CM_MouseLeave and
> CM_MouseEnter
> handlers to your shape component. I don't know if there are any shape
> components
> that are in a star shape..but you could write one...
>
<SNIP>

OK I have completed a TShape descendant that has a star shape and
has OnMouseEnter/Leave handlers. Note that, in order to correctly
handle the OnMouseEnter/Leave on the Rectangle/Square shapes, the
size of the rectangle/square will be two pixels smaller than the
dimensions of the control.

Any comments????

********************************************************************

unit EXSShape;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TEXSShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle, stStar);

  TEXSShape = class(TShape)
  private
    { Private declarations }
    FRegion: HRGN;
    FPen: TPen;
    FBrush: TBrush;
    FMouseInControl, FDragging: Boolean;
    FShape: TEXSShapeType;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure SetShape(Value: TEXSShapeType);
    procedure MouseEnter;
    procedure MouseLeave;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   DrawStar(Rect: TRect);
    procedure   DrawRectangle(A, B, C, D: Integer);
    procedure   DrawRoundRect(A, B, C, D, E, F: Integer);
    procedure   DrawEllipse(A, B, C, D: Integer);
  published
    { Published declarations }
    procedure StyleChanged(Sender: TObject);
    property Align;
    property Anchors;
    property Brush: TBrush read FBrush write SetBrush;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property MouseInControl: Boolean read FMouseInControl write
FMouseInControl;
    property ParentShowHint;
    property Pen: TPen read FPen write SetPen;
    property Shape: TEXSShapeType read FShape write SetShape default
stRectangle;
    property ShowHint;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write
FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write
FOnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

uses Math;

procedure Register;
begin
  RegisterComponents('Samples', [TEXSShape]);
end;

{ TShape }

constructor TEXSShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 65;
  Height := 65;
  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
  FMouseInControl := False;
end;

destructor TEXSShape.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  inherited Destroy;
end;

procedure TEXSShape.Paint;
var
  X, Y, W, H, S: Integer;
  Rect: TRect;
begin
  Rect := Self.GetClientRect;
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    if FShape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case FShape of
      stRectangle, stSquare:
        DrawRectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        DrawRoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
      stCircle, stEllipse:
        DrawEllipse(X, Y, X + W, Y + H);
      stStar:
        DrawStar(Rect);
    end;
  end;
end;

procedure TEXSShape.DrawRectangle(A, B, C, D: Integer);
begin
  FRegion := CreateRectRgn(A+2, B+2, C-2, D-2);
  Canvas.Rectangle(A+2, B+2, C-2, D-2);
end;

procedure TEXSShape.DrawRoundRect(A, B, C, D, E, F: Integer);
begin
  FRegion := CreateRoundRectRgn(A, B, C, D, E, F);
  Canvas.RoundRect(A, B, C, D, E, F);
end;

procedure TEXSShape.DrawEllipse(A, B, C, D: Integer);
begin
  FRegion := CreateEllipticRgn(A, B, C, D);
  Canvas.Ellipse(A, B, C, D);
end;

procedure TEXSShape.DrawStar(Rect: TRect);
var
  i, x, y, xx, yy: Integer;
  p: array[0..9] of TPoint;
  t, r, sv, sw, sx, sy, s: Real;
begin
  sx := (Rect.Right-Rect.Left)*0.48;
  sy := (Rect.Bottom-Rect.Top)*0.5;
  if sx > sy then
    sx := sy
  else
    sy := sx;
  sv := (Rect.Left + Rect.Right) / 2;
  sw := (Rect.Top + Rect.Bottom * 1.2) / 2.2;
  for i := 0 to 10 do
  begin
    if ((i and 1) <> 0) then
      r := 1
    else
      r := 0.384;
    t := i * 2 * (PI/10);
    P[i].x := Trunc(sv+sx*r*sin(t));
    P[i].Y := Trunc(sw+sy*r*cos(t));
  end;
  FRegion := CreatePolygonRgn(P, 10, WINDING);
  Self.Canvas.Polygon(P);
end;

procedure TEXSShape.SetShape(Value: TEXSShapeType);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Invalidate;
  end;
end;

procedure TEXSShape.StyleChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TEXSShape.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TEXSShape.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TEXSShape.MouseEnter;
begin
  if (FMouseInControl) and (Assigned(FOnMouseEnter)) then
    FOnMouseEnter(Self);
end;

procedure TEXSShape.MouseLeave;
begin
  if (not FMouseInControl) and (Assigned(FOnMouseLeave)) then
    FOnMouseLeave(Self);
end;

procedure TEXSShape.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if PtInRegion(FRegion, X, Y) then
  begin
    FMouseInControl := True;
    MouseEnter;
  end
  else
  begin
    FMouseInControl := False;
    MouseLeave;
  end;
end;

end.