Einzelnen Beitrag anzeigen

motion

Registriert seit: 23. Jan 2006
10 Beiträge
 
#2

AW: form.print oder getformimage - TRichEdit Inhalt fehlt (bei TCombobox auch)

  Alt 8. Mai 2021, 18:12
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)='FIXImagethen 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.
  Mit Zitat antworten Zitat