unit Shape2;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages;
type
TShapeType = (stRechteck, stDreieck, stProzess);
TShape1 =
class(TShape)
private
{ Private declarations }
FShape : TShapeType;
FCaption :
String;
FSelected : Boolean;
rx, ry,
oH, oW,
oL,
oT : Integer;
procedure SetShape(Value : TShapeType);
procedure SetCaption(Value :
String);
procedure SetSelection(Value : Boolean);
protected
{ Protected declarations }
protected procedure Paint();
override;
protected procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
override;
protected procedure MouseMove(Shift: TShiftState; X, Y: Integer);
override;
protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
override;
public
{ Public declarations }
published
{ Published declarations }
property Shape: TShapeType
read FShape
write SetShape;
property Caption:
String read FCaption
write SetCaption;
property Selected: Boolean
read FSelected
write SetSelection;
end;
type TMyShape =
class(TWinControl)
Shape : TShape1;
procedure Exit(
var msg:TMessage);
message cm_exit;
procedure Button(
var msg:TMessage);
message wm_lbuttondown;
constructor create(Aowner:Tcomponent);
override;
destructor destroy;
end;
procedure Register;
implementation
constructor TMyShape.create;
begin
inherited create(Aowner);
shape:=Tshape1.Create(self);
self.Enabled:=true;
self.TabStop:=true;
with self.Shape
do begin
Parent:= self;
Enabled := true;
Shape := stProzess;
Left := 100;
Top := 100;
Height:= 100;
Width := 100;
Brush.Color := $005555FF;
Show;
end;
end;
destructor TMyShape.destroy;
begin
shape.Free;
inherited;
end;
procedure TMyShape.Exit(
var msg:TMessage);
begin
self.Shape.Selected := false;
end;
procedure TMyShape.Button(
var msg:TMessage);
begin
self.Shape.Selected := true;
self.SetFocus;
end;
procedure Register;
begin
RegisterComponents('
Samples', [TShape1]);
end;
procedure TShape1.SetShape(Value : TShapeType);
begin
FShape := Value;
end;
procedure TShape1.SetCaption(Value :
String);
begin
FCaption := Value;
// Paint;
end;
procedure TShape1.SetSelection(Value : Boolean);
begin
FSelected := Value;
Paint;
end;
procedure TShape1.Paint();
var sw, sh: Integer;
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect(0,0,self.Width, self.Height));
sw := self.Width -1;
sh := self.Height -1;
Canvas.Brush.Color := self.Brush.Color;
Canvas.Font.Color := $00FFFFFF;
Canvas.Font.Style := [fsBold];
if Self.Shape = stRechteck
then begin
Canvas.Polygon([Point(4, 4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4), Point(4, Self.ClientHeight-4)]);
end;
If Self.Shape = stDreieck
then begin
Canvas.Polygon([Point(4, Trunc(Self.ClientHeight / 2)-4), Point(Self.ClientWidth-4, 4), Point(Self.ClientWidth-4, Self.ClientHeight-4)]);
end;
If Self.Shape = stProzess
then begin
Canvas.Polygon([Point(4,4), Point(Trunc(0.85 * Self.Width),4), Point(Self.Width-4,Trunc(Self.Height / 2)), Point(Trunc(0.85 * Self.Width), Self.Height-4), Point(4,Self.Height-4), Point(Trunc(0.15*Self.Width),Trunc(Self.Height / 2))]);
end;
If Self.Selected = True
then begin
Canvas.Pen.Style := psDot;
Canvas.Pen.Color := $00999999;
Canvas.Brush.Style:= bsClear;
Canvas.Polyline([
Point(0,0),
Point(sw,0),
Point(sw,sh),
Point(0,sh),
Point(0,0)
]);
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := $00000000;
Canvas.Brush.Color := $00FFFFFF;
//Ecken [] zeichnen
Canvas.Rectangle(0,0,8,8);
Canvas.Rectangle(self.ClientWidth-8,0,self.ClientWidth,8);
Canvas.Rectangle(0,self.ClientHeight-8,8,self.ClientHeight);
Canvas.Rectangle(self.ClientWidth-8,self.ClientHeight-8,self.ClientWidth,self.ClientHeight);
Canvas.Rectangle(Trunc(self.Width /2)-4,0,Trunc(self.Width /2)+4,8);
Canvas.Rectangle(Trunc(self.Width /2)-4,self.Height-8,Trunc(self.Width /2)+4,self.Height);
Canvas.Rectangle(0,Trunc(Self.Height / 2)-4,8,Trunc(Self.Height / 2)+4);
Canvas.Rectangle(self.Width-8,Trunc(Self.Height / 2)-4,self.Width,Trunc(Self.Height / 2)+4);
end;
Canvas.Brush.Style := bsClear;
Canvas.TextOut(Trunc(self.Width / 2)-Trunc(Canvas.TextWidth(Caption) / 2), Trunc(self.Height / 2) - Trunc(Canvas.TextHeight(Caption) / 2), Self.Caption);
end;
procedure TShape1.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
rx := X;
ry := Y;
oH := self.Height;
oW := self.Width;
oT := self.Top;
oL := self.Left;
// Self.Selected := True;
Paint;
end;
procedure TShape1.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if ((ssLeft
in Shift)
AND (self.Selected = True))
then begin
//links oben
if ((rx < 9)
AND (ry < 9))
then begin
self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
self.Height :=
oH+(
oT - self.Top);
self.Width := oW+(oL - self.Left);
//rechts oben
end else if ((rx > oW-8)
AND (ry < 9))
then begin
self.Top := Mouse.CursorPos.Y - 30 - Parent.Top - ry;
self.Height :=
oH+(
oT - self.Top);
self.Width := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
//rechts unten
end else if ((rx > oW-8)
AND (ry >
oH -8))
then begin
self.Top :=
oT;
self.Left := oL;
self.Height := Mouse.CursorPos.Y - 30 - Parent.Top -
oT + (
oH-rY);
self.Width := Mouse.CursorPos.X - 4 - Parent.Left - oL + (oW-rX);
//links unten
end else if ((rx < 9)
AND (ry >
oH -8))
then begin
self.Top :=
oT;
self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
self.Height := Mouse.CursorPos.Y - 30 - Parent.Top -
oT + (
oH-rY);
self.Width := oW+(oL - self.Left);
//mitte oben
end else if ((rx > Trunc(oW / 2)-4)
AND (rx < Trunc(oW / 2)+4)
AND (ry < 9))
then begin
self.Top := Mouse.CursorPos.Y -30 - Parent.Top - ry;
self.Height :=
oH+(
oT - self.Top);
//mitte links
end else if ((rx < 9)
AND (ry > Trunc(
oH/2) -4)
AND (ry < Trunc(
oH/2)+4))
then begin
self.Left := Mouse.CursorPos.X -4 - Parent.Left - rx;
self.Width := oW+(oL - self.Left);
//mitte rechts
end else if ((rx > oW-8)
AND (ry > Trunc(
oH/2) -4)
AND (ry < Trunc(
oH/2)+4))
then begin
self.Width := Mouse.CursorPos.X -4 - Parent.Left - oL + (oW-rX);
//mitte unten
end else if ((rx > Trunc(oW / 2)-4)
AND (rx < Trunc(oW / 2)+4)
AND (ry >
oH -8))
then begin
self.Top :=
oT;
self.Height := Mouse.CursorPos.Y - 30 - Parent.Top -
oT + (
oH-rY);
//sonst verschiebe nur
end else begin
self.Top := Mouse.CursorPos.Y - Parent.Top - ry-30;
self.Left := Mouse.CursorPos.X - Parent.Left - rx-4;
end;
end;
end;
procedure TShape1.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
end;
end.