Einzelnen Beitrag anzeigen

Nikodel

Registriert seit: 11. Jan 2019
20 Beiträge
 
Delphi XE4 Professional
 
#1

zeichnen auf TForm.Canvas?

  Alt 7. Feb 2019, 14:07
Hi,
in meinem VCL-Progamm möchte ich für den Ausdruck einer programmierten Grafik die Ränder interaktiv einstellen können. Dazu erzeuge ich ein neues Fenster, in welchem die Ränder links, rechts, oben und unten mit jeweiligen SpinEdit eingestellt werden können. Damit man auch einen visuellen Eindruck bekommt, soll ein DINA4-Blatt mit diesen Rändern in Form von Rechtecken direkt auf das TForm gemalt werden.
Leider erhalte beim Anwählen des Drucks jedoch eine Exception "acces violation at ...".

Zum Drucken wird drucken1Click() in Unit1 aufgerufen.
Dort wird das Objekt PrintForm von Unit2 erzeugt (in Unit1 wird kein Objekt von Unit2 erzeugt).
Nach Einstellung der Werte für das DINA4-Rechteck wird PrintForm.SetPrintArea von Unit2 aufgerufen.
Sofort in der ersten Zeile von SetPrintArea kommt die Exception.
Darf man denn nicht direkt auf ein TForm.Canvas zeichnen?

Code:
In Unit1:
procedure TMainForm.drucken1Click(Sender: TObject);
{ es wird von einem A4-Format ausgegangen }
var
  PrintForm: TForm2;
  sfx, sfy: single;
begin
  if PrintDialog1.Execute then
  begin
    PrintForm := TForm2.Create(self);
    if Printer.PageWidth>Printer.PageHeight then  // A4-Querformat
    begin
      PrintForm.pLeft:=227;
      PrintForm.pTop:=(PrintForm.ClientHeight div 2)-52;
      PrintForm.pRight:=PrintForm.pLeft+145;
      PrintForm.pBottom:=PrintForm.pTop+105;
      sfx:=Printer.PageWidth/290;
      sfy:=Printer.PageHeight/210;
    end
    else begin   // A4-Hochformat
      PrintForm.pLeft:=227;
      PrintForm.pTop:=(PrintForm.ClientHeight div 2)-72;
      PrintForm.pRight:=PrintForm.pLeft+105;
      PrintForm.pBottom:=PrintForm.pTop+145;
      sfx:=Printer.PageWidth/210;
      sfy:=Printer.PageHeight/290;
    end;
    PrintForm.SetPrintArea; // <<-- da passiert die Exception!
    try
      PrintForm.ShowModal;
    finally // jetzt stehen die Ränder fest

      ... // hier wird gedruckt

      PrintForm.Free;
    end;
    SetBordersDispl;
  end;
end;

In Unit2:
type
  TForm2 = class(TForm)
    seTop: TSpinEdit;
    seLeft: TSpinEdit;
    seRight: TSpinEdit;
    seBottom: TSpinEdit;
    Label1: TLabel;
    Label_o: TLabel;
    Label_u: TLabel;
    Label_l: TLabel;
    Label_r: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure SetPrintArea;
    procedure BorderChange(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    pLeft, pTop, pRight, pBottom: int16;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.BorderChange(Sender: TObject);
begin
  SetPrintArea;
end;

procedure TForm2.SetPrintArea;
begin
  Form2.Canvas.Brush.Color:=clDkGray;   // <<-- hier passiert die Exception!
  Form2.Canvas.FillRect(Rect(pLeft, pTop, pRight, pBottom));
  Form2.Canvas.Rectangle(pLeft+seLeft.Value, pTop+seTop.Value,
                          pRight-seRight.Value, pBottom-seBottom.Value);
end;
  Mit Zitat antworten Zitat