Einzelnen Beitrag anzeigen

xVaskii

Registriert seit: 21. Apr 2016
15 Beiträge
 
Delphi 7 Personal
 
#3

AW: Canvas beim zeichnen Rechtecke buggy

  Alt 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.
  Mit Zitat antworten Zitat