Einzelnen Beitrag anzeigen

Benutzerbild von Gollum
Gollum

Registriert seit: 14. Jan 2003
Ort: Boxberg
456 Beiträge
 
Delphi 10.1 Berlin Professional
 
#10

AW: Zeichnung wird nicht richtig gezeichnet

  Alt 10. Jul 2019, 10:30
Hallo delphicoder123,

anbei ein einfaches Beispiel, in dem das Rechteck nach Mausklick gezeichnet und der Hintergrund aktualisiert wird.
Delphi-Quellcode:
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    ScrollBox1: TScrollBox;
    imgAusgabe: TImage;
    procedure imgAusgabeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    x1, x2, y1, y2:Integer;
    bmpHintergrund:TBitmap;

    procedure InitHintergrund();
    procedure Ausgabe();
  public
  end;

var
  Form2: TForm2;


implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  x1:=0;
  y1:=0;
  x2:=0;
  y2:=0;
  bmpHintergrund:=TBitmap.Create();
  bmpHintergrund.SetSize(ScrollBox1.Width*2, ScrollBox1.Height*2);
  bmpHintergrund.Canvas.Brush.Color:=clYellow;
  bmpHintergrund.Canvas.Pen.Color:=clNavy;
  bmpHintergrund.Canvas.Pen.Width:=2;
  imgAusgabe.SetBounds(0, 0, bmpHintergrund.Width, bmpHintergrund.Height);

  InitHintergrund();
  Ausgabe();
end;


procedure TForm2.FormDestroy(Sender: TObject);
begin
  bmpHintergrund.Free();
end;


procedure TForm2.InitHintergrund();
var i, dx:Integer;
begin
  dx:=imgAusgabe.Width div 30;

  bmpHintergrund.Canvas.FillRect(bmpHintergrund.Canvas.ClipRect);
  for i:=0 to 29 do
  begin
    bmpHintergrund.Canvas.MoveTo(dx*i, 0);
    bmpHintergrund.Canvas.LineTo(dx*i, imgAusgabe.Height);
  end; // for i
end; // TForm2.InitHintergrund


procedure TForm2.Ausgabe();
begin
  imgAusgabe.Picture.Assign(bmpHintergrund);
  imgAusgabe.Canvas.Rectangle(x1, y1, x2, y2);
end; // TForm2.Ausgabe


procedure TForm2.imgAusgabeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin
    x1:=x;
    x2:=x+100;
    y1:=y;
    y2:=y+100;
    Ausgabe();
  end; // if
end;
end.
Angehängte Dateien
Dateityp: zip Unit2.zip (1,3 KB, 2x aufgerufen)
  Mit Zitat antworten Zitat