Gemischtes Drucken RichEdit, TextOut, MoveTo, LineTo auf einer Seite - Schriftgrößenproblem

[Roland Reimann]

Hallo,

ich habe folgendes Problem mit dem gemischten Drucken diverser Inhalte
auf einer Seite, also innerhalb eines BeginDoc und EndDoc.

Zunächst wird Text (TextOut) und Graphik (MoveTo, LineTo) auf die
PrinterCanvas gedruckt.
Dann werden formatierte RichEdit-Inhalte dazu gedruckt. Dies passiert
mit der unten angehängten Funktion. Diese Funktion schaltet auf einen
anderen MapMode (auf MM_Text, vorher MM_HIMETRIC), druckt den
RichEdit-Text mit EM_FORMATRANGE und schaltet danach wieder auf den
ursprünglichen MapMode zurück.

Bis hierhin funktioniert alles einwandfrei.

Wird nach dem Drucken eines RichEdit-Textes aber wieder normaler Text
gedruckt (mit TextOut), dann kann ich die Schriftgröße des mit TextOut
gedruckten Textes nicht mehr verändern. Das Verändern von
Printer.Canvas.Font.Height hat keinen Effekt mehr.

Was muss nach dem Drucken des RichEdits rückinitialisiert werden,
damit die Schriftgröße für TextOut wieder verändert werden kann?

Das zwischenzeitliche Verändern des MapMode funktioniert übrigens
einwandfrei. Dies ist durch MoveTo LineTo im ursprünglichen
MapMode-Koordinatensystem verifiziert.

Ich bin für jeden Hinweis dankbar.
(System: XE4, Win7)

Gruß
Roland

Funktion zum Drucken eines RichEdit-Textes:


// Quelle: http://flocke.vssd.de/prog/tips/pascal/prtred/
// Leicht modifiziert
function PrintRichEditIntoRect(RichEditHandle : HWND;
PageRect : TRect;
RectScaling : Integer;
StartPos : Integer;
EndPos : Integer;
var bisYMM : integer): Integer;
var
Range: TFormatRange;
mm, lpx, lpy, pox, poy: Integer;

begin
// Druck bis mm initialisieren :
bisYmm := 0;

// Handle zuweisen :
Range.hdc := Printer.Handle;
Range.hdcTarget := Range.hdc;

// Get printer resolution
lpx := 100 * GetDeviceCaps(Range.hdc, LOGPIXELSX);
lpy := 100 * GetDeviceCaps(Range.hdc, LOGPIXELSY);

// Convert to device coordinates
if RectScaling <> PageRect_Printer then
begin
// Get physical printing offset
pox := GetDeviceCaps(Range.hdc, PHYSICALOFFSETX);
poy := GetDeviceCaps(Range.hdc, PHYSICALOFFSETY);

if RectScaling < 0 then
begin
Range.rc.Left := MulDiv(PageRect.Left, lpx, -RectScaling) - pox;
Range.rc.Top := MulDiv(PageRect.Top, lpy, -RectScaling) - poy;
Range.rc.Right := GetDeviceCaps(Range.hdc, PHYSICALWIDTH) -
MulDiv(PageRect.Right, lpx, -RectScaling);
Range.rc.Bottom := GetDeviceCaps(Range.hdc, PHYSICALHEIGHT) -
MulDiv(PageRect.Bottom, lpy, -RectScaling);
end
else
begin
Range.rc.Left := MulDiv(PageRect.Left, lpx, RectScaling) -
pox;
Range.rc.Top := MulDiv(PageRect.Top, lpy, RectScaling) -
poy;
Range.rc.Right := MulDiv(PageRect.Right, lpx, RectScaling) -
pox;
Range.rc.Bottom := MulDiv(PageRect.Bottom, lpy, RectScaling) -
poy;
end;
end
else
Range.rc := PageRect;

// Convert to twips
Range.rc.Left := MulDiv(Range.rc.Left, 144000, lpx);
Range.rc.Top := MulDiv(Range.rc.Top, 144000, lpy);
Range.rc.Right := MulDiv(Range.rc.Right, 144000, lpx);
Range.rc.Bottom := MulDiv(Range.rc.Bottom, 144000, lpy);

Range.rcPage := Range.rc;
Range.chrg.cpMin := StartPos;
Range.chrg.cpMax := EndPos;

// Es wird kurzzeitig auf MM_Text geschaltet um später wieder auf
den
// Ursprünglichen MapMode zurück :
mm := SetMapMode(Printer.Handle, MM_Text);
try
SendMessage(RichEditHandle, EM_FORMATRANGE, 0, 0);
Result := SendMessage(RichEditHandle, EM_FORMATRANGE, 1,
Integer(@Range));
if Result < 0 then
Result := SendMessage(RichEditHandle, WM_GETTEXTLENGTH, 0, 0);

if RectScaling < 0 then
begin

end
else
begin
bisYMM := round(((Range.rc.Bottom*lpy/144000) + poy) *
RectScaling / lpy);
end;

finally
SendMessage(RichEditHandle, EM_FORMATRANGE, 0, 0);
SetMapMode(Printer.Handle, mm);
end;
end;

[Hans-Peter Diettrich]

Post by Roland Reimann
Wird nach dem Drucken eines RichEdit-Textes aber wieder normaler Text
gedruckt (mit TextOut), dann kann ich die Schriftgröße des mit TextOut
gedruckten Textes nicht mehr verändern. Das Verändern von
Printer.Canvas.Font.Height hat keinen Effekt mehr.

Vielleicht hilft es, (vorübergehend) einen anderen Font einzustellen?

DoDi

[Roland Reimann]

Antwort auf eine Nachricht von Hans-Peter Diettrich
<***@aol.com> vom Fri, 05 Dec 2014 11:00:36 +0100 :

Hallo Hans-Peter,

Post by Hans-Peter Diettrich

Post by Roland Reimann
Wird nach dem Drucken eines RichEdit-Textes aber wieder normaler Text
gedruckt (mit TextOut), dann kann ich die Schriftgröße des mit TextOut
gedruckten Textes nicht mehr verändern. Das Verändern von
Printer.Canvas.Font.Height hat keinen Effekt mehr.

Vielleicht hilft es, (vorübergehend) einen anderen Font einzustellen?

genial, funktioniert.

Aber wie kommt man denn auf diese Idee?

Sich die kompletten Fonteinstellungen von vorher zu merken und nachher
wieder zu setzen funktioniert nämlich NICHT:
FontVorher := Printer.Canvas.Font;
RichEditDrucken;
Printer.Canvas.Font; := FontVorher;

Gruß und vielen Dank
Roland

[Achim Kalwa]

Hallo,

Post by Roland Reimann
Sich die kompletten Fonteinstellungen von vorher zu merken und nachher
FontVorher := Printer.Canvas.Font;
RichEditDrucken;
Printer.Canvas.Font; := FontVorher;

Du könntest mal versuchen, Die Windows-API-Funktionen SaveDC/RestoreDC
zu verwenden:

var
SavedSettings : Integer;

begin
SavedSettings := SaveDC(Printer.Handle);
RichEditDrucken;
RestoreDC(Printer.Handle, SavedSettings);


HTH
Achim

[Roland Reimann]

Antwort auf eine Nachricht von Achim Kalwa
<***@achim-kalwa.de> vom Fri, 05 Dec 2014 14:06:00 +0100 :

Hallo Achim,

Post by Achim Kalwa
Du könntest mal versuchen, Die Windows-API-Funktionen SaveDC/RestoreDC
var
SavedSettings : Integer;
begin
SavedSettings := SaveDC(Printer.Handle);
RichEditDrucken;
RestoreDC(Printer.Handle, SavedSettings);

ja, diese Variante funktioniert ebenfalls.

Zusammen mit den beiden Varianten von Hans-Peter gäbe es Damit drei
funktionsfähige Lösungen.

Vielen Dank für die Hilfe.

Gruß
Roland

[Hans-Peter Diettrich]

Post by Roland Reimann
Antwort auf eine Nachricht von Hans-Peter Diettrich
Hallo Hans-Peter,

Post by Hans-Peter Diettrich

Post by Roland Reimann
Wird nach dem Drucken eines RichEdit-Textes aber wieder normaler Text
gedruckt (mit TextOut), dann kann ich die Schriftgröße des mit TextOut
gedruckten Textes nicht mehr verändern. Das Verändern von
Printer.Canvas.Font.Height hat keinen Effekt mehr.

Vielleicht hilft es, (vorübergehend) einen anderen Font einzustellen?

genial, funktioniert.
Aber wie kommt man denn auf diese Idee?

Ich habe mich bei Win 3.0 mit dem kompletten API befaßt, und kann mir in
etwa vorstellen, was (zumindest damals) intern ablaufen muß. Nun legt
aber Delphi (dankenswerterweise) eine eigene Verwaltung der
Canvas-Elemente über die des Windows DeviceContext, so daß es kritisch
wird, da mit low-level Lösungen dazwischenzufummeln.

