Image.Canvas wird invers gedruckt...

[Namenloser]

Am besten wäre es, die Zeichenroutine so zu gestalten, dass sie auf ein beliebiges Canvas zeichnen kann, und dann das Drucker-Canvas zu übergeben. Das sollte ziemlich sicher auf jedem Drucker funktionieren und hat den Vorteil, dass es effizienter ist, weil nur die Zeichenbefehle an den Drucker übertragen werden und nicht ein Bitmap Pixel für Pixel (langsam). Außerdem wird die Bitmap-Lösung immer recht pixelig aussehen, da der Monitor eine deutlich geringere Auflösung hat als der Drucker.

Delphi-Quellcode:

procedure Draw(Dest: TCanvas);
begin
  // ...
end;

// Für GUI:
Draw(Image1.Picture.Bitmap.Canvas);

// Zum Drucken:
Draw(Printer.Canvas);

(Dabei muss natürlich auf die Skalierung geachtet werden wegen der unterschiedlichen Auflösungen.)

Damit wäre auch die Logik von der Darstellung getrennt. Direkt Daten aus GUI-Controls zu verwenden ist immer Gefrickel, das aus gutem Grund vermieden werden sollte.

Wenn das aus irgendeinem Grund nicht geht, würde ich es so versuchen:

Delphi-Quellcode:

var
  Tmp: TBitmap;
begin
  Tmp := TBitmap.Create;
  try
    // Wir zeichnen das Bild erst auf einen weißen Hintergrund, und das Ergebnis dann auf
    // das Drucker-Canvas

    Tmp.SetSize(Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
    Tmp.Canvas.Brush.Color := clWhite;
    Tmp.Canvas.FillRect(Rect(0, 0, Tmp.Width, Tmp.Height);

    // Image1.Transparent := True; ?
    Tmp.Canvas.Draw(0, 0, Image1.Picture.Bitmap); // Canvas.Draw beachtet Transparenz von Bitmaps

    Printer.BeginDoc;
    Printer.Canvas.StretchDraw(Bounds(10,10,printer.pagewidth,printer.pageheight), Tmp);
    Printer.EndDoc;
  finally
    Tmp.Free;
  end;
end;

Wäre aber nur eine Art Hotfix bzw. eine Notlösung...

[Bummi]

Noch eine recht dankbare Methode, wenn man keine eigenen Komponenten hat denen man das Canvas vor dem Zeichnen/Drucken austauscht sind Metafiles.
Als Vektorgrafiken können sie verlustfrei skaliert werden.
Zeichnen im Metafile, darstellen in einem TImage ..

Delphi-Quellcode:

  public
    { Public-Deklarationen }
    FMF:TMetafile;

  end;

var
  Form1: TForm1;

implementation
Const
  C_WishedWidth=2900;
  C_WishedHeight=2100;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 i:Integer;
 Mfc: TMetaFileCanvas;
 x,y:Integer;
begin
  Mfc := TMetaFileCanvas.Create(FMF, 0);
  for I := 0 to 100 do
      begin
        Mfc.Font.Color := RGB(random(255),Random(255),Random(255));
        Mfc.Pen.Color := RGB(random(255),Random(255),Random(255));


        Mfc.Brush.Style := bsClear;
        Mfc.Textout(random(2800),Random(2000),Format('Test %d',[i]));
        Mfc.Brush.Style := bsSolid;
        Mfc.Brush.Color := RGB(random(255),Random(255),Random(255));
        x := Random(2800);
        y := Random(2000);
        Mfc.Ellipse( x,y,
                     x+ Random(200),
                     y+Random(200)
                     );
      end;
  Mfc.Free;
  image1.Picture.Assign(FMF);
  if Checkbox1.Checked then
    begin
      Printer.Orientation := poLandScape;
      Printer.Begindoc;
      Printer.Canvas.StretchDraw(Rect(0,0,Printer.PageWidth,printer.PageHeight),FMF);
      Printer.EndDoc;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   FMF:=TMetafile.Create;
   FMF.Width := C_WishedWidth;
   FMF.Height := C_WishedHeight;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    FMF.Free;
end;

[shmia]

Was braucht man um ein Bitmap zu drucken??
* Ein Bitmap
* ein Rechteck in das das Bitmap gedruckt werden soll
* ein Printer-Handle oder ein Printer-Objekt

Und jetzt MUSS jedem der Geistesblitz kommen:
Man bräuchte eine Prozedur mit genau diesen Parametern.

Wenn man eine unabhängige Prozedur hätte, dann könnte man sogar den Code in eine andere Anwendung kopieren.
Und vielleicht könnte man dann sogar auf verschiedenen Rechnern und mit verschiedenen Druckern testen bis man den Code entwickelt hat, der immer korrekt druckt.

Hmmmm, vielleicht gibt es das schon im Internet?
http://www.swissdelphicenter.ch/de/showcode.php?id=744


Sorry für meinen "seltsamen" Schreibstil, aber ich finde meine Überlegungen sind so einfach, dass eigentlich jeder auf diesen Trichter kommen müsste.

[andydp]

@Bummi: Image1.Picture.Bitmap.PixelFormat:=pf24bit; hat leider auch nichts gebracht.

Danke für die Infos Leute!

Möchte den Code nicht unbedingt umschreiben. Es muss doch eine Erklärung geben, weshalb die Eigenschaft "Transparent" auf einem einzigen Rechner ein solcher Ausdruck produziert.

Wie gesagt, wenn ich Transparent vor dem Ausdruck nicht auf True stelle, habe ich auf dem Problemrechner einen korrekten Ausdruck. Dafür erscheint die Grafik auf den andern Testrechnern als weisses Blatt

[andydp]

So Leute, hab die Lösung dank shmia gefunden

Hab mir dein Code von SwissDelphiCenter geholt und in meinen Source eingebaut und siehe da, es läuft auf allen Rechnern (und dies erst noch beliebig skalierbar)

Code:

procedure TTemperaturdaten.DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var
  Header, Bits: Pointer;
  HeaderSize: DWORD;
  BitsSize: DWORD;
begin
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  Header := AllocMem(HeaderSize);
  Bits := AllocMem(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, HeaderSize);
    FreeMem(Bits, BitsSize);
  end;
end;

procedure TTemperaturdaten.PrintImage(Image: TImage; ZoomPercent: Integer);
  // if ZoomPercent=100, Image will be printed across the whole page
var
  relHeight, relWidth: integer;
begin
  Screen.Cursor := crHourglass;
  Printer.Orientation := poLandscape;
  Printer.BeginDoc;
  with Image.Picture.Bitmap do
  begin
    if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then
    begin
      // Stretch Bitmap to width of PrinterPage
      relWidth := Printer.PageWidth;
      relHeight := MulDiv(Height, Printer.PageWidth, Width);
    end
    else
    begin
      // Stretch Bitmap to height of PrinterPage
      relWidth  := MulDiv(Width, Printer.PageHeight, Height);
      relHeight := Printer.PageHeight;
    end;
    relWidth := Round(relWidth * ZoomPercent / 100);
    relHeight := Round(relHeight * ZoomPercent / 100);
    DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);
  end;
  Printer.EndDoc;
  Screen.cursor := crDefault;
end;

procedure TTemperaturdaten.SpeedButton10Click(Sender: TObject);
Var rect:TRect;
    Tmp_String:String;
Begin
if ((Daten_ok) AND (Abbruch=False)) then
 begin
  if(Mode=MD_TEMP_DATEN) then
   begin
     PrintImage(Image1, 100);    
   end;
  end;
end;

Herzlichen Dank für Eure Mithilfe.
Wünsche Euch einen gemütlichen Feierabend...