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

[mschaefer]

Moin, Moin,
also heute habe ich ein Problem, wo ich wirklich gnadenlos hänge:

Habe neben Texten auch eine Bitmap auszudrucken. Das ganze wird
auf den Druckercanvas ausgegeben. Mit den Texten ist das auch kein
Problem. Aber die Bitmap macht mir Probleme.

Die Bitmap ist oft höher aufgelöst als der Canvas, muß aber auf
eine definierte Größe Reampled werden. Wie groß die Bitmap selbst
ist weiß ich eigentlich nicht, da der Benutzer diese selbst auswählen
kann.

FRAGE: Wo finde ich etwas zum Resampling von Bitmaps zum Ausdruck ? :?: :wiejetzt:

Viele Grüße // Martin

[roderich]

schau mal unter

http://g32.org

da hab ich eine library für Delphi her, die u.a. Bitmaps resamplen (interpolieren) kann.

Roderich

[Steve]

TCanvas.StretchDraw könnte Dir evtl. auch weiterhelfen.

Gruß
Stephan

[mschaefer]

Danke,

arbeite mich da erst mal ein und melde mich nochmal

Grüße aus dem sommerlichen ( Ha! Ein Tag unterbrechung der Regenzeit) Hannover

// Martin

[roderich]

Zitat:

TCanvas.StretchDraw könnte Dir evtl. auch weiterhelfen.

Fürs erste sicherlich. StretchDraw interpoliert aber nicht, sondern eliminiert oder addiert ganze Zeilen/Spalten. Ein kleines Bild auf einen großen Canvas gestretcht erzeugt starke Treppenstufen.

Die Funktion aus der g32 library kann u.a. interpolieren mit Anti-Aliasing.

Gruß
roderich

[mschaefer]

Moin, moin,

Hier kommt das StretchDraw Beispiel. Ok das ist im weitesten Sinne "HOFFNUNGSLOS".
Aber nichts für ungut Steve, hat geholfen eine Möglichkeit zu eleminieren.
Eigentlich wollte ich ja nur das SW-Bild ausdrucken. Ok Jetzt brauch ich erstmal
ein Beispiel von der G32-Libary....

:gruebel: :gruebel: :gruebel:

Viele Grüße // Martin

[Ricane]

Moinsen,

ich habe ein ähnliches Problem! Ich möchte ein Bild drucken und dann auf diesem Bild noch ein paar Textfelder... Mit diesem Quellcode druckt er das Bild ohne Problem!

Delphi-Quellcode:

  Printer.BeginDoc;
  With Printer.Canvas Do
  Begin
    Rect := Bounds(0, 0, Printer.PageWidth, Printer.PageHeight);
    StretchDraw(Rect, imgObjekt.Picture.Bitmap);
  End;
  Printer.Enddoc;

Wenn ich aber jetzt den Code für das Drucken der Textfelder einbinde, wird das Bild nicht mehr gedruckt, und die Textfelder viel zu klein...

Der code sieht jetzt so aus..... hat jemand eine Ahnung was da falsch läuft?

Delphi-Quellcode:

  Printer.BeginDoc;
  Printer.Canvas.Font.Name := 'MS Sans Serif';
  Printer.Canvas.Font.Height := 8;

  With Printer.Canvas Do
  Begin
    For I := 1 To AnzahlKompos Do
    Begin
      Kompo := FindComponent('Kompo' + IntToStr(I));
      L := (Kompo As TLabel).Left;
      O := (Kompo As TLabel).Top;
      Text := (Kompo As TLabel).Caption;
      TextOut(L, O, Text);
    End;
    Rect := Bounds(0, 0, Printer.PageWidth, Printer.PageHeight);
    StretchDraw(Rect, imgObjekt.Picture.Bitmap);
  End;
  Printer.Enddoc;

Grüsse,

Ricane

[Ricane]

*schieb - schieb*

Kann es vielleicht daran liegen, das man bei den Textfeldern (der "TextOut" Befehl) auch noch eine Art "StretchDraw" ausführen muss, damit diese auch im richtigen Verhältnis stehen, wie das Bild?!

Oder ist es generell nicht möglich beides auf das selbe Papier zu bringen; und dabei natürlich auch noch gestreckt?!


Hoffe irgend jemand weiss da mehr, denn ich bin bereits stark am verzweifeln :|



Ricane

[Steve]

Servus,

die Schrift ist so winzig, weil Du Height statt Size geändert hast.

Versuch mal Folgendes: Erst Grafik, dann alles, was mit Text zu tun hat..

Delphi-Quellcode:

Printer.BeginDoc;
With Printer.Canvas Do
Begin
  StretchDraw(Printer.Canvas.ClipRect, bmp);
  Font.Name := 'MS Sans Serif';
  Font.Size := 8;
  {.. Textausgabe ..}
End;
Printer.Enddoc;

Bei mir gings so dann. Warum's andersum nicht ging, ist mir leider auch nicht ganz klar :wiejetzt:
[edit]Habe als Rect lieber "TCanvas.ClipRect" benutzt.[/edit]

Ich hoffe, Dein Problem ist damit trotzdem (wenigstens teilweise) gelöst :zwinker:

Gruß
Stephan

[Ricane]

Besten Dank!

Kann es leider hier nicht testen (bin noch @ Work...), bin aber schon sehr gespannt ob das funzt....


Beste Grüsse,

Ricane

[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