Komponente für PrintPreview, Printing und Export

[Mackhack]

Hier noch was Handgeschriebenes aus 10 Jahren,...

Delphi-Quellcode:

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,printers, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    PrinterSetupDialog1: TPrinterSetupDialog;
    SpeedButton2: TSpeedButton;
    Shape1: TShape;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  blatt : TCanvas;
  dc : HDC;
  druckbreite,druckhoehe: integer;
  panelx : TWinControl;
  MMproPixelY,
  MMproPixelX           : single;

implementation

{$R *.DFM}

procedure DC_TextOut(c:TCanvas;x,y,winkel,groesse:integer;txt:PChar);
var
  hfont, fontold : integer;
  dc             : hdc;
  fontname       : string;
begin
  dc := c.handle;
  fontname := c.font.name + #0;
  hfont   := CreateFont(groesse,0,winkel*10,0,fw_normal,0,0,0,1,out_tt_precis,$10,2,4,@fontname[1]);
  fontold := SelectObject(dc,hfont);
  c.TextOut(x,y,txt);
  SelectObject(dc, fontold);
  DeleteObject(hfont);
end;

procedure blattanpassen;
var
  prnxy, formxy         : single;
  dx,dy,x,y             : integer;
  blattbreite,
  blatthoehe            : integer;
  scale                 : single;
  xofs,yofs             : single;
begin
  MMproPixelX  := 25.4 / GetdeviceCaps(printer.handle,LOGPIXELSX) ;
  MMproPixelY  := 25.4 / GetdeviceCaps(printer.handle,LOGPIXELSY) ;

  blattbreite := Round(GetdeviceCaps(printer.handle,PHYSICALWIDTH) * MMproPixelX);
  blatthoehe  := Round(GetdeviceCaps(printer.handle,PHYSICALHEIGHT) * MMproPixelY);

  xofs := Round(GetdeviceCaps(printer.handle,PHYSICALOFFSETX)*MMproPixelX);
  yofs := Round(GetdeviceCaps(printer.handle,PHYSICALOFFSETY)*MMproPixelY);

  druckbreite := GetDeviceCaps(printer.handle, horzsize);
  druckhoehe  := GetDeviceCaps(printer.handle, vertsize);
  y := 35;
  x := 10;
  formxy := (form1.clientWidth - x) / (Form1.clientheight - y);

  prnxy := blattbreite / blatthoehe;
  If formxy < prnxy Then
  begin //Breite dominiert
    dx := form1.clientWidth - 20;
    dy := round(dx / prnxy);
    y  := round((Form1.ClientHeight / 2 + 8) - (dy / 2));
  end
  else
  begin                   //Höhe dominiert
    dy := form1.clientHeight - y-10;
    dx := round(dy * prnxy);
    x  := round((form1.clientWidth / 2) - (dx / 2));
  End;
  form1.shape1.setbounds(x,y,dx,dy);
  scale := dy /blatthoehe;
  panelx.setbounds(x+Round(xofs*scale),y+Round(yofs*scale),Round(druckbreite*scale),Round(druckhoehe*scale));
  SetMapMode(blatt.handle,mm_anisotropic);
  SetViewportExtEX(blatt.handle,dx,dy,nil);          // Scalierung
  SetWindowExtEX(blatt.handle,druckbreite*10,-druckhoehe*10,nil);
  Setbkmode(blatt.handle,TRANSPARENT);
  blatt.Brush.Style := bssolid;
  blatt.Brush.Color := clwhite;
  blatt.Pen.Color := clblack;
  blatt.fillrect(bounds(0,0,druckbreite*10,-druckhoehe*10));
end;

procedure ausgabe(ziel : TCanvas);
var
  i,l,n,x,y,breite,hoehe : integer;
  s : string;

begin
  with ziel do
  begin
    font.Height:=50;
    font.Name := 'Arial';
    SetTextAlign(handle,TA_CENTER+TA_TOP);
    breite := druckbreite*10;
    hoehe  := druckhoehe*10;
    moveto(0,1);LineTo(breite,1);
    i := 1;
    while i <= breite do
    begin
      MoveTo(i,-1);
      if (i-1) mod 100 = 0 then
      begin
        LineTo(i,-50);
        TextOut(i,-50,intToStr(i div 100));
      end
      else LineTo(i,-30);
        inc(i,10);
    end;
    SetTextAlign(handle,TA_LEFT+TA_TOP);
    n := 200;
    i := 0;
    x := druckbreite * 5;
    y := druckhoehe * 5;
    while i < 500 do
    begin
      Dec(n,5);
      DC_textout(ziel,x, -y, i, n, '                rotierender Text');
      Inc(i,15);
    end;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  printer.begindoc;
  SetMapMode(printer.canvas.handle,MM_LOMETRIC);
  ausgabe(printer.canvas);
  printer.enddoc
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  printersetupdialog1.execute;
  blattanpassen;
  ausgabe(blatt);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  blattanpassen;
  ausgabe(blatt);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  panelx := TWincontrol.create(self);
  panelx.parent := Form1;
  blatt := TCanvas.Create;
  blatt.handle := GetDC(panelx.handle);
  setmapmode(blatt.handle,mm_anisotropic);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  releaseDC(handle, blatt.handle);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  blattanpassen;
  ausgabe(blatt);
end;

end.