Egyszerű gumiszálas technika

Top  Previous  Next

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

stmaptype, StdCtrls, ExtCtrls;

 

type

TForm1 = class(TForm)

   Panel1: TPanel;

   Label1: TLabel;

   ComboBox1: TComboBox;

   Panel2: TPanel;

   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

     Y: Integer);

   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure ComboBox1Click(Sender: TObject);

private

   FDrawMode: TDrawMode;

   { Private declarations }

public

   Drawing  : boolean;

   Origin   : TPoint;

   MovePt   : TPoint;

   oldMovePt: TPoint;

   sr       : TRect;

   property DrawMode: TDrawMode read FDrawMode write FDrawMode;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

// Draw a shape to Canvas

procedure DrawShape(Canvas: TCanvas; T,B: TPoint; DrawMode: TDrawMode;

                           AMode: TPenMode);

var DC:HDC;

   DX,DY : integer;

begin

DC := GetDC(Canvas.Handle);

With Canvas do

begin

   Pen.Mode    := AMode;

   Brush.Color := clWhite;

   Brush.style := bsClear;

   If (T.X<>B.x) OR (T.Y<>B.Y) then

   begin

       case DrawMode of

       dmPoint:

           Rectangle(T.X-2,T.Y-2,T.X+2,T.Y+2);

       dmLine,dmPolyline,dmPolygon:

       begin

           MoveTo(T.X, T.Y); LineTo(B.X, B.Y);

       end;

       dmRectangle : Rectangle(T.X, T.Y, B.X, B.Y);

       dmCircle,dmEllipse :

       begin

           dx := Abs(T.X-B.X);

           dy := Abs(T.Y-B.Y);

           if DrawMode=dmCircle then begin

              dx:=Trunc(sqrt(dx*dx+dy*dy));

              dy:=dx;

           end;

           Ellipse(T.X-dx, T.Y-dy, T.X+dx, T.Y+dy);

       end;

       end;

   end;

end;

RestoreDC(Canvas.Handle,DC);

end;

 

 

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Origin:=Point(x,y);

Canvas.Pen.Color := clRed;

sr:=Rect(x,y,x,y);

Drawing := True;

end;

 

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

MovePt := Point(x,y);

if Drawing then begin

    DrawShape(Canvas,sr.TopLeft,sr.BottomRight,DrawMode,pmNotXor);

    sr:=Rect(Origin.x,Origin.y,x,y);

    DrawShape(Canvas,sr.TopLeft,sr.BottomRight,DrawMode,pmNotXor);

end;

oldMovePt := Point(x,y);

end;

 

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Drawing := False;

end;

 

procedure TForm1.ComboBox1Click(Sender: TObject);

begin

DrawMode := TDrawMode(ComboBox1.itemindex);

end;

 

end.