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.