Es freut mich, daß obiger Vorschlag funktioniert, auch wenn ich nicht
sagen kann, was die genaue Ursache des Fehlers ist. Ich tippe mal auf
einen Bug im Druckertreiber - schon mal einen anderen Drucker
ausprobiert? Falls es der Treiber ist, kann solcher Mist bei jedem
Kunden passieren, in jeder Form, bei jedem Drucker...

Post by Roland Reimann
Sich die kompletten Fonteinstellungen von vorher zu merken und nachher
FontVorher := Printer.Canvas.Font;
RichEditDrucken;
Printer.Canvas.Font; := FontVorher;

Zwei Möglichkeiten:

Ein eigenes Font-Objekt erzeugen, und dem die gewünschten Einstellungen
zuweisen (notfalls aus Printer.Canvas.Font herauskopieren). Wenn sich
der Font verheddert hat, Printer.Canvas.Font:=MyFont. Das funktioniert
aber möglicherweise nur einmal, beim nächsten Mal ist dieser Font ggf.
ebenfalls "verbrannt".

Low-Level: Ein DeviceContext (DC, Handle hDC) enthält GDI-Objekte für
Font, Brush usw., siehe WinAPI SelectObject. GetCurrentObject. Mit
GetCurrentObject und SelectObject kann man die Handles der aktiven
Objekte abfragen und im DC aktivieren. Ein Font wird dabei durch eine
LOGFONT Struktur beschrieben, die sich mit GetObject abfragen läßt, und
aus der sich ein *neues* Objekt mit CreateFontIndirect erzeugen läßt,
das dann mit SelectObject aktiviert werden kann. Um die Erzeugung und
Löschung (DeleteObject) muß sich der Benutzer kümmern, und da kommt
Delphi ins Spiel, das (irgendwie) einen eigenen Cache für die Objekte
verwaltet und das Löschen übernimmt. Man riskiert damit bei der
Benutzung eigener Objekte, daß man danach entweder zu wenige oder zu
viele GDI-Objekte mit DeleteObject entsorgt.

Bliebe evtl. eine Abwandlung der ersten Methode, indem man die
Properties hin und her kopiert, etwa so:
MyFont := TFont.Create;
MyFont.Assign(Printer.Canvas.Font); //einmal
...
Printer.Canvas.Font.Assign(MyFont); //beliebig oft
...
MyFont.Free;

Achtung: Assign kopiert nicht alles (siehe TFont.Assign)!

Ob's funktioniert? Kai Neahnung :-(
Ggf. jedesmal einen weiteren TFont dazwischenschalten, Assign(MyFont)
und an Canvas.Font zuweisen. Ob der dann auch wieder entsorgt werden muß?

Vielleicht kann man auch TFont.Handle irgendwie verwenden (siehe
GetHandle/SetHandle)? Ideal wäre GetData/SetData, aber das ist privat :-(

DoDi

[Roland Reimann]

Antwort auf eine Nachricht von Hans-Peter Diettrich
<***@aol.com> vom Fri, 05 Dec 2014 20:11:27 +0100 :

Hallo Hans-Peter,

vielen Dank für Deine ausführlichen Hintergrundinformationen.

Post by Hans-Peter Diettrich
Es freut mich, daß obiger Vorschlag funktioniert, auch wenn ich nicht
sagen kann, was die genaue Ursache des Fehlers ist. Ich tippe mal auf
einen Bug im Druckertreiber - schon mal einen anderen Drucker
ausprobiert? Falls es der Treiber ist, kann solcher Mist bei jedem
Kunden passieren, in jeder Form, bei jedem Drucker...

So wie es scheint hat es mit dem Druckertreiber nichts zu tun. Die
Problematik tritt sowohl bei einem HP-Laser als auch beim PDF-Ausdruck
auf.

Post by Hans-Peter Diettrich
Bliebe evtl. eine Abwandlung der ersten Methode, indem man die
MyFont := TFont.Create;
MyFont.Assign(Printer.Canvas.Font); //einmal
...
Printer.Canvas.Font.Assign(MyFont); //beliebig oft
...
MyFont.Free;
Achtung: Assign kopiert nicht alles (siehe TFont.Assign)!
Ob's funktioniert? Kai Neahnung :-(

Ja, auch das funktioniert.

Zusammen mit dem ebenfalls funktionierenden Vorschlag von Achim hätte
ich damit drei funktionierende Varianten. Ich betrachte die
Problematik damit als gelöst.

Vielen Dank für die Hilfe.

Gruß
Roland