Drucken von Bitmaps / Größenanpassung an Druckercanvas / Wie

[Ricane]

Habe das Problem jetzt komplett gelöst...

Falls es noch andere interessiert, hier die Lösung:

Anmerkungen:

- Ich habe im Quellcode auf Querformat (poLandscape) gestellt, weil das Bild Height = 300 und Width = 400 hat!
- Die -16 ergeben sich daraus, dass das Bild (img) Left = 16 hat und Top = 16 hat!

Delphi-Quellcode:

Procedure TForm1.Button1Click(Sender: TObject);
Var

  Verti, Hori, I: Integer;
  FaktorH, FaktorV: Double;
  Kompos: Array[1..3] Of String;
  Kompo: TComponent;

Begin

  Kompos[1] := 'Label1';
  Kompos[2] := 'Label2';
  Kompos[3] := 'Label3';

  Printer.Orientation := poLandscape;
  Printer.BeginDoc;
  With Printer.Canvas Do
  Begin
    StretchDraw(Printer.Canvas.ClipRect, img.Picture.Graphic);
    Verti := GetDeviceCaps(Printer.Handle, HORZRES);
    Hori := GetDeviceCaps(Printer.Handle, VERTRES);
    FaktorH := Hori / img.Height;
    FaktorV := Verti / img.Width;
    Font.Name := 'MS Sans Serif';
    Font.Size := 8;

    For I := 1 To 3 Do
    Begin
      Kompo := FindComponent(Kompos[I]);
      TextOut(Round(((Kompo As TLabel).Left - 16) * FaktorV),
        Round(((Kompo As TLabel).Top - 16) * FaktorH),
        (Kompo As TLabel).Caption);
    End;
  End;
  Printer.Enddoc;

End;

Beste Grüsse,

Ricane

[mschaefer]

Moin, das hat meine Anerkennung :!:
Prima Lösung und damit kann ich den Thread
als Erfolgreich abgeschlossen einordnen

Danke // Martin

[mschaefer]

Moin, moin,

da war dann doch noch was. Hat man farbige Bitmaps ist StretchDraw eher leidlich und
liefert recht Grobrasterergebnisse. Also das StretchDraw funktioniert nicht korrekt.

Hier kommt jetzt eine Lösung bei der auch das "Strechen" mit farbigen Bitmaps funktioniert.
Ich befürchte aber, das da noch irgendwo ein Speicherbug :mrgreen: drinsteckt.
Denn von Zeit zu Zeit bekomme ich auch Fehlfarben.

Vielleicht weis von Euch jemand Rat...

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;

Viele Grüße // Martin