![]() |
Delphi-Version: 5
Canvas beim zeichnen Rechtecke buggy
Liste der Anhänge anzeigen (Anzahl: 1)
Hey Community,
wollte fragen wie man den Bug fixen kann. Wenn man noch beim auswählen ist, wird die BrushColor sowie PenColor falsch dargestellt (siehe Screenshot). Wenn man loslässt wird das dann richtig dargestellt. Danke! :) |
AW: Canvas beim zeichnen Rechtecke buggy
Zitat:
|
AW: Canvas beim zeichnen Rechtecke buggy
Also hier ist mal mein kompletter Code. Nichts besonderes bisher :D
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. |
AW: Canvas beim zeichnen Rechtecke buggy
Oha. Da hat sich aber ein Bug in der Forensoftware eingeschlichen. Im Code Fenster wird mir gar nichts angezeigt. Wenn ich allerdings den Beitrag zitieren will, dann sehe ich alles.
|
AW: Canvas beim zeichnen Rechtecke buggy
Zitat:
|
AW: Canvas beim zeichnen Rechtecke buggy
Okay danke, ja also könnte etwas dauern ist recht viel code aber vielleicht sieht der ein oder andere schon woran es liegen könnte.
|
AW: Canvas beim zeichnen Rechtecke buggy
Zitat:
Also er hat wohl nur mit normalem Code Tag gepostet, aber der Fehler sollte natürlich trotzdem nicht auftreten. :wink: |
AW: Canvas beim zeichnen Rechtecke buggy
Zitat:
Woher hast du den Code? Komplett selbstgeschrieben ist er ja nicht .. kann mich dunkel erinnern in meiner Anfangszeit auch mal ein Grafikprogramm geschrieben zu haben und während meiner Recherche einen verdammt ähnlichen Code, der ebenfalls pmNotXor verwendet hat, gefunden zu haben. |
AW: Canvas beim zeichnen Rechtecke buggy
nein nicht alles selber, ist aus einem buch was wir auch in der schule behandeln :)
|
AW: Canvas beim zeichnen Rechtecke buggy
Wie kann man denn diesen XOR Modus deaktivieren? liegt es daran?
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:10 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz