Beiträge von skoschke

Danke, ich schau mir das mal an, ob alles for ZUGFeRD damit angehängt werden kann.

Ciao
Stefan

Hallo,

dank Demo-Projekt und hervorragender Hilfe kann ich PDF-A Dokumente für ZUGFeRD erstellen.
Das Problem ist nun, dass ich fertige PDF-A-Dateien bekomme und um den ZUGFeRD-XML-Anhang erweitern muss.
Hier fehlt mir jetzt der Ansatz, wie das erreicht werden kann?

Danke für Tips

Ciao
Stefan

Hallo,

ich habe eine Textbox im Header, welche mehrere Zeilen Text sowie MergeFields enthält.

Im WPRichText1MouseUp möchte ich nun, wenn ein Mergefield angeklickt ist, darunter ein normales TPanel positionieren (was Controls enthält, die den Inhalt des Feldes ändern sollen).

Im Event habe ich X und Y und mit WPRichText.Left usw. kann ich genau an der Mausposition positionieren.

Ich möchte aber das Panel genau linksbündig mit dem Beginn des MergeFields und genau darunter haben, egal ob der User am Anfang, in der Mitte oder am Ende auf das Feld klickt.

Dazu brauche ich die Position des MergeFields....

Höhe und Breite habe ich gefunden, wie aber komme ich an die Position?

Folgendes habe ich probiert, komme aber damit nicht zum Ziel:

  field := WPRichText1.FieldAtCP(false);
  // das zu positionierende Panel
  PanelDate.Visible := false;
  if field <> nil then
  begin
    // Schutz steht in den Extras
    if field.Extra.IndexOf('Protected') <> -1 then
    begin
      // geschütztes Feld
      WPRichText1.ProtectedProp := WPRichText1.ProtectedProp + [ppIsInsertpoint, ppIsMergedText,
        ppProtectSelectedTextToo];
      // geschützt gar keinen Cursor anzeigen
      WPRichText1.EditOptionsEx := WPRichText1.EditOptionsEx + [wpdisableCaret];
      // ist es ein Feld mit Datums-Panel?
      if field.Extra.IndexOf('Date') <> -1 then
      begin
        if WPRichText1.GetLineFromXY(X, Y, par, posinpar) then
        begin
          WPRichText1.IgnoreMouse; // Sonst selektiert die Maus!
          pt := WPRichText1.GetPointFromParLin(par, 0);
          // Umrechnuing für z.B. PopUpMenüs
          // pt := WPRichText1.ClientToScreen(pt);
          PanelDate.Left := pt.X + WPRichText1.Left;
          PanelDate.top := pt.Y + WPRichText1.top;
          PanelDate.Visible := true;
        end;
      end;
    end

Danke
Ciao
Stefan

TextBoxen haben wie Bilder den Typ wpobjImage

danke, das war mir bisher absolut nicht bewusst.

Und vielen Dank für den Tip mit BeforePaintLayer, das funktioniert so hervorragend :-)

Ciao
Stefan

Ich erzeuge eine Textbox im Header und möchte später damit etwas machen.

Zum Testen habe ich folgenden Minimalcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  SpecialText: TWPRTFDataBlock;
  X, Y, b, H: Integer;
  RTFData: TWPRTFDataBlock;
  txtobj: TWPTextObj;
  p: Integer;
  list: TWPTextObjList;
  i: Integer;
begin
  SpecialText := WPRichText1.HeaderFooter.Get(wpIsHeader, wpraOnFirstPage);
  if SpecialText.Empty then
  begin
    X := WPCentimeterToTwips(1);
    Y := WPCentimeterToTwips(0.5);
    b := WPCentimeterToTwips(4);
    H := WPCentimeterToTwips(1.5);
    // Textbox erzeugen
    RTFData := nil;
    WPRichText1.ActiveText := WPRichText1.HeaderFooter.Get(wpIsHeader, wpraOnFirstPage);
    txtobj := WPRichText1.TextObjects.InsertTextBox(b, H, RTFData);
    txtobj.PositionMode := wpotPage;
    txtobj.RelX := X;
    txtobj.Rely := Y - WPRichText1.Header.MarginHeader;
    txtobj.Frame := [];
    if RTFData <> nil then
    begin
      RTFData.RtfText.AsString := 'Hallo';
    end;
  end;
  WPRichText1.ActiveText := WPRichText1.BodyText;
  WPRichText1.ReformatAll(true, true);
  WPRichText1.SetFocus;
  i := WPRichText1.TextObjects.Count;
  list := TWPTextObjList.Create;
  WPRichText1.TextObjectsGetList(list, wpobjTextObject, true);
  for i := 0 to list.Count - 1 do
  begin
    list[i].SetTag(0);
  end;
  list.Free;

end;

Die Zeile

i := WPRichText1.TextObjects.Count;

soll nur angeben ob was vorhanden ist, später dann beim Erstellen der Liste

WPRichText1.TextObjectsGetList(list, wpobjTextObject, true);

ist list.count dann aber 0 groß!

Hintergrund:

Ich wollte in der Schleife alle Textobjekte Tag = 0 setzen, um im OnTextObjectPaint das gerade selektierte gelben Hintergrund (Tag = 1) und alle anderen weißen Hintergrund zu zeichnen.

Wo liegt mein Denkfehler?

Ciao
Stefan

Hallo,

der Stack ist "unauffällig", was ich jetzt gefunden habe, ist dass die Formatierungen im MailMergeGetText kaputtgehen!

Der sieht momentan etwa so aus:

 procedure TForm.WPRichText1MailMergeGetText(Sender: TObject;
  const inspname: string; Contents: TWPMMInsertTextContents);
var
  S: string;
begin
    //hier wird eigentlich der anzuzeigende Text gemäß inspname geholt
    S:= 'Hallo'
    Contents.StringValue := S;
end;

Ich vermute die Contents.Options sind fehlerhaft, nur habe ich beim Probieren keine Option gefunden welche die bestehende Formatierung nicht kaputtmacht.

Gibt es dazu einen Tip bitte?

Ciao

Stefan

Hallo,

ich denke ich habe mein Problem besser lokalisiert:

Beim per ButtonClick die Textbox erzeugen wird auch die Feldformatierung korrekt dargestellt, mache ich das Laden allerdings im GetSpecialText dann sind die Feldformatierungen weg.

ButtonClick:

begin
  ms := TMemoryStream.Create;
  ms.Clear;
  ms.LoadFromFile('c:\temp\RTFStream.rtf');
  SpecialText := WPRichText1.HeaderFooter.Get(wpIsHeader, wpraOnFirstPage);
  if SpecialText.Empty then
  begin
    // hier nun die Textboxen erzeugen die zur Pagenr passen
    X := 1000;
    Y := 3000;
    b := 5000;
    h := 1000;
    // Textbox erzeugen
    RTFData := nil;
    txtobj := WPRichText1.TextObjects.InsertTextBox(b, h, RTFData);
    txtobj.PositionMode := wpotPage;
    txtobj.RelX := X;
    txtobj.Rely := Y - WPRichText1.Header.MarginHeader;
    txtobj.Frame := [];
    if RTFData <> nil then
    begin
      ms.Position := 0;
      RTFData.RtfText.LoadFromStream(ms, 'RTF');
    end;
  end;
  ms.Free;
  WPRichText1.ReformatAll(true, true);

procedure TTextForm.WPRichText1GetSpecialText(Sender: TObject; Par: TParagraph;
  posinpar, pagenr: Integer; Kind: TWPPagePropertyKind;
  var IsLastPage, UseThis: Boolean; var SpecialText: TWPRTFDataBlock);
var
  RTFData: TWPRTFDataBlock;
  textobj: TWPTextObj;
  aName: string;
  ms: TMemoryStream;
begin
  if Kind = wpIsHeader then
  begin
    aName := 'HEADER#' + IntToStr(pagenr);
    SpecialText := WPRichText1.HeaderFooter.Get(wpIsHeader, wpraNamed, aName);
    if SpecialText.Empty then
    begin
      RTFData := nil;
      textobj := WPRichText1.TextObjects.InsertTextBox(3000, 1000, RTFData,
        SpecialText.FirstPar);
      if RTFData <> nil then
      begin
        ms := TMemoryStream.Create;
        ms.Clear;
        ms.LoadFromFile('c:\temp\RTFStream.rtf');
        ms.Position := 0;
        RTFData.RtfText.LoadFromStream(ms, 'RTF');
        ms.Free;
      end;
      WPRichText1.DelayedReformat;
    end;
    UseThis := true;
  end;

Was ist denn an dem Code im GetSpecialText falsch?

Ciao

Stefan

Kann das irgend eine (falsche) Einstellung des WPRichText sein?

Ciao
Stefan

Hallo,

nein, leider habe ich mich zu früh gefreut...

"Normale Texte mit unterschiedlichen Schriften" werden korrekt geladen, aber Mergefields, welche in dem WPRichText stecken, verlieren weiterhin ihre Formatierungen.

Ich habe den Inhalt des WPRichText mit

ms:=TMemoryStream.Create;
WP.SaveToStream(ms,'RTF');
ms.SaveToFile('c:\temp\RTFStream.rtf');
ms.free;

gespeichert.

Im GetSpecialText dann wieder laden:

...
txtobj := WPRichText1.TextObjects.InsertTextBox(b, h, RTFData);
...
if RTFData <> nil then
   begin
     ms := TMemoryStream.Create;
     ms.LoadFromFile('c:\temp\RTFStream.rtf');
     RTFData.RtfText.LoadFromStream(ms, 'RTF');
     ms.Free;
   end;

Die gespeicherte Datei habe ich mal per Mail gesendet.

Ciao
Stefan

Kurze Rückmeldung:

Nach langem Suchen habe ich die Stelle gefunden, wo bei mir nicht konsequent AnsiString verwendet wurde.

Das war die Stelle, wo ich die Inhalte vieler kleiner WPRichText an ein großes per dok.RTFVariables.AddStream... angehängt hatte.

Jetzt funktioniert alles wie gewünscht.

Ciao
Stefan

Wunderbar, funktioniert, vielen Dank für Deine tolle Arbeit!

Ciao
Stefan

Hallo,

in einer Textbox im normalen Text habe ich auch die unterschiedlichen Größen, nur nicht bei der Textbox im Header!

Das mit dem Memorystream bzw. reinem ANSI probiere ich aus.

Ciao

Stefan

Hallo,

in einem WPRichText sind Textfelder, die mit WPRichText.InputMergeField eingefügt wurden.

Weiterhin gibt es normalen Text.

Einzelne Textfelder sind fett formatiert und haben eine größere Schrift.

Dieses WPRichtext wird als RTF-Text weggespeichert mit s := WP.SaveToString('RTF',false);

und s zeigt im Debugger

'{\rtf1\ansi\deff0\uc1\ansicpg1252\deftab720{\fonttbl{\f0\fnil\fcharset1 Arial;}{\f1\fnil\fcharset2 Wingdings;}{\f2\fnil\fcharset2 Symbol;}{\f3\fnil\fcharset3 Segoe UI Emoji;}}{\colortbl\red0\green0\blue0;\red255\green0\blue0;\red0\green128\blue0;\red0\green0\blue255;\red255\green255\blue0;\red255\green0\blue255;\red128\green0\blue128;\red128\green0\blue0;\red0\green255\blue0;\red0\green255\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green255\blue255;\red192\green192\blue192;\red128\green128\blue128;\red0\green0\blue0;}\wpprheadfoot1\paperw4875\paperh4715\margl0\margr0\margt0\margb0\headery254\footery254\ftnbj\sftnbj\sftnrstcont\nocolbal\sftnnar\saftnnar\fet0\endnhere\sectdefaultcl{\*\generator WPTools_9.0-PRM;}{\plain\f0\fs28\cf0{\field{\*\fldinst{MERGEFIELD Formularfeld_1-42}}{\*\wpfldparam{Kundenberatungs GmbH}}{\fldrslt{\f0\fs40\cf0\b\i Kundenberatungs GmbH\f0\fs28\cf0\b0\i0}}}\par'#$D#$A'\plain\f0\fs28\cf0{\field{\*\fldinst{MERGEFIELD Formularfeld_2-46}}{\*\wpfldparam{Kundenweg 12}}{\fldrslt{Kundenweg 12}}}\par'#$D#$A'\pard\plain\plain\f0\fs28\cf0\par'#$D#$A'\plain\f0\fs28\cf0{\field{\*\fldinst{MERGEFIELD Formularfeld_3-47}}{\*\wpfldparam{98765}}{\fldrslt{\f0\fs38\cf0\b 98765\f0\fs28\cf0\b0}}}\li0\fi0\ri0\sb0\sa0\ql\vertalt\f0\fs38\cf0\b  \f0\fs28\cf0\b0{\field{\*\fldinst{MERGEFIELD Formularfeld_4-48}}{\*\wpfldparam{Kundendorf}}{\fldrslt{\f0\fs38\cf0\b Kundendorf\f0\fs28\cf0\b0}}}\par'#$D#$A'}}'

Da sind also die Felder und ihre Schriftgrößen drin.

Num erzeuge ich in einem anderen WPRichText Textboxen und möchte da diesen RTF-Inhalt reinbekommen

procedure TTextForm.WPRichText1GetSpecialText(Sender: TObject; Par: TParagraph;
  posinpar, pagenr: Integer; Kind: TWPPagePropertyKind;
  var IsLastPage, UseThis: Boolean; var SpecialText: TWPRTFDataBlock);
var
  RTFData: TWPRTFDataBlock;
  txtobj: TWPTextObj;
  aName: string;
  X, Y, b, h: Integer;
begin
  if Kind = wpIsHeader then
  begin
    aName := 'HEADER#' + inttostr(pagenr);
    SpecialText := WPRichText1.HeaderFooter.Get(wpIsHeader, wpraNamed, aName);
    if SpecialText.Empty then
    begin
        X := 100;
        Y := 100;
        b := 5000;
        h := 3000;
        RTFData := nil;
        txtobj := WPRichText1.TextObjects.InsertTextBox(b, h, RTFData,
          SpecialText.FirstPar);
        txtobj.PositionMode := wpotPage;
        txtobj.RelX := X;
        txtobj.Rely := Y - WPRichText1.Header.MarginHeader;
        txtobj.Frame := [wpframeFine];
        if RTFData <> nil then
        begin
          //den oben gezeigten RTF-String hier laden
          RTFData.RtfText.LoadFromString(s, 'RTF');
        end;
    end;
    UseThis := true;
  end; // is Header
end;

Warum gehen die Formatierungen verloren?

Ciao
Stefan

Hallo,

einige meiner Tabellenzeilen haben Rahmen.

Lasse ich das WPRichtext die Gridlines anzeigen, verschwinden teilweise die Rahmen.

Kann man dieses Verhalten irgendwie so anpassen, dass die Rahmen als oberstes gezeichnet werden, also ggf. die Gridlines überdecken?

Ciao
Stefan

Vielen Dank!

Irgendwie habe ich ein meiner (ungekürzten) Callback-Funktion einen Denkfehler gehabt, jetzt mit der einfachen Mitzählvariante funktioniert es wie gewünscht und ich kann Überträge in Rechnungen im Footer (nicht auf letzter Seite) und im Header (nicht auf erster Seite) anzeigen ohne irgendwelche "Verrenkungen" mit extra Tabellen im SeitenHeader oder SeitenFooter.

Ich liebe die WPTools immer mehr :-))))

Und nebenbei:

Meine anderen Verrenkungen zum Tabellenkopieren per Streams (erinnerst Du Dich?) habe ich jetzt konsequent auf das Erstellen von Tabellenzeilen und Zellen mit jeweiligem Verweis auf die entsprechenden TParagraphs umgesetzt und setze nur den Originaltext sowie die gewünschten Parameter (AGet / ASet) und kann damit in weniger als 1 sec 1000 Positionen (je 3-zeilig) auf 77 Seiten erzeugen und dabei noch die Seitensummen ermitteln und die Überträge errechnen.

Ciao
Stefan

Hallo,

ich erzeuge eine Tabelle mit doppeltem Header mit der Option wptblCreateSubHeader.

In der Callback-Routine kommt dann zwei Mal die RowNr = -1 so daß ich da mitzähle um die zweite Headerzeile zu erkennen:

//Global
var SubHeader : boolean;

procedure TWPTableCalc.KopfZelle(RowNr, ColNr: integer; par: TParagraph);
begin
if RowNr = -1 then // Header
  begin
    if not SubHeader then
      par.settext('H1')
    else
      par.settext('H2');
  end;
  if RowNr = -2 then // Footer
  begin
    par.settext('F1');
  end;
  // zweiten Header erkennen
  if ColNr = Kopfcolzahl then
    SubHeader := true;
end;

Ich bekomme eine Tabelle mit einer Headerzeile wo alle Zellen H1 haben und mit 2 Footerzeilen, die erste alles mit H2 und die zweite alles mit F1.

Ist das ein Fehler oder wie kann man das Einrichten der beiden Headerzeilen besser gestalten?

Ein Test mit wptblCreateSummaryFooter analog ergibt, wie erwartet, 2 Footerzeilen, die auch unterschieden werden können.

Ein Test mit wptblCreateSubHeader2 erzeugt wieder eine zusätzliche Footerzeile, obwohl im Callback RowNr = -1 ist.

Danke

Ciao
Stefan

Hallo,

im DoTextObjectPaintCalcEvent habe ich jetzt mal den Ergebnistext mit Nullen verlängert, dann passt die rechtsbündige Formatierung.

ResultText := formatfloat('0', sum);
while length(ResultText) < 20 do
 ResultText := '0' + ResultText;
UseIt := true;

Das ist aber optisch nicht gewünscht, so dass ich mit Leerzeichen anstelle der Nullen verlängert habe, das aber funktioniert nicht, da steht der Text nicht mehr ganz rechts.

Mit '_' geht es auch, wie aber bekomme ich "unsichtbare" Zeichen vor den Text?

Irgendwie fehlt mir die "zündende Idee" wie und womit ich verlängern kann.

Ciao
Stefan

Wenn ich im Footer einer Tabelle ein Textobjekt platziere und es rechtsbündig ausrichte (Preise und Überträge sollen rechtsbündig sein)

 else if ColNr = 3 then
    begin
      field := par.AppendNewObject(wpobjTextObject);
      field.Name := 'PAINT_CALC';
      field.Source := 'Uebertrag';
      par.ASet(WPAT_Alignment, 2);
    end;

dann stimmt die Formatierung nicht, das Gleiche gilt für zentrierte Darstellung.

Rechtsbündig: Ab einer bestimmten Textlänge wächst der Text rechts aus der Zelle heraus, obwohl links noch Platz ist

Zentriert: Ab einer bestimmten Länge wird der Text rechts länger ohne dass der Anfang weiter nach links rückt obwohl da noch Platz ist.

Nachstellen kann man den Fehler durch 2 kleine Änderungen in der Demo CalcTable:

1) die Preisspalte den Schutz wegschalten und

2) die Fußzeile rechtsbündig,

dann im Preis ein paar Ziffern dazutippen

procedure TWPTableCalc.LongTableDemoCell(RowNr, ColNr: Integer;
  par: TParagraph);
var
  field: TWPTextObj;
begin

  if ColNr = 1 then
    par.ASet(WPAT_COLWIDTH_PC, 1000)
  else
  begin
    par.ASet(WPAT_COLWIDTH_PC, 9000);
//    Tippen im Preis erlauben
//    par.ASet(WPAT_ParProtected, 1);
  end;

  if RowNr = -1 then // Header
  begin
    if ColNr = 1 then
      par.SetText('NR')
    else
      par.SetText('VALUE');
    par.ASetColor(WPAT_BGCOLOR, $F0F0F0);
  end
  else if RowNr = -2 then
  // Footer
  begin
    if ColNr = 2 then
    begin
      par.Append('Subtotal on this page :');
      field := par.AppendNewObject(wpobjTextObject);
      field.Name := 'PAINT_CALC';
      /// <<-- fixed value to trigger event
      field.Source := 'RNDNR'; // <<-- name of field to be sumed
      par.Append(#10 + 'Subtotal :');
      field := par.AppendNewObject(wpobjTextObject);
      field.Name := 'PAINT_CALC';
      /// <<-- fixed value to trigger event
      field.Source := 'LASTTOTAL'; // <<-- we save this value each row
    end;
    par.ASetColor(WPAT_BGCOLOR, $F0F0F0);
//   rechtsbündige Ausgabe
    par.ASet(WPAT_Alignment, 2);
  end
  else
  begin
    if ColNr = 1 then
      par.SetText(IntToStr(RowNr))
    else
    begin
      // This is the field which is displayed
      field := par.AppendNewObjectPair(wpobjMergeField, FloatToStr(Part));
      field.Name := 'RNDNR';
      // Calculate the running total
      Total := Total + Part;
      // This is the total, we cannot see it
      field := par.AppendNewObject(wpobjTextObject, false, false, HiddenText);
      field.Name := 'LASTTOTAL';
      /// <<-- fixed value to trigger event
      field.Params := FloatToStr(Total); // We use that
      //
      Part := Part + Increment;
    end;
  end;
end;

Es wäre schön wenn es dafür eine Lösung gibt!

Ciao
Stefan

Danke, schau ich mir an...

Ciao
Stefan

Hallo,

im Footer einer Tabelle habe ich ein Feld eingefügt, welches die Seitensumme berechnet:

field := Cell.AppendNewObject(wpobjTextObject, false, false, HiddenText);
field.Name := 'PAINT_CALC';
field.Source := 'Seitensumme'; 

Füge ich viele Zeilen (z.B. 200) in die Tabelle ein, sind danach wie gewünscht alle Seitensummen vorhanden.

Benutze ich die gleiche Felddefinition in einer Zelle einer Datenzeile, werden nicht alle Seitensummen berechnet, erst wenn man langsam durch das Dokument scrollt.

Das gleiche Verhalten habe ich wenn das Feld im SeitenFooter eingefügt wird.

Eigentlich möchte ich den Tabellenfooter gar nicht, aber die Zeilen-Höhe des Footers lässt sich nicht auf 0 setzen, sobald da irgendwo was drin steht.

Mit welcher Procedure bekomme ich die Seitensummen alle berechnet, wenn das Summenfeld z.B. in allen Seiten-Footern steht?

Reformat bringt keine Änderung, das Beispiel in WPReporter_Calc berechnet nur eine absolute Gesamtsumme über alle Seiten...

Danke für Hinweise
Ciao
Stefan

Nachtrag:

Ich durchlaufe alle MergeFields im OnPaintCalc:

oc := page.EmbeddedObjectCount([wpobjMergeField]);
for j := 0 to oc - 1 do
begin
 obj := page.EmbeddedObjectGet(j);

oc ergibt 1 beim Debuggen, aber der Zugriff auf page.EmbeddedObjectGet(0) bringt Laufzeitfehler Index 0 außerhalb des gültigen Bereichs!

Das ObjectCount also findet ein solches MergeField, was dann aber nicht vorhanden ist...

In der Demo wird page.EmbeddedObjectCount([wpobjTextObject]) durchlaufen, liegt da der Fehler?

page.EmbeddedObjectGet(j)