Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Auf Windows Fax drucken - Nur ein weißes Blatt (https://www.delphipraxis.net/109351-auf-windows-fax-drucken-nur-ein-weisses-blatt.html)

alleinherrscher 28. Feb 2008 15:18


Auf Windows Fax drucken - Nur ein weißes Blatt
 
Hi@all!

Ich scanne ein Bild ein, und habe es dann in einem Bitmap liegen (ziemlich groß, aber naja.)

Diese Befehle benutzte ich um das Bitmap auf dem Fax zu drucken:

Delphi-Quellcode:
Printername:='Fax';


Printer.PrinterIndex:=Printer.Printers.IndexOf(Printername);

if Printer.Printers[Printer.PrinterIndex]<>Printername then
  if not PrinterSetupDialog1.execute then exit;
 
    with Rect1 do
      begin
        Top:=0;
        Left:=0;
        Bottom:=Printer.PageHeight;
        right:=Printer.PageWidth;
      end;


Printer.BeginDoc;

for i:=0 to aImageList.Count-1 do
begin
  aBitmap:=aImageList.Items[i];
  Printer.Canvas.StretchDraw(rect1,aBitmap);
  if i<> aImageList.count-1 then
    Printer.NewPage;
end;

Printer.EndDoc;
Leider bekomme ich nur leere weiße Blätter im Fax, während, wenn ich anstatt auf das WindowsFax auf meinem Drucker drucke, funktioniert alles wunderbar...

Jemand ne idee woran das liegen kann? Wäre für eine schnelle Hilfe sehr dankbar!
Grüße,

ALleinherrscher

alleinherrscher 28. Feb 2008 15:27

Re: Auf Windows Fax drucken - Nur ein weißes Blatt
 
Hey, ich entschuldige mich hiermit ganz dolle:

Hab die Lösung hier gefunden:
http://www.delphipraxis.net/internal...ht=printer+din

Tut mir irre leid, gehe mich jetzt in die ecke stellen und schämen, dass ich einen Thread dazu aufgemacht hab!

Schönen Tag noch und viele Grüße!

alleinherrscher 28. Feb 2008 16:06

Re: Auf Windows Fax drucken - Nur ein weißes Blatt
 
Liste der Anhänge anzeigen (Anzahl: 1)
Allerdings habe ich noch folgendes Problem: Die bilder kommen nicht richtig auf der Printer.canvas an: das ganze sieht dann hinterher wie folgt aus (siehe anhang) hat jemand eine Idee, woran dies liegen kann??

Ich benutze nun diesen Code um auf die Printercanvas zu schreiben:

Delphi-Quellcode:
procedure EnhStretchDraw
(          Canvas   : TCanvas;
           DestRect : TRect;
           ABitmap  : TBitmap );
var
  Header, Bits : Pointer;
  HeaderSize   : DWord;
  BitsSize     : DWord;
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.Bottom,
        0, 0, ABitmap.Width, ABitmap.Height, Bits,TBitmapInfo(Header^),
        DIB_RGB_COLORS, SRCCOPY);
  finally
    FreeMem(Header);
    FreeMem(Bits);
  end;
end;
//edit: Richtig eingescannt werden Sie hingegen schon! Nur auf dem Fax wirds nicht richtig angezeigt!

alleinherrscher 29. Feb 2008 10:33

Re: Auf Windows Fax drucken - Nur ein weißes Blatt
 
Wie ich soeben rausgefunden habe, handelt es sich um einen Fehler in von 1997 von Borland vorgestellten Routine. (vgl. http://www.delphipraxis.net/internal...=stretchdibits)

Zitat:

Zitat von generic
der obige code macht bei uns unter winxp probleme. wir drucken schwarz/weiss bitmaps und es kommt manchmal vor das die strechbld eine weiss oder schwarze seite druckt.
ich hab bei uns auf gdi+ umgestellt.
der fehler tritt nur auf wenn man viel druckt und ist leider nicht repoduzierbar.


Weiß jemand, etwas auf die Printer.canvas drucken kann OHNE dabei StretchDIBits (scheinbar mit Fehler behaftet) oder StrechDraw (Funktioniert ja nicht bei allen Printer.canvas) zu verwenden?

Bzw. kennt jemand eine Möglichkeit, StretchBiBits zu verwenden ohne dass der Fehler (wie oben im Anhang) auftritt?

Es wäre echt super, wenn ihr mir helfen könntet!

Union 29. Feb 2008 12:06

Re: Auf Windows Fax drucken - Nur ein weißes Blatt
 
Schu Dir mal diesen Beitrag an.

alleinherrscher 29. Feb 2008 20:36

Re: Auf Windows Fax drucken - Nur ein weißes Blatt
 
Danke, Union, aber das is auch nicht das Problem. Ich habe nach langem googlen Abhilfe gefunden:

Man muss anstatt GetMem bei Windows XP GlobalAlloc benutzen:

Delphi-Quellcode:
PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap:TBitmap);

VAR BitmapHeader            : pBitmapInfo;
    BitmapImage             : POINTER;
    HeaderSize              : DWORD;   // Use DWORD for D3-D5 compatibility
    ImageSize               : DWORD;
    kopierte_Zeilen         : integer;
    alles_ok                : boolean;
    OldMode                 : integer;
    InfoHandle, ImageHandle : THandle;

BEGIN
  GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);

  // Anstelle von GetMem wird hier GlobalAlloc und GlobalLock verwendet,
  // da bei Verwendung von GetMem auf einigen Druckern sporatischentweder
  // eine scharze Grafikfläche oder eine weiße Grafikfläche anstelle der
  // Grafik selbst gedruckt wird.

  //GetMem(BitmapHeader, HeaderSize);
  //GetMem(BitmapImage, ImageSize);
  InfoHandle := GlobalAlloc(HeapAllocFlags, HeaderSize);
  BitmapHeader := GlobalLock(InfoHandle);
  ImageHandle := GlobalAlloc(HeapAllocFlags, ImageSize);
  BitmapImage := GlobalLock(ImageHandle);

  TRY
    alles_ok := GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^,BitmapImage^);
    if not alles_ok then
      MessageDlg('Bitmap copy error!', mtWarning, [mbOk], 0);
    OldMode := SetStretchBltMode(Canvas.Handle, COLORONCOLOR);
    kopierte_Zeilen := StretchDIBits(Canvas.Handle,
                  DestRect.Left, DestRect.Top,        // Destination Origin
                  DestRect.Right - DestRect.Left,   // Destination Width
                  DestRect.Bottom - DestRect.Top, // Destination Height
                  0, 0,                                                 // Source Origin
                  Bitmap.Width, Bitmap.Height,        // Source Width & Height
                  BitmapImage,
                  TBitmapInfo(BitmapHeader^),
                  DIB_RGB_COLORS,
                  SRCCOPY);
    if kopierte_Zeilen < 1 then
      begin
      if GetLastError <> NoError then
        MessageDlg(SysErrorMessage(getLastError), mtWarning, [mbOk],0);
    end;
    SetStretchBltMode(Printer.Canvas.Handle, OldMode);

  FINALLY

  //  FreeMem(BitmapHeader);
  //  FreeMem(BitmapImage)
  GlobalUnlock(ImageHandle);
  GlobalFree(ImageHandle);
  GlobalUnlock(InfoHandle);
  GlobalFree(InfoHandle);

  END
END {PrintBitmap};
Hoffe, dass dieser Thread wenigstens den Leuten hilft, die nach mir dieses Problem haben!

Gute nacht!


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:53 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz