Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi form.print oder getformimage - TRichEdit Inhalt fehlt (bei TCombobox auch) (https://www.delphipraxis.net/207773-form-print-oder-getformimage-trichedit-inhalt-fehlt-bei-tcombobox-auch.html)

motion 1. Mai 2021 15:36

form.print oder getformimage - TRichEdit Inhalt fehlt (bei TCombobox auch)
 
Hallo Zusammen,
in einem alten, aber noch aktiven Delphi 7 Projekt habe ich ein Problem bei der Erstellung von Hardcopies von VCL Forms.
Die Hardcopies des aktiven Fensters sollen entweder gedruckt, in die Zwischenablage kopiert oder als bmp Datei gespeichert werden.

Eigentlich ja simpel, da mittels form.print, form.getformimage + clipboard.assign alles klar gehen sollte.
Funktioniert auch, aber nicht bei TComboboxen oder TRichEdit Komponenten. Deren Inhalte sind einfach leer.

Bemerkung: Ich brauche keinen vollständigen Ausdruck des TRichedit über richedit.print oder ähnlich; nur die Hardcopies des sichtbaren Teils auf dem Formular reicht mir.

Ich habe das Problem jetzt auch noch mal in Delphi 10.2 nachgestellt: Existiert hier genauso, ist also keine alte Delphi 7 Spezialität, sondern eher eine Sache von Windows.

Für die TCombobox habe ich einen Fix (mehr ein Hack): den Style von csDropDown temporär auf csDropDownList stellen, dann funktioniert es.
(siehe hier auf dem Jahre 2000: http://www.delphigroups.info/2/c3/322778.html)

Für die TRichEdit suche ich noch nach einer Lösung.
Hat jemand da eine Idee?

Vielen Dank

motion 8. Mai 2021 17:12

AW: form.print oder getformimage - TRichEdit Inhalt fehlt (bei TCombobox auch)
 
Okay, ich habe inzwischen zwei Hacks implementiert und damit läuft es.
Ein einfacherer Weg wäre mir lieber gewesen ab so ist jetzt erledigt:
*TComboboxen temporär von csdropdown auf csdropdownlist umstellen
*TCustomRichedit Felder: temporär ein TImage erzeugen und über das TRichedit legen, eine Bitmap preview der TRichedit ins TImage kopieren und das Trichedit.visible=false setzen

d.h. bei Operationen wie form.print, Form in die Zwischenablage kopieren oder als BMP speichern diese einbetten in PrintFixOn und PrintFixOff:
Delphi-Quellcode:

Procedure PrintFixON (F: Tform);
//Alle Ableitungen von Tcustomcombobox (Tcombobox, TIB_Combobox) drucken nicht bei form.print oder form.getimage
//Style temporär von csdropdown auf csdropdownlist umstellen; mit der PrintFixOFF wieder zurück
VAR I :Integer;
    Imag : Timage;
Begin
  For I:=0 to f.ComponentCount-1 do
    Begin
      if F.Components[i] is TComboBox then
      begin
        with TComboBox( F.Components[i]) do
           begin
              items.add(text); // make sure the current item is in the list
              style:=csDropDownList; // do the magic
              itemindex:=items.count-1;
           end;
      end;
      if F.Components[i] is TIB_ComboBox then
      begin
        with TIB_ComboBox( F.Components[i]) do
           begin
              items.add(text); // make sure the current item is in the list
              style:=csDropDownList; // do the magic
              itemindex:=items.count-1;
           end;
      end;
    end;
// jetzt die Richedits checken und Images drüber legen
  For I:=0 to f.ComponentCount-1 do
    Begin
      if f.components[i] is TCustomRichedit then
        with Tcustomrichedit(f.components[i]) do
        Begin
          Imag:=TImage.create(f);
          Imag.name:='FIXImage'+InttoStr(I);
          Imag.top:=top;
          imag.left:=left;
          imag.height:=height;
          imag.width:=width;
          imag.Parent:=Parent;
          RichEditToCanvas(Tcustomrichedit(f.components[i]), Imag.Canvas, f.PixelsPerInch);
          Imag.Refresh;
          visible:=false;
        end;
    end;
  application.ProcessMessages;
end;

procedure RichEditToCanvas(RichEdit: TCustomRichEdit; Canvas: TCanvas; PixelsPerInch: Integer);
var
  ImageCanvas: TCanvas;
  fmt: TFormatRange;
begin
  ImageCanvas := Canvas;
  with fmt do
  begin
    hdc:= ImageCanvas.Handle;
    hdcTarget:= hdc;
    // rect needs to be specified in twips (1/1440 inch) as unit
    rc:= Rect(0, 0,
                ImageCanvas.ClipRect.Right * 1440 div PixelsPerInch,
                ImageCanvas.ClipRect.Bottom * 1440 div PixelsPerInch
              );
    rcPage:= rc;
    chrg.cpMin := 0;
    chrg.cpMax := RichEdit.GetTextLen;
  end;
  SetBkMode(ImageCanvas.Handle, TRANSPARENT);
  RichEdit.Perform(EM_FORMATRANGE, 1, Integer(@fmt));
  // next call frees some cached data
  RichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;

Procedure PrintFixOff (F: Tform);
VAR I :Integer;

Begin
  For I:=0 to f.ComponentCount-1 do
    Begin
      if f.Components[i] is TComboBox then
        begin
         with TComboBox(F.Components[i]) do
         begin
           style:=csDropDown;
           text:=items[items.count-1];
           items.delete(items.count-1);
         end;
        end;
      if f.Components[i] is TIB_ComboBox then
        begin
         with TIB_ComboBox(F.Components[i]) do
         begin
           style:=csDropDown;
           text:=items[items.count-1];
           items.delete(items.count-1);
         end;
        end;
    end;
//jetzt die Images löschen und die Richedits wieder sichtbar machen
 For I:=f.ComponentCount-1 downto 0 do
    Begin
      if f.components[i] is TCustomRichedit then
        Tcustomrichedit(f.components[i]).visible:=true
        else if f.components[i] is TImage then
        with Timage(f.components[i]) do
         Begin
          if copy(name,1,8)='FIXImage' then free;
        end;
    end;
  application.ProcessMessages;
end;

So kopiere ich jetzt das Form in die Zwischenablage:
Delphi-Quellcode:
procedure TFTasten_Form.HardcopyClipboardExecute(Sender: TObject);
VAR Bmp : TBitmap;
begin
  inherited;
  PrintFixON(self);
  bmp := GetFormImage;
  try
    Clipboard.Assign(bmp);
  finally
  bmp.free;
  PrintFixOFF(self);
  end;
end;
oder so ein Ausdruck des Formulars auf den Standarddrucker
Delphi-Quellcode:
procedure TFTasten_Form.Hardcopy2Execute(Sender: TObject);
begin
  inherited;
  self.PrintScale:=poPrintToFit;
  PrintFixON(self);
  self.Print;
  PrintFixOFF(self);
end;
Vielleicht kann das hier ja jemand mal als Referenz gebrauchen.
...oder jemand hat einen besseren Fix.


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:29 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