Bitmaps drucken geht nicht...

[Ulf Mielke]

habe ja nun wirklich alles versucht.
Hier der Quelltext:

procedure TAuftragform.Drucktest1Click(Sender: TObject);<br>
var kopfbild: TBitmap;<br>
begin<br>
kopfbild := tbitmap.create;<br>
kopfbild.loadfromfile('kopf.bmp');<br>
printer.begindoc;<br>
with printer.canvas do begin<br>
moveto(0,0);<br>
SetMapMode(printer.canvas.handle, mm_lometric);<br>
draw(250, -1000, kopfbild);<br>
end;<br>
printer.enddoc;<br>
kopfbild.free;<br>
end;<br>

ich bekomme alle möglichen Ergebnisse. Es druckt gar nicht, an der falschen Stelle, <br>
auf dem Kopf, Seitenverkehrt... Wer weiß Rat ??

[Dirk Zschenderlein]

Hallo Ulf, <p>
ich habe Deine Routine ausprobiert. Ohne <b>SetMapMode</b> funktioniert es bei mir auf den verschiedensten Druckern.<br>
Mit <b>SetMapMode</b> kam es zu der verkehrten Ausgabe.<br>
Es liegt wahrscheinlich in den Unterroutine von Draw welche das bewirken.<br>
Muss es den unbedingt in 10tel mm gedruckt werden? Du kannst Dir das doch auch in Pixeln zusammenbauen. Es muessen lediglich die Druckereinstellungen vor dem Ausdruck ermittelt werden. das mache ich auch bei manchen sachen. <br>
Viel Erfolg. Gruss dirk

es handelt sich um eine sehr umfangreiche Datenbankanwendung (Auftragsabwicklung),<br>
mit Stücklisten usw. Die Druckroutinen habe ich letzendlich alle "zu Fuß" <br>
geschrieben, da kein Listengenerator den benötigten Funktionsumfang leisten <br>
konnte. So habe ich die Listen mit Papier und Bleistift "layoutet" und per Lineal
die Maße übertragen. Das fertige Layout, incl. Bitmaps (Briefköpfe usw.) ist nun so <br>
ziemlich das letzte, was an den Druckfuntionen noch fehlt.<br>
Ich hatte nur gehofft daß es einen Workaround gibt...<br>
ich werde sonst wohl wiklich pixelweise koperen müssen. <br>

Danke
Ul

[Dirk Zschenderlein]

Hallo, <p>
wenn es nicht anders geht als im MM_LOMETRIC zu arbeiten habe ich hier noch eine moegliche Loesung.<p>
Gruss Dirk.<p>

procedure TForm1.ButtonDruckClick(Sender: TObject);<br>
Var x,y,i:Integer;<br>
Rect:TRect;<br>
DruckerDpi:Integer;<br>
dcP:Thandle;<br>
<br>
Function mmToPixel(mm:real):Integer;<br>
// Rechnet eine mm Angabe in Pixel um...<br>
Begin mmToPixel:=Round(DruckerDPI/25.4*mm); End;<br>
<br>
Begin<br>
kopfbild := TImage.create(Self);<br>
kopfbild.Picture.LoadFromFile(OpenPictureDialog1.F ileName);<br>
If PrintDialog1.Execute Then<br>
Begin<br>
// Eingabe der Position<br>
Try X:=Round(StrToFloat(Edit1.Text)*100); Except x:=250; End;<br>
Try Y:=Round(StrToFloat(Edit2.Text)*100); Except y:=-1000;End;<br>
<br>
dcP:=Printer.Handle;<br>
DruckerDpi:=GetDeviceCaps(dcP,logpixelsx);<br>
printer.begindoc;<br>
Try<br>
with printer.canvas do<br>
begin<br>
// Alles mit 10tel mm drucken<br>
SetMapMode(printer.canvas.handle, mm_lometric);<br>
Brush.Color:=clWhite;<br>
Font.Name:='ARIAL';<br>
Font.Height:=25;<br>
// Mal ein Lineal zeichnen<br>
For i:=1 To 20 Do<br>
Begin<br>
MoveTo(100,-(I*100)); LineTo(200,-(I*100));<br>
TextOut(100,-((I*100)+2),IntToStr(I)+' cm');<br>
End;<br>
For i:=1 To 20 Do<br>
Begin<br>
MoveTo(100,-((I*100)+50)); LineTo(150,-((I*100)+50));<br>
TextOut(100,-((I*100)+52),IntToStr(I)+',5 cm');<br>
End;<br>
Font.Name:='ARIAL';<br>
Font.Height:=50;<br>
TextOut(X,-100,'X: '+FloatToStr(X/100)+' cm - Y: '<br>
+FloatToStr(y/100)+' cm Druckerauflösung: '<br>
+IntToStr(DruckerDpi)+' Dpi');;<br>
// Das 10tel mm-Bild umranden...<br>
Rect:=Bounds(X-10,-(Y+10),kopfbild.Picture.Width+20,kopfbild.Picture. Height+20);<br>
Brush.color:=clred;<br>
Rectangle(Rect);<br>
<br>
// Neue Recheck in welches das Bild auf die Druckerauflösung "skaliert" wird<br>
// Die obigen Funktionen interpretieren 1 Pixel = 0.1 mm,<br>
// Das soll hier auch so sein<br>
// X,Y ist die obere linke Ecke des Bildes !<br>
Rect:=Bounds(mmToPixel(X/10),<br>
mmToPixel(Y/10),<br>
mmToPixel(kopfbild.Picture.Width/10),<br>
mmToPixel(kopfbild.Picture.Height/10));<br>
// Mal kurz MapMode ändern<br>
SetMapMode(printer.canvas.handle,MM_TEXT);<br>
StretchDraw(Rect,kopfbild.Picture.Graphic);<br>
<br>
// Draw zeichnet nach oben wegen des Koordinatenursprungs links oben<br>
// X,Y ist die untere linke Ecke des Bildes !<br>
SetMapMode(printer.canvas.handle,MM_LOMETRIC);<br>
draw(X,-Y, kopfbild.Picture.Graphic);<br>
end;<br>
Finally<br>
printer.enddoc;<br>
kopfbild.free;<br>
End;<br>
End;<br>
end;<br&gt

[Ulf Mielke]

Danke für die Antwort. <br>
Soweit funktioniert das auch, solange es nur eine Grafik ist.<br>
verusche oich mehrere Grafiken auf eine Seite zu drucken, geht auch das wieder schief.<br>
Es wird (fast) immer nur eine Grafik gedruckt. Manchmal auch zwei, aber nie reproduzierbar. Beim wiederaufrufen derselben Routine kann das Ergebnis schon ganz anders aussehen.

Was ist da los ?

(..wär' ich mal bei dBase geblieben...

[Jürgen Kortt]

&#10

[Jürgen Kortt]

Hallo,

ich habs ausprobiert und es funktionniert.
Aber es funktioniert nur, wenn ich das Bild mit LoadFromFile lade.
Wenn ich <br>
kopfbild.Picture.Bitmap := Form1.GetFormImage;<br>
anstatt <br>
kopfbild := TImage.create(Self);<br>
kopfbild.Picture.LoadFromFile(OpenPictureDialog1.F ileName);<br>
benutze, dann hab ich nur einen roten Strich am oberen Rand des Blattes (Druckvorschau von FinePrint), aber kein Bild.
<p>
Kann mir da jemand helfen ?

Jürgen Kort

[KarstenKattner]

Unter D2 war/ist ein Fehler. Ich verwende folgendes Borland FAQ
Leider gehts in D5 immer noch nicht besser mint Timage.

Ich suche dringend aber eine Lösung für JPG

unit Print_me;

interface
uses graphics,WinTypes ;

procedure BltTBitmapAsDib(DestDc : hdc; {Handle of where to blt}
x : word; {Bit at x}
y : word; {Blt at y}
Width : word; {Width to stretch}
Height : word; {Height to stretch}
bmp : graphics.TBitmap); {the TBitmap to Blt}

implementation

{
Frequently Asked Questions
Sending an image to the printer
Question:
How can I reliably print an image to the printer?
Answer:
Sending a bitmap based on the screen to the printer is an
invalid operation that will usually fail, unless the print
driver has been designed to detect this error condition and
compensate for the error. This means you should use the VCL
canvas methods Draw, StretchDraw,CopyRect, BrushCopy, and
the like to transfer a bitmap to the printer, since the
underlying bitmap is based on the screen, and is device
dependent. The only way to reliably print an image is to
use DIBs (Device Independent Bitmaps). Getting a valid DIB can
be difficult, as there are many Windows API functions that must
be used correctly. Further, many video drivers incorrectly fill
in the DIB structure in regards to the color table in the DIB.

The following example demonstrates an attempt to overcome
some of these problems and limitations. The example should
compile successfully under all versions of Delphi/C++ Builder.

The core function in the example, BltTBitmapAsDib(), accepts
a handle to a device to image to, the x and y coordinates you
wish the bitmap to be imaged at, the width and height you wish
the image to be (stretching and shrinking is acceptable), and
the TBitmap you wish to image.

Example:
}
uses Printers;

type
PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
TPalEntriesArray = array[0..0] of TPaletteEntry;

procedure BltTBitmapAsDib(DestDc : hdc; {Handle of where to blt}
x : word; {Bit at x}
y : word; {Blt at y}
Width : word; {Width to stretch}
Height : word; {Height to stretch}
bmp : graphics.TBitmap); {the TBitmap to Blt}
var
OriginalWidth :LongInt; {width of BM}
dc : hdc; {screen dc}
IsPaletteDevice : bool; {if the device uses palettes}
IsDestPaletteDevice : bool; {if the device uses palettes}
BitmapInfoSize : integer; {sizeof the bitmapinfoheader}
lpBitmapInfo : PBitmapInfo; {the bitmap info header}
hBm : hBitmap; {handle to the bitmap}
hPal : hPalette; {handle to the palette}
OldPal : hPalette; {temp palette}
hBits : THandle; {handle to the DIB bits}
pBits : pointer; {pointer to the DIB bits}
lPPalEntriesArray : PPalEntriesArray; {palette entry array}
NumPalEntries : integer; {number of palette entries}
i : integer; {looping variable}
begin
{If range checking is on - lets turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie: if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer i, we can now access a[3] by setting}
{i := 3; and then accessing a[i] without error}

{Save the original width of the bitmap}
OriginalW

[Stefan Hofmann]

Hallo Ulf,

ich hatte nach dem GDI-Befehl SetMapMode ebenfalls keine repruduzierbare Ergebnisse, bis ich Application.ProcessMessages hinter jeden GDI-Befehl gesetzt habe.

Mfg, Stefa

[Michael Eicher]

Hier ein Code der garantiert funktioniert

procedure TPrintFormPage.CopyBmpRect(Canvas: TCanvas; const DestRect: TRect; ABitmap: TBitmap;
const SourceRect: TRect);
var
Header, Bits: Pointer;
HeaderSize, BitsSize: Cardinal;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
GetMem(Header, HeaderSize);
GetMem(Bits, BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top,
DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top,
SourceRect.Left, SourceRect.Top,
SourceRect.Right - SourceRect.Left, SourceRect.Bottom - SourceRect.Top,
Bits, TBitmapInfo(Header^),
DIB_RGB_COLORS, Canvas.CopyMode);
finally
FreeMem(Header);
FreeMem(Bits);
end;
end