📄 calctu.pas
字号:
2 : par.SetText(prods[RowNr-1]);
3 : par.SetText(IntToStr(Random(1000)+1));
4 : par.SetText(IntToStr(Random(3)+1));
5 : begin
par.ASetStringProp(WPAT_PAR_COMMAND, 'left(2)*left(1)');
par.ASetStringProp(WPAT_PAR_NAME, 'PAR_NET');
par.ASet(WPAT_ParProtected,1);
end;
6 : begin
par.ASetStringProp(WPAT_PAR_COMMAND, 'left(1)*0.16');
par.ASetStringProp(WPAT_PAR_NAME, 'PAR_VAT');
par.ASet(WPAT_ParProtected,1);
end;
7 : begin
par.ASetStringProp(WPAT_PAR_COMMAND, 'left(2)+left(1)');
par.ASetStringProp(WPAT_PAR_NAME, 'PAR_TOTAL');
par.ASet(WPAT_ParProtected,1);
end;
end;
end;
end;
procedure TWPTableCalc.InvoiceDemoClick(Sender: TObject);
var par : TParagraph;
obj : TWPTextObj;
begin
WPRichText1.Clear;
WPRichText1.CheckHasBody;
par := WPRichText1.ActiveParagraph;
par.SetText('This are the ordered products:');
par.ASet(WPAT_ParProtected,1);
par.ASetBorderFlags(WPBRD_DRAW_Bottom);
// ---------------------------------------------------------------------------
par := WPRichText1.TableAdd(7,7,[wptblActivateBorders,wptblAppendTableAtEnd],nil, InvoiceDemoCell);
// ---------------------------------------------------------------------------
par := WPRichText1.ActiveText.AppendPar(nil, par);
par := WPRichText1.ActiveText.AppendPar(nil, par);
par.SetText('Please pay ');
obj := par.AppendNewObject(wpobjTextObject,false, false);
obj.Name := 'CALC';
obj.Source := 'PAR_TOTAL';
obj.Params := '???';
// ---------------------------------------------------------------------------
WPRichText1.RecalcText(true,true);
end;
// #############################################################################
// #############################################################################
// #############################################################################
procedure TWPTableCalc.CreateNamedTableClick(Sender: TObject);
var par : TParagraph;
begin
WPRichText1.Clear;
WPRichText1.CheckHasBody;
par := WPRichText1.ActiveParagraph;
par.SetText('Tip: Use "InsertRow" to insert rows until a page break is created!');
par := WPRichText1.ActiveText.AppendPar(nil, par);
par.SetText('some text');
par := WPRichText1.ActiveText.AppendPar(nil, par);
par.SetText('some text');
WPRichText1.BeginTable('NAME', 0, 0,0);
par := WPRichText1.TableAdd(7,7,[wptblActivateBorders,wptblAppendTableAtEnd],nil, InvoiceDemoCell);
WPRichText1.EndTable;
par := WPRichText1.ActiveText.AppendPar(nil, par);
par.SetText('some text');
par := WPRichText1.ActiveText.AppendPar(nil, par);
par.SetText('some text');
// ---------------------------------------------------------------------------
WPRichText1.RecalcText(true,true);
end;
procedure TWPTableCalc.ModifyNamedTableClick(Sender: TObject);
begin
WPRichText1.BeginUpdate; // Temporarily disable protection!
if not WPRichText1.MoveToTable('NAME') then
ShowMessage('Table "NAME" was not found')
else
begin
WPRichText1.TableRowNumber := WPRichText1.TableRowCount-2;
WPRichText1.InsertRow;
WPRichText1.InputString(IntToStr(WPRichText1.TableRowNumber));
WPRichText1.TableColNumber := 2;
WPRichText1.InputString(IntToStr(Random(1000)+1));
WPRichText1.TableColNumber := 3;
WPRichText1.InputString(IntToStr(Random(3)+1));
end;
WPRichText1.EndUpdate;
// Create a footer with the sub total:
// This is a text object with name "PAINT_CALC"
// and source= '+' + the name of the paragraph which contents should be summed each page
WPRichText1.HeaderFooter.Get(wpIsFooter,wpraNotOnLastPage).RtfText.AsString :=
'<html><div align=right style="border-top-width:0.5pt">Subtotal: <TEXTOBJ name="PAINT_CALC" source="+PAR_TOTAL" iparam=1133>???</TEXTOBJ></div></html>';
// Not on first page ...
WPRichText1.HeaderFooter.Get(wpIsHeader,wpraOnFirstPage); // empty!
WPRichText1.HeaderFooter.Get(wpIsHeader,wpraOnOddPages).RtfText.AsString :=
'<html><div align=right style="border-bottom-width:0.5pt">Subtotal: <TEXTOBJ name="PAINT_CALC" source="-PAR_TOTAL" iparam=1133>???</TEXTOBJ></div></html>';
WPRichText1.HeaderFooter.Get(wpIsHeader,wpraOnEvenPages).RtfText.AsString :=
'<html><div align=right style="border-bottom-width:0.5pt">Subtotal: <TEXTOBJ name="PAINT_CALC" source="-PAR_TOTAL" iparam=1133>???</TEXTOBJ></div></html>';
// ---------------------------------------------------------------------------
WPRichText1.RecalcText(true,true);
end;
procedure TWPTableCalc.ModifyNamedTable2Click(Sender: TObject);
var par, row : TParagraph;
begin
{ TIP:
par := WPRichText1.FindParWithText('Product');
works if the table has no name but you know the text in one of the cells! }
par := WPRichText1.FindTable('NAME');
if par=nil then ShowMessage('Table "NAME" was not found') else
begin
// Get the second row from the end
row := par.Rows[par.RowCount-2];
// Duplicate it
row := row.RowAppend;
// and add some text. The properties and formulas have been automatically duplicated!
if row<>nil then
begin
row.Cols[0].SetText(IntToStr(row.RowNr));
row.Cols[2].SetText(IntToStr(Random(1000)+1));
row.Cols[3].SetText(IntToStr(Random(3)+1));
end;
end;
// ---------------------------------------------------------------------------
WPRichText1.RecalcText(true,true);
end;
procedure TWPTableCalc.Button1Click(Sender: TObject);
begin
WPRichText1.AsString :=
WPRichText1.AsANSIString('WPTOOLS');
end;
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
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);
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);
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;
procedure TWPTableCalc.CreateLongTableClick(Sender: TObject);
begin
WPRichText1.Clear;
WPRichText1.InsertPointAttr.Hidden := TRUE;
// We create a CharAttr index for hidden text. We use it to hide our totals
WPRichText1.AttrHelper.Clear;
WPRichText1.AttrHelper.IncludeStyle(afsHidden);
HiddenText := WPRichText1.AttrHelper.CharAttr;
Total := 0;
Part := 10;
Increment := StrToFloat(IncEdit.Text);
WPRichText1.TableAdd(2,200,
[wptblActivateBorders,wptblCreateHeaderRow,wptblCreateFooterRow],
nil, LongTableDemoCell );
WPRichText1.FastAppendParagraph;
WPRichText1.InputString(Format('Total=%f',[Total]));
end;
procedure TWPTableCalc.DoTextObjectPaintCalcEvent(Sender: TObject;
pobj: TWPTextObj; par : TParagraph;
page : TWPVirtPage;
pagenr : Integer;
textbody : TWPRTFDataBlock;
var ResultText : WideString;
PaintCanvas : TCanvas; var UseIt : Boolean);
var formula : string;
j : Integer;
sum : extended;
s : string;
obj : TWPTextObj;
begin
formula := pobj.Source;
if formula='LASTTOTAL' then
begin
for j:=page.EmbeddedObjectCount([wpobjTextObject])-1 downto 0 do
begin
obj := page.EmbeddedObjectGet(j);
if obj.Name='LASTTOTAL' then
begin
ResultText := obj.Params;
UseIt := TRUE;
exit;
end;
end;
end else
if (formula<>'') and (formula[1]>='A') then
begin
sum := 0;
for j:=0 to page.EmbeddedObjectCount([wpobjMergeField])-1 do
begin
obj := page.EmbeddedObjectGet(j);
s := obj.EmbeddedText;
if (s<>'') and (s[1] in ['-','0'..'9']) then
try
sum := sum + StrToFloat(s);
except
ResultText := 'ERR';
UseIt := TRUE;
end;
end;
if not UseIt then
ResultText := FloatToStr(sum);
UseIt := TRUE;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -