crtableu.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit CrTableU;

interface

uses
  Windows, Messages, SysUtils, {Variants,} Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WPRTEDefs, WPRTEPaint, WPCTRMemo, WPCTRRich,
  WPTbar, ExtCtrls, WPCreateDemoText, WPObj_Image, ExtDlgs
  ;

type
  TForm1 = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    CreateTable: TButton;
    Button1: TButton;
    Button2: TButton;
    ModifyNamedTable2: TButton;
    ModifyNamedTable: TButton;
    CreateNamedTable: TButton;
    Bevel1: TBevel;
    WPToolBar1: TWPToolBar;
    Label1: TLabel;
    Label2: TLabel;
    Bevel2: TBevel;
    Label3: TLabel;
    BorderAndBackgrounds: TButton;
    Reload_RTF: TButton;
    Reload_WPT: TButton;
    Image1: TImage;
    BackGr: TCheckBox;
    Label4: TLabel;
    Bevel3: TBevel;
    CreateTableWithImage: TButton;
    SelectImageFile: TCheckBox;
    OpenPictureDialog1: TOpenPictureDialog;
    Image2: TImage;
    Bevel4: TBevel;
    Label5: TLabel;
    CreateTableWithHeaderFooter: TButton;
    MakeHeader: TCheckBox;
    MakeFooter: TCheckBox;
    procedure CreateTableClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CreateNamedTableClick(Sender: TObject);
    procedure ModifyNamedTableClick(Sender: TObject);
    procedure ModifyNamedTable2Click(Sender: TObject);
    procedure BorderAndBackgroundsClick(Sender: TObject);
    procedure Reload_RTFClick(Sender: TObject);
    procedure Reload_WPTClick(Sender: TObject);
    procedure WPRichText1PaintWatermark(Sender: TObject;
      RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
      PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
      YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
    procedure BackGrClick(Sender: TObject);
    procedure CreateTableWithImageClick(Sender: TObject);
    procedure CreateTableWithHeaderFooterClick(Sender: TObject);
  private
    FCellNr: Integer;
    wprt: TWPRichText;
    FPrice, FTotal: Double;
    FRowCount: Integer;
    procedure CreateTableCellCallBack(RowNr, ColNr: Integer; par: TParagraph);
    procedure InvoiceDemoCell(RowNr, ColNr: Integer; par: TParagraph);
    procedure CreateTableCellCallBackHF(RowNr, ColNr: Integer; par: TParagraph);

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Reload to test reading and writing

procedure TForm1.Reload_RTFClick(Sender: TObject);
begin
  WPRichText1.AsString := WPRichText1.AsANSIString('RTF');
end;

procedure TForm1.Reload_WPTClick(Sender: TObject);
begin
  WPRichText1.AsString := WPRichText1.AsANSIString('WPTOOLS');
end;

// Draw a tiled background image

procedure TForm1.WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
  PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
  YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
begin
  if BackGr.Checked then
    WPPrintTiledBackground(toCanvas, PageRect, Image1.Picture.Graphic, XRes / WPScreenPixelsPerInch);
end;

procedure TForm1.BackGrClick(Sender: TObject);
begin
  WPRichText1.Repaint;
end;

// We are using the callback to change the props of the new cell

procedure TForm1.CreateTableCellCallBack(RowNr, ColNr: Integer; par: TParagraph);
begin
  if assigned(wprt) then
  begin
    if (RowNr and 1) = 0 then
      par.Style := wprt.ParStyles.GetID('evenstyle')
    else par.Style := wprt.ParStyles.GetID('oddstyle');

    // Set width in %: 10, 40, 40, 10
  {  if ColNr=1 then
        par.ASet(WPAT_COLWIDTH_PC, 10*100)
    else if ColNr=2 then
        par.ASet(WPAT_COLWIDTH_PC, 40*100)
    else if ColNr=3 then
        par.ASet(WPAT_COLWIDTH_PC, 40*100)
    else if ColNr=4 then
        par.ASet(WPAT_COLWIDTH_PC, 10*100);   }

    par.SetText(IntToStr(FCellNr));
    inc(FCellNr);
  end;
end;

{.$DEFINE CRDYNAMIC}// Work with dynamic Editor!

procedure TForm1.CreateTableClick(Sender: TObject);
begin
{$IFDEF CRDYNAMIC}
  wprt := TWPRichText.CreateDynamic; //NO!! Create(nil);
{$ELSE}
  wprt := WPRichText1;
{$ENDIF}
  try
    wprt.Clear;
    wprt.CheckHasBody;
   // wprt.ActiveText := wprt.HeaderFooter.Get(wpIsHeader, wpraOnAllPages);

    FCellNr := 0;
    wprt.Loaded;
    with wprt.ParStyles.AddStyle('oddstyle') do
    begin
      ASet(WPAT_IndentLeft, 32);
      ASet(WPAT_IndentRight, 32);
     {  ASetColor(WPAT_FGColor, clYellow);
       ASetColor(WPAT_BGColor, clWhite);
       ASet(WPAT_ShadingValue, 30); // %
    }ASet(WPAT_CharStyleON, 1);
      ASet(WPAT_CharStyleMask, 1);
    end;
    with wprt.ParStyles.AddStyle('evenstyle') do
    begin
      ASet(WPAT_IndentLeft, 32);
      ASet(WPAT_IndentRight, 32);
      ASetColor(WPAT_FGColor, clRed);
      ASetColor(WPAT_BGColor, clWhite);
      ASet(WPAT_ShadingValue, 10); //
    end;
   // wprt.Refresh();
    wprt.TableAdd(4, 10, [wptblActivateBorders, wptblAllowNestedTables], nil, CreateTableCellCallBack);

    WPRichText1.ActiveText := WPRichText1.BodyText;
    WPRichText1.FastAppendParagraph;

    WPRichText1.InputString('This table uses the styles: evenstyle and oddstyle');

    WPRichText1.SetFocus;



    wprt.ReformatAll(false, true);
{$IFDEF CRDYNAMIC}
    WPRichText1.AsString := wprt.AsString; //
    WPRichText1.Refresh;
{$ENDIF}


  finally
{$IFDEF CRDYNAMIC}FreeAndNil(wprt); {$ENDIF}
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(WPRichText1.ParStyles.GetWPCSS);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage(
    WPRichText1.ActiveParagraph.ABaseStyleName + '=' +
    WPRichText1.ActiveParagraph.ABaseStyleString);
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

// This method also sets calculation formulas. These are only usable
// with the TWPFormulaInterface included with WPReporter!

procedure TForm1.InvoiceDemoCell(RowNr, ColNr: Integer; par: TParagraph);
const prods: array[1..5] of string =
  ('Cool', 'Master', 'Hummer', 'High Performace', 'Better');
  prices: array[1..5] of Integer =
  (23, 432, 956, 123, 55);
  counts: array[1..5] of Integer =
  (23, 432, 956, 123, 55);
var vat: Double;
begin
  // Set the widths of the rows
  case ColNr of
    1: par.ASet(WPAT_COLWIDTH_PC, 500); // % * 100 !
    2: par.ASet(WPAT_COLWIDTH_PC, 2500);
  else
    begin
      par.ASet(WPAT_COLWIDTH_PC, 1400);
      par.ASet(WPAT_Alignment, Integer(paralRight));
    end;
  end;

  // Set the text and the cell names and commands

  if RowNr = 1 then // Header Row ------------------------------
  begin
    case ColNr of
      1: ;
      2: par.SetText('Product');
      3: par.SetText('Price');
      4: par.SetText('Amount');
      5: par.SetText('net');
      6: par.SetText('+VAT');
      7: par.SetText('total');
    end;
    par.ASetColor(WPAT_FGColor, $A0A0A0);
    par.ASet(WPAT_ParProtected, 1);
    par.ASet(WPAT_Alignment, Integer(paralCenter));
  end else
    if RowNr = 7 then // Footer Row ------------------------------
    begin
      par.ADel(WPAT_BorderWidth); // Delete the border width for ALL linese
      par.ASet(WPAT_BorderWidthT, 40); // ANd set the top line to 40 twips
      par.ASetAdd(WPAT_BorderFlags, WPBRD_DRAW_Top); // Add a flag!
     // par.ParentRow.ASet(WPAT_BoxMinHeight, WPCentimeterToTwips(1.5));
      par.ASet(WPAT_SpaceBefore, WPCentimeterToTwips(0.3));
      par.ASet(WPAT_SpaceAfter, WPCentimeterToTwips(0.3));
      par.ASet(WPAT_ParProtected, 1);
      case ColNr of