unit ZWShape;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
const MAX_STATION = 8;
type
TZWShape = class(TShape)
private
{ Private declarations }
old_x,old_y: integer;
can_move: boolean;
PicLeft,PicTop,TexLeft,TexTop: integer;
//ImgRect: TRect;
FPicture: TPicture;
FNumber: Cardinal;
FTouch: TNotifyEvent;
procedure SetPicture(Value: TPicture);
procedure SetNumber(Value: Cardinal);
//procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
//procedure WMSize(var Msg: TWMSize); message WM_SIZE;
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
TextX, TextY: integer;
//Ctr: Ctr_T;
neighbor_x,neighbor_y:integer;
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure MouseMove(Shift: TShiftState; X,
Y: Integer); override;
function CenterX:integer;
function CenterY:integer;
published
{ Published declarations }
property Picture: TPicture read FPicture write SetPicture;
property Number: Cardinal read FNumber write SetNumber default 0;
property OnTouch : TNotifyEvent read FTouch write FTouch;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('220', [TZWShape]);
end;
constructor TZWShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
can_move := false;
FPicture := TPicture.Create;
Shape := stCircle;
Canvas.Font.Color := ClWhite;
Canvas.Font.Style := Canvas.Font.Style + [fsBold];
TextX := 0;
TextY := 0;
TexLeft := width div 2 - Canvas.Font.Height div 2 + TextX;
TexTop := height div 2 - Canvas.Font.Size div 2 + TextY;
end;
procedure TZWShape.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
old_x := x;
old_y := y;
can_move := true;
cursor := crSizeAll;
if assigned(OnMouseDown) then OnMouseDown(self,Button,shift,x,y);
end;
procedure TZWShape.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
can_move := false;
cursor := crDefault;;
if assigned(OnMouseUp) then OnMouseUp(self,Button,shift,x,y);
end;
procedure TZWShape.MouseMove(Shift: TShiftState; X,
Y: Integer);
{var TemShape: TZWShape;
i: integer;}
begin
cursor := crSizeAll;
if can_move then
begin
Left := Left+x-old_x;
Top := Top+y-old_y;
end;
{for i:=0 to parent.ComponentCount-1 do
begin
if parent.Components.ClassName = 'TZWShape' then
begin
TemShape:= (parent.Components as TZWShape);
if TemShape.Number <> Number then
begin
neighbor_x := TemShape.CenterX;
neighbor_y := TemShape.CenterY;
if assigned(OnTouch) then OnTouch(self);
end;
end;
end;}
if assigned(OnMouseMove) then OnMouseMove(self,shift,x,y);
end;
procedure TZWShape.Paint;
var
SavedBrushStyle : TBrushStyle;
SavedBrushColor: TColor;
begin
SavedBrushStyle := Canvas.Brush.Style;
SavedBrushColor := Canvas.Brush.Color;
try
Canvas.Brush.Style := bsCross;
Canvas.Brush.Color := RGB(50,190,60);//clGreen;
Canvas.Pen.Color := RGB(50,190,60); //clGreen;
Canvas.Ellipse(ClientRect);
if assigned(FPicture) then
begin
//Canvas.StretchDraw(ImageRect,FPicture.Graphic);
Canvas.Draw(PicLeft,PicTop,Fpicture.Bitmap);
Canvas.TextOut(TexLeft,TexTop,inttostr(FNumber));
//if assigned(OnTouch) then OnTouch(self);
end;
finally
Canvas.Brush.Style := SavedBrushStyle;
Canvas.Brush.Color := SavedBrushColor;
end;
end;
{procedure TZWShape.WMSize(var Msg: TWMSize);
begin
inherited;
DeleteObject(FHRgn);
FHRgn := CreateEllipticRgn(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom);
SetWindowRgn(Handle, FHRgn, True);
end;}
procedure TZWShape.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
//set transparent
Fpicture.Bitmap.TransparentMode := tmAuto;
Fpicture.Bitmap.TransparentColor := Fpicture.BitMap.canvas.pixels[5,5];
Fpicture.Bitmap.Transparent := true;
PicLeft := width div 2 - Value.Bitmap.Width div 2;
PicTop := height div 2 - Value.Bitmap.Height div 2;
TexLeft := width div 2 - Canvas.Font.Height div 2 + TextX;
TexTop := height div 2 - Canvas.Font.Size div 2 + TextY;
invalidate;
end;
procedure TZWShape.SetNumber(Value: Cardinal);
begin
FNumber := value;
end;
{procedure TZWShape.WMEraseBkgnd(var Msg: TMessage);
begin
inherited;
if assigned(OnTouch) then OnTouch(self);
end;}
function TZWShape.CenterX:integer;
begin
Result:=left + (width div 2);
end;
function TZWShape.CenterY:integer;
begin
Result:=top + (height div 2);
end;
destructor TZWShape.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
end.
