Entwickler-Ecke

Delphi Language (Object-Pascal) / CLX - PaintBox->Canvas drucken?


jackie05 - Do 03.10.13 23:53
Titel: PaintBox->Canvas drucken?
Hallo,
ich habe ein Problem mit dem drucken von PaintBox->Canvas.

Das drucken funktioniert, nur das es ca. 3x größer ist, wie in PaintBox.

Hier ist mal der Code:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
  with Printer do
  begin
    Orientation := poLandscape;
    BeginDoc;
    Canvas.CopyMode := cmSrcCopy;
    Canvas.CopyRect(Rect(0,0,PageWidth,PageHeight),
                    PaintBox1.Canvas,
                    Rect(0,0,PaintBox1.Width,PaintBox1.Height));
    EndDoc;
  end;


Wie kann ich das so einstellen, das es nicht so extrem gross ausdruckt, sondern so ca. wie auf dem Bildschirm zusehen ist?

Ich danke euch schonmal für die Hilfe.

MfG


Mathematiker - Fr 04.10.13 00:00

Hallo,
user profile iconjackie05 hat folgendes geschrieben Zum zitierten Posting springen:
Das drucken funktioniert, nur das es ca. 3x größer ist, wie in PaintBox.
...

Delphi-Quelltext
1:
2:
3:
...    Canvas.CopyRect(Rect(0,0,PageWidth,PageHeight),
                    PaintBox1.Canvas,
                    Rect(0,0,PaintBox1.Width,PaintBox1.Height));


Du druckst die Höhe Deiner Paintbox auf die Höhe der Seite, analog die Paintboxbreite auf die Seitenhöhe.
Im Allgemeinen werden die Verhältnisse Papierhöhe/Paintboxhöhe und Papierbreite/Paintboxbreite nicht gleich sein, wodurch es zu Verzerrungen kommt. Du müsstest für beide Verhältnisse gleiche Werte wählen, höchstwahrscheinlich das kleinere Verhältnis der beiden.
Nebenbei "with" ist nicht so schön. Besser wäre jeweils printer. voranzusetzen.

Beste Grüße
Mathematiker


jaenicke - Sa 05.10.13 17:59

Nicht nur das, auch die unterschiedliche Pixeldichte muss dabei beachtet werden. Beim Ausdruck muss das daher gegen die dpi-Werte skaliert werden.


jackie05 - So 06.10.13 20:30

Vielen Dank.

Genau das ist auch noch das Problem, es ist auch etwas verpixelt, wenn ich den Inhalt von PaintBox->Canvas ausdrucke.

Könntest du mir Vielleicht einen beispiel posten, wie ich das mit dem Drucken ambesten lösen kann?

Danke schonmal.

MfG


Mathematiker - So 06.10.13 21:35

Hallo,
es ist etwas umfangreicher, aber druckt den Inhalt einer Paintbox maßstabsgerecht auf die maximale Breite einer Seite.
Willst Du es senkrecht drucken, musst Du noch die Druckerorientierung ändern.


Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
//Drucken des Bitmaps 
PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
  VAR
    BitmapHeader: pBitmapInfo;
    BitmapImage : POINTER;
    HeaderSize  : DWORD;
    ImageSize   : DWORD;
BEGIN
    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
    GetMem(BitmapHeader, HeaderSize);
    GetMem(BitmapImage, ImageSize);
    TRY
      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
      StretchDIBits(Canvas.Handle,
        DestRect.Left, DestRect.Top,
        DestRect.Right - DestRect.Left,
        DestRect.Bottom - DestRect.Top,
        00,
        Bitmap.Width, Bitmap.Height,
        BitmapImage,
        TBitmapInfo(BitmapHeader^),
        DIB_RGB_COLORS,
        SRCCOPY)
    FINALLY
      FreeMem(BitmapHeader);
      FreeMem(BitmapImage)
    END
END;

//Maße holen und Druckrechteck ermitteln
procedure normaldruck(image:timage);
var
  ScaleX,ScaleY:real;
  limog,obmog,lioff,oboff,reoff : Integer;
  R: TRect;
begin
    Printer.BeginDoc;

      try
        limog:=GetDeviceCaps(printer.Handle, physicaloffsetx);
        lioff:=round(lidruck*GetDeviceCaps(printer.Handle,logPixelsX)/25.4)-limog;
        if lioff<0 then lioff:=0;
        reoff:=round(redruck*GetDeviceCaps(printer.Handle,logPixelsX)/25.4)-limog;
        if reoff<0 then reoff:=0;
        obmog:=GetDeviceCaps(printer.Handle, physicaloffsety);
        oboff:=round(obdruck*GetDeviceCaps(printer.Handle,logPixelsY)/25.4)-obmog;
        if oboff<0 then oboff:=0;
        ScaleX := GetDeviceCaps(printer.Handle, logPixelsX)/PixelsPerInch;
        ScaleY := GetDeviceCaps(printer.Handle, logPixelsY)/pixelsPerInch;
        while scalex*image.picture.width>(printer.pagewidth-lioff-reoff) do
        begin
          scalex:=scalex-0.02;
          scaley:=scaley-0.02;
        end;
        if scalex<=0 then scalex:=1;
        if scaley<=0 then scaley:=1;
        R := Rect(lioff, oboff, round(lioff+Image.Picture.Width * ScaleX),
                  round(oboff+Image.Picture.Height * ScaleY));
        printbitmap(printer.canvas,R,Image.Picture.bitmap)
      finally
        printer.EndDoc;
      end;
end;

//Bitmap von Paintbox erzeugen
procedure bilddrucken(const paintbox:tpaintbox);
var Bitmap: TBitmap;
    birect:trect;
    image:timage;
begin
    image:=timage.create(nil);
    image.autosize:=true;
    Bitmap := TBitmap.Create;
    Bitmap.Width := paintbox.Width;
    Bitmap.Height := paintbox.Height;
    birect:=paintbox.clientrect;
    bitmap.canvas.CopyRect(biRect,paintbox.Canvas,biRect);
    try
      image.picture.Assign(Bitmap);
      normaldruck(image);
    finally
      Bitmap.Free;
      image.Free;
    end;
end;

lidruck, redruck und obdruck sind eingestellte Ränder links, rechts und oben auf dem Blatt in mm gerechnet.
Ich hoffe, dass ich nichts vergessen habe (z.B. irgendwelche Variablen), da ich die Routinen aus einem größeren Projekt kopiert habe.

Beste Grüße
Mathematiker


jackie05 - So 06.10.13 21:55

Vielen Dank für deine Mühe, ich werde es gleich mal testen.

Noch eine Frage:
Ich möchte gerne die PaintBox Komponent auf Din A6 einstellen, und diese soll dann in Din A6 Format gedruckt werden, also nicht auf komplette Seite vom Drucker Papier (Din A4) übernehmen.

Wie könnte man das ambesten anstellen ohne Qualitätverlust?

MfG