Registriert seit: 21. Apr 2016
15 Beiträge
Delphi 7 Personal
|
AW: Canvas beim zeichnen Rechtecke buggy
22. Apr 2016, 19:39
Also hier ist mal mein kompletter Code. Nichts besonderes bisher
Delphi-Quellcode:
var Grafikart, Pinseldicke : Integer;
Stiftart : TPenStyle;
Pinselart : TBrushStyle;
zeichnen : Boolean;
Stiftfarbe, Pinselfarbe : TColor;
x0,y0,x1,y1 : Integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
with Form1 do begin
WindowState := wsMaximized; // starte in maximiertem Fenster //
end;
image1.Canvas.MoveTo(0,0);
zeichnen:= false; // Globale Voreinstellung //
Grafikart:=0;
Stiftfarbe:=clBlack;
Pinselfarbe:=clBlack;
Stiftart:=psSolid;
Pinselart:=bsClear;
Image1.Canvas.Pen.width:=Pinseldicke;
ComboBox1.ItemIndex:=0; // Zurücksetzen der ComboBox1 auf Solid //
ComboBox2.ItemIndex:=1; // Zurücksetzen der ComboBox2 auf Solid //
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r,a,b : LongInt;
begin
if zeichnen then
with Image1.Canvas do
begin
Case Grafikart of
1 : Lineto(x,y);
2 : begin
MoveTo(x0,y0); // hier werden die alten Werte gelöscht //
LineTo(x1,y1);
MoveTo(x0,y0); // hier wird mit den neuen Werten gezeichnet //
LineTo(x,y);
end;
3 : begin
Rectangle(x0,y0,x1,y1);
Rectangle(x0,y0,x,y);
end;
4 : begin
r:=Round(Sqrt(Sqr(x1-x0)+Sqr(y1-y0)));
Ellipse(x0-r,y0-r,x0+r,y0+r);
r:=Round(Sqrt(Sqr(x-x0)+Sqr(y-y0)));
Ellipse(x0-r,y0-r,x0+r,y0+r);
end;
5 : begin
a:=Round(Sqrt(2)*(x1-x0));
b:=Round(Sqrt(2)*(y1-y0));
Ellipse(x0-a,y0-b,x0+a,y0+b);
a:=Round(Sqrt(2)*(x-x0));
b:=Round(Sqrt(2)*(y-y0));
Ellipse(x0-a,y0-b,x0+a,y0+b);
end;
6 : begin
Form1.Image1.canvas.pen.color:=clWhite;
end;
end;
x1:=x; // aktuelle Werte merken //
y1:=y;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var r,a,b : LongInt;
begin
zeichnen:=false; // Wenn nicht geklickt = zeichnet nicht //
with Image1.Canvas do
begin
pen.mode:=pmCopy;
Case Grafikart of
2 : begin
MoveTo(x0,y0);
LineTo(x,y);
end;
3 : Rectangle(x0,y0,x,y) ;
4 : begin
r:=Round(Sqrt(Sqr(x1-x0)+Sqr(y1-y0)));
Ellipse(x0-r,y0-r,x0+r,y0+r);
end;
5 : begin
a:=Round(Sqrt(2)*(x-x0));
b:=Round(Sqrt(2)*(y-y0));
Ellipse(x0-a,y0-b,x0+a,y0+b);
end;
end;
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
zeichnen:=true; // Wenn geklickt = zeichnet //
x0:=x; y0:=y;
x1:=x; y1:=y;
with image1.Canvas do
begin
pen.color:=Stiftfarbe;
pen.style:=Stiftart;
brush.color:=pinselfarbe;
brush.Style:=pinselart;
Moveto(x,y);
if Grafikart=1
then pen.mode:=pmCopy
else pen.Mode:=pmNotXor;
end;
end;
procedure TForm1.PenButtonClick(Sender: TObject);
begin
with image1.canvas do begin // Zurücksetzen nach Radieren //
Grafikart:=1;
pen.width:=1;
Stiftfarbe:=clBlack;
end;
end;
procedure TForm1.LineButtonClick(Sender: TObject);
begin
Grafikart:=2;
end;
procedure TForm1.RectangleButtonClick(Sender: TObject);
begin
Grafikart:=3;
end;
procedure TForm1.CircleButtonClick(Sender: TObject);
begin
Grafikart:=4;
end;
procedure TForm1.EllipseButtonClick(Sender: TObject);
begin
Grafikart:=5;
end;
procedure TForm1.EraseButtonClick(Sender: TObject); // Radiergummi //
begin
Grafikart:=1; // Stift (Freihand), sonst Radiert man mit dem Rechteck zB //
with image1.canvas do begin
Pen.Width:=20;
Stiftfarbe:=clWhite;
pen.style:=psdot;
end; // Ende with //
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
Stiftart:=TPenStyle(Combobox1.ItemIndex); // Linienart //
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
Pinselart:=TBrushStyle(Combobox2.ItemIndex); // Arten der Füllung (Brushs) //
end;
procedure TForm1.PenColorButtonClick(Sender: TObject); // Stiftfarbe auswählen //
begin
if ColorDialog1.Execute then
Stiftfarbe:=ColorDialog1.Color;
end;
procedure TForm1.BrushColorButtonClick(Sender: TObject); // Füllfarbe auswählen //
begin
if ColorDialog1.Execute then
Pinselfarbe:=ColorDialog1.Color;
end;
procedure TForm1.OpenClick(Sender: TObject); // Leiste oben, öffnen //
begin
if OpenDialog1.Execute then
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.SaveClick(Sender: TObject); // Leiste oben, speichern //
begin
if SaveDialog1.Execute then
Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
if MessageDlg('Wirklich beenden?',
mtConfirmation,
[mbYes,mbNo],
0) = mrYes then begin
close;
end;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ComboBox1.Canvas do
begin
Pen.Color:=Stiftfarbe;
Pen.Style:=TPenStyle(Index);
Brush.Color:=clWhite;
FillRect(Rect);
MoveTo(Rect.Left+5,Rect.Top+ComboBox1.ItemHeight div 2);
LineTo(Rect.Right-5,Rect.Top+ComboBox1.ItemHeight div 2);
end;
end;
procedure TForm1.ComboBox2DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
with ComboBox2.Canvas do
begin
Pen.Color:=Stiftfarbe;
Brush.Color:=Pinselfarbe;
Pen.Style:=psSolid;
Brush.Style:=TBrushStyle(Index);
Rectangle(Rect.Left+1,Rect.Top+1,Rect.Right-1,Rect.Bottom-1);
end;
end;
procedure TForm1.New1Click(Sender: TObject);
begin
if MessageDlg('Möchten Sie Neu anfangen?', // if Abfrage //
mtConfirmation,
[mbYes,mbNo],
0) = mrYes then begin
with Image1.Canvas do
begin // lösche Canvas //
Pen.Color:=clWhite;
Pen.Style:=psSolid;
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
Rectangle(0,0,Image1.Width,Image1.Height);
end;
end;
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
clipboard.assign (image1.picture); // Bild in Zwischenablage
end;
procedure TForm1.Paste1Click(Sender: TObject);
begin
Image1.Picture.assign(clipboard); // Zwischenablage in Bild
end;
procedure TForm1.FormResize(Sender: TObject); // responsive Toolbars //
begin
image1.Height:=form1.Height-51;
image1.Width:=form1.Width-41;
panel2.Height:=form1.Height-41;
panel1.Width:=form1.Width;
end;
// procedure TForm1.Edit1Change(Sender: TObject); // hier soll Zahl eingegeben werden //
// var eingabe: integer;
//begin
// eingabe:=strtoint(edit1.text);
// Pinseldicke:=eingabe;
//end;
procedure TForm1.Edit1Change(Sender: TObject);
var wert:integer;
begin
wert:=strtoint(edit1.Text);
Image1.Canvas.Pen.Width:=Pinseldicke;
wert:=Pinseldicke;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (kEY =ord('V')) then PenButtonClick(Sender);
end;
end.
André Thiele
Geändert von Daniel (22. Apr 2016 um 20:10 Uhr)
Grund: Delphi-Tags korrigiert.
|