⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wpreptest.pas

📁 wptools5 pro 完整源代码 Msword界面的文本编辑器源代码
💻 PAS
字号:
unit WPRepTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, WPRTEDefs, WPCTRMemo, WPCTRRich, WPUtil,
  WPRepED, ExtCtrls, WPRuler, WPTbar, WPRTEReport, Menus, WPTblCalc;

type
  TWPRepForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    ReportOutput: TTabSheet;
    Description: TWPRichText;
    Label1: TLabel;
    Memo1: TMemo;
    WPToolBar1: TWPToolBar;
    WPRuler1: TWPRuler;
    SourceText: TWPRichText;
    WPReportBandsDialog1: TWPReportBandsDialog;
    Button1: TButton;
    DestText: TWPRichText;
    WPSuperMerge1: TWPSuperMerge;
    Button2: TButton;
    WPToolBar2: TWPToolBar;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    ShowBandDialog1: TMenuItem;
    InsertParagraphatendofthisgroup1: TMenuItem;
    InsertField1: TMenuItem;
    SuppressAutomaticHeaderFooter: TCheckBox;
    Label2: TLabel;
    Button4: TButton;
    ShowFields: TCheckBox;
    InsFieldPopup: TPopupMenu;
    ESTData1: TMenuItem;
    estNumber1: TMenuItem;
    SumField: TMenuItem;
    WPFormulaInterface1: TWPFormulaInterface;
    otaltablefooter1: TMenuItem;
    Button5: TButton;
    ReloadRTF: TButton;
    ShowFieldNames: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure WPSuperMerge1MailMergeGetText(Sender: TObject;
      const inspname: string; Contents: TWPMMInsertTextContents);
    procedure WPSuperMerge1BeforeProcessGroup(Sender: TWPSuperMerge;
      Band: TWPBand; Count: Integer; var CustomData: TObject;
      var ProcessGroup, IsLastRun: Boolean);
    procedure Button3Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure InsertParagraphatendofthisgroup1Click(Sender: TObject);
    procedure SuppressAutomaticHeaderFooterClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ShowFieldsClick(Sender: TObject);
    procedure ESTData1Click(Sender: TObject);
    procedure estNumber1Click(Sender: TObject);
    procedure SumFieldClick(Sender: TObject);
    procedure WPFormulaInterface1TextObjectPaintCalc(Sender: TObject;
      pobj: TWPTextObj; par: TParagraph; page: TWPVirtPage;
      pagenr: Integer; textbody: TWPRTFDataBlock;
      var ResultText: WideString; PaintCanvas: TCanvas;
      var UseIt: Boolean);
    procedure otaltablefooter1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure SourceTextMailMergeGetText(Sender: TObject;
      const inspname: String; Contents: TWPMMInsertTextContents);
    procedure ShowFieldNamesClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    // Used for our data base simulation
    LineNo: Integer;
    Total : Integer;
  end;

var
  WPRepForm: TWPRepForm;

implementation

{$R *.dfm}

procedure TWPRepForm.FormCreate(Sender: TObject);
begin
  DestText.FormatOptions := [wpfDontBreakTableRows,wpDisableSpeedReformat];  
  WPSuperMerge1.SetSourceDest(
    SourceText.Memo.RTFData,
    DestText.Memo.RTFData
    );
   // Hide the fields in the Destination:
  DestText.InsertPointAttr.Hidden := TRUE;
end;

procedure TWPRepForm.Button1Click(Sender: TObject);
begin
  WPReportBandsDialog1.Execute;
end;

procedure TWPRepForm.ESTData1Click(Sender: TObject);
begin
  SourceText.InputMergeField('TEST', '<test field>');
end;

procedure TWPRepForm.estNumber1Click(Sender: TObject);
begin
   SourceText.InputMergeField('NR', '<000>');
end;

procedure TWPRepForm.otaltablefooter1Click(Sender: TObject);
var obj : TWPTextObj;
begin
  obj := SourceText.InputTextFieldName('PAINT_CALC');
  obj.Params := '[TOTAL:NR]';
  obj.Source := 'TOTALNR';
end;

procedure TWPRepForm.SumFieldClick(Sender: TObject);
var obj : TWPTextObj;
begin
  obj := SourceText.InputTextFieldName('PAINT_CALC');
  obj.Params := '[TOTALONPAGE:NR]';
  obj.Source := 'NR';
end;

// This even is triggered by the field 'PAINT_CALC'!
procedure TWPRepForm.WPFormulaInterface1TextObjectPaintCalc(
  Sender: TObject; pobj: TWPTextObj; par: TParagraph; page: TWPVirtPage;
  pagenr: Integer; textbody: TWPRTFDataBlock; var ResultText: WideString;
  PaintCanvas: TCanvas; var UseIt: Boolean);
var i, colnr : Integer;
    sum : Extended;
    tbl : TParagraph;
    list : TList;
