title image


Smiley Re: Kreis mit Maus aufziehen
zB so:





private

Kreismitte : TPoint;

Kreisradius : Integer;

Kreiszeichnen : Boolean;

...



procedure TForm1.FormCreate(Sender: TObject);

begin

Kreismitte := Point(-10,-10);

KreisRadius := 0;

Kreiszeichnen := false;

end;



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

Shift: TShiftState; X, Y: Integer);

begin

Image1.Canvas.Pen.Color := clBlue;

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Pen.Mode := pmNot ;

KreisMitte := Point(X,Y);

Kreiszeichnen := true;

end;



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

Y: Integer);

function max(w1,w2:Integer):Integer;

begin

IF W1 > w2 then Result := W1

else Result := W2;

end;

var radx,rady : Integer;

begin

IF Kreiszeichnen then begin

radx := Abs(KreisMitte.X - X);

rady := Abs(KreisMitte.y - y);





Image1.Canvas.Ellipse(Kreismitte.X-Kreisradius,Kreismitte.y-Kreisradius,Kreismitte.X+Kreisradius,Kreismitte.y+Kreisradius);



Kreisradius := Max(radx,Rady);

Image1.Canvas.Ellipse(Kreismitte.X-Kreisradius,Kreismitte.y-Kreisradius,Kreismitte.X+Kreisradius,Kreismitte.y+Kreisradius);

end;

end;



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

Shift: TShiftState; X, Y: Integer);

begin

Kreiszeichnen := false;

Kreisradius := 0;

end;


Gruss anubis

Rechtschreibfehler sind geistiges Eigentum des Authors und dürfen ohne ausdrückliche Erlaubnis weder verändert oder kopiert werden.



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: