unit Shape3;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages, Windows;
type
TShapeType = (stRechteck, stDreieck, stProzess);
TMyShape =
class(TCustomControl)
private
{ Private declarations }
FShape : TShapeType;
FCaption :
String;
FSelected : Boolean;
rx, ry,
rXObj, rYObj,
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;
procedure onExit(
var msg:TMessage);
message cm_exit;
// protected procedure onClick();
procedure onButton(
var msg:TMessage);
message wm_lbuttondown;
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;
property onClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Samples', [TMyShape]);
end;
procedure TMyShape.onExit(
var msg:TMessage);
begin
self.Selected := false;
end;
procedure TMyShape.onButton(
var msg:TMessage);
begin
self.Selected := true;
self.SetFocus;
rX := Mouse.CursorPos.X-Parent.Left-Self.Left;
rXObj := rX - 4;
rY := Mouse.CursorPos.Y-Parent.Top-Self.Top;
rYObj := rY - 30;
oH := self.Height;
oW := self.Width;
oT := self.Top;
oL := self.Left;
self.BringToFront;
end;
procedure TMyShape.SetShape(Value : TShapeType);
begin
FShape := Value;
Invalidate;
end;
procedure TMyShape.SetCaption(Value :
String);
begin
FCaption := Value;
Invalidate;
end;
procedure TMyShape.SetSelection(Value : Boolean);
begin
FSelected := Value;
if Value = True
then
Self.DoubleBuffered := true
else
Self.DoubleBuffered := False;
Invalidate;
end;
procedure TMyShape.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;
if(self.Shape = stRechteck)
then self.Brush.Color := clBlue;
if(self.Shape = stProzess)
then self.Brush.Color := clRed;
if(self.Shape = stDreieck)
then self.Brush.Color := clYellow;
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)), 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 TMyShape.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
{ mp := ScreenToClient(Mouse.CursorPos);
rX := Mouse.CursorPos.X-Parent.Left-Self.Left;
rY := mp.Y;
self.Caption := '.'+IntToStr(mp.X);
oH := self.Height;
oW := self.Width;
oT := self.Top;
oL := self.Left; }
// Self.Selected := True;
end;
procedure TMyShape.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if ((ssLeft
in Shift)
AND (self.Selected = True))
then begin
//links oben
if ((rxObj < 9)
AND (ryObj < 9))
then begin
self.Top := round((Mouse.CursorPos.Y - Parent.Top - ry) / 5)*5;
self.Left := round((Mouse.CursorPos.X - Parent.Left - rx) / 5)*5;
self.Height :=
oH+(
oT - self.Top);
self.Width := oW+(oL - self.Left);
//rechts oben
end else if ((rxObj > oW-8)
AND (ryObj < 9))
then begin
self.Top := ((Mouse.CursorPos.Y - Parent.Top - ry)
div 10)*10;
self.Height :=
oH+(
oT - self.Top);
self.Width := ((Mouse.CursorPos.X - Parent.Left - oL + (oW-rX))
div 10)*10;
//rechts unten
end else if ((rxObj > oW-8)
AND (ryObj >
oH -8))
then begin
self.Top :=
oT;
self.Left := oL;
self.Height := Round((Mouse.CursorPos.Y - Parent.Top -
oT + (
oH-rY)) / 5) * 5;
self.Width := Round((Mouse.CursorPos.X - Parent.Left - oL + (oW-rX)) / 5) *5;
//links unten
end else if ((rxObj < 9)
AND (ryObj >
oH -8))
then begin
self.Top :=
oT;
self.Left := Mouse.CursorPos.X - Parent.Left - rx;
self.Height := Mouse.CursorPos.Y - Parent.Top -
oT + (
oH-rY);
self.Width := oW+(oL - self.Left);
//mitte oben
end else if ((rxObj > Trunc(oW / 2)-4)
AND (rxObj < Trunc(oW / 2)+4)
AND (ryObj < 9))
then begin
self.Top := ((Mouse.CursorPos.Y - Parent.Top - ry)
div 10)*10;
self.Height :=
oH+(
oT - self.Top);
//mitte links
end else if ((rxObj < 9)
AND (ryObj > Trunc(
oH/2) -4)
AND (ryObj < Trunc(
oH/2)+4))
then begin
self.Left := ((Mouse.CursorPos.X - Parent.Left - rx)
div 10)*10;
self.Width := oW+(oL - self.Left);
//mitte rechts
end else if ((rxObj > oW-8)
AND (ryObj > Trunc(
oH/2) -4)
AND (ryObj < Trunc(
oH/2)+4))
then begin
self.Width := ((Mouse.CursorPos.X - Parent.Left - oL + (oW-rX))
div 10)*10;
//mitte unten
end else if ((rxObj > Trunc(oW / 2)-4)
AND (rxObj < Trunc(oW / 2)+4)
AND (ryObj >
oH -8))
then begin
self.Top :=
oT;
self.Height := ((Mouse.CursorPos.Y - Parent.Top -
oT + (
oH-rY))
div 10)*10;
//sonst verschiebe nur
end else begin
self.Left := (round((Mouse.CursorPos.X - Parent.Left - rX) / 10)) * 10;
self.Top := (round((Mouse.CursorPos.Y - Parent.Top - rY) / 10)) * 10;
end;
end;
end;
procedure TMyShape.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
end;
end.