begin
   { This is only a dem to show how values on a page can be calculated. To
     calculate values in a table you can use
       table.GetObjList }

   // We don't want to use this in the first editor!
   if Sender<>SourceText.Memo then
   try
      tbl := pobj.ParentPar.ParentTable;
      colnr := pobj.ParentPar.ColNr;
      sum := 0;
      if pobj.SOURCE='TOTALNR' then // Sum in this Column ------------------------
      begin
        list := TList.Create;
        try
          tbl.GetObjList([wpobjMergeField],list,nil,'NR');
          for i:=0 to list.Count-1 do
          //OPTION: if TWPTextObj(list[i]).ParentPar.ColNr=colnr then  //<--- only in same COLUMN!!!
          begin
            // sum := sum + StrToFloat(TWPTextObj(list[i]).EmbeddedText);
            sum := sum + TWPTextObj(list[i]).EmbeddedTextAsFloat;
          end;
        finally
         list.Free;
        end;
      end else // Sum on this page with same parent table ----------------------
      begin
        for i:=0 to page.EmbeddedObjectCount([wpobjMergeField],pobj.Source)-1 do
        if page.EmbeddedObjectGet(i).ParentPar.ParentTable=tbl then // Only sum up in same table!
        begin
         // sum := sum + StrToFloat(page.EmbeddedObjectGet(i).EmbeddedText);
         sum := sum + page.EmbeddedObjectGet(i).EmbeddedTextAsFloat;
        end;
      end;
      ResultText := FloatToStr(sum);
      UseIt := TRUE;
   except
      ResultText := 'ERR';
      UseIt := TRUE;
      if PaintCanvas<>nil then
         PaintCanvas.Font.Color := clRed;
   end;
end;


procedure TWPRepForm.Button2Click(Sender: TObject);
var p : TPoint;
begin
  p := (sender as TButton).ClientToScreen(Point(
     0,(sender as TButton).Height));
  InsFieldPopup.Popup(p.X, p.y);
end;

procedure TWPRepForm.WPSuperMerge1MailMergeGetText(Sender: TObject;
  const inspname: string; Contents: TWPMMInsertTextContents);
begin
  if CompareText(inspname, 'TEST') = 0 then
    Contents.StringValue := Memo1.Lines[LineNo]
  else if CompareText(inspname, 'NR') = 0 then
    Contents.StringValue := IntToStr(Random(7000))
  else Contents.StringValue := 'FIELD:' + inspname;
end;

procedure TWPRepForm.WPSuperMerge1BeforeProcessGroup(Sender: TWPSuperMerge;
  Band: TWPBand; Count: Integer; var CustomData: TObject; var ProcessGroup,
  IsLastRun: Boolean);
begin
  if Band.Alias = 'LOOP10' then
  begin
     // Detailband->to start
    LineNo := -1;

    IsLastRun := Count = 9;
    ProcessGroup := Count <= 10;
  end else if Band.Alias = 'LOOP100' then
  begin
     // Detailband->to start
    LineNo := -1;

    IsLastRun := Count = 99;
    ProcessGroup := Count <= 100;
  end else
  begin
    inc(LineNo);
    IsLastRun := Memo1.Lines.Count < LineNo - 1;
    ProcessGroup := LineNo < Memo1.Lines.Count;
  end;
end;

// This code activates the reporting

procedure TWPRepForm.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePage = ReportOutput then
  begin
    DestText.Clear;
    LineNo := -1;
    WPSuperMerge1.Execute;
    // DestText.SaveToFile('c:\a.rtf');
  end;
end;

procedure TWPRepForm.Button3Click(Sender: TObject);
begin
  DestText.TextLoadSaveOptions := '-nomergefields,-ignorecollapsedpar';
  try
    DestText.SaveAs;
  finally
    DestText.TextLoadSaveOptions := '';
  end;
end;

procedure TWPRepForm.PopupMenu1Popup(Sender: TObject);
begin
  InsertParagraphatendofthisgroup1.Enabled :=
     (WPSuperMerge1.Bands.CurrentBand<>nil) and
     (WPSuperMerge1.Bands.CurrentBand.Style=wpmGroup);
end;

procedure TWPRepForm.InsertParagraphatendofthisgroup1Click(
  Sender: TObject);
begin
  WPSuperMerge1.InsertParAtrEndOfGroup;
end;

procedure TWPRepForm.SuppressAutomaticHeaderFooterClick(Sender: TObject);
begin
  WPSuperMerge1.SuppressAutomaticHeaderFooter :=
     SuppressAutomaticHeaderFooter.Checked;
end;

procedure TWPRepForm.Button4Click(Sender: TObject);
var sect : TWPRTFSectionProps;
begin
   SourceText.InputString(#12); // New Page
   sect := SourceText.ActiveParagraph.StartNewSection;
   sect.Select := [
      wpsec_PageSize, // We change the landscape flag!
      wpsec_SelectHeaderFooter // we want a new set of header/footer!
      ];
   sect.Landscape := not sect.Landscape;
end;

procedure TWPRepForm.ShowFieldsClick(Sender: TObject);
begin
 DestText.InsertPointAttr.CodeOpeningText:=
  '%N="';
 DestText.InsertPointAttr.CodeClosingText := '"';
 DestText.InsertPointAttr.Hidden :=
   not ShowFields.Checked;
 DestText.ReformatAll(true,true);
end;

procedure TWPRepForm.Button5Click(Sender: TObject);
begin
  if Sender = ReloadRTF then
       SourceText.AsString := SourceText.AsANSIString('RTF')
  else SourceText.AsString := SourceText.AsANSIString('WPTOOLS');
end;

procedure TWPRepForm.SourceTextMailMergeGetText(Sender: TObject;
  const inspname: String; Contents: TWPMMInsertTextContents);
begin
   Contents.StringValue := inspname;
end;

procedure TWPRepForm.ShowFieldNamesClick(Sender: TObject);
begin
   SourceText.MergeText;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -