subpar1.pas

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

unit SubPar1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WPCTRRich, WPGutter, WPRuler, WPRTEDefs, WPCTRMemo,
  ExtCtrls, WPTbar, ComCtrls;

type
  TWPSubParDemo = class(TForm)
    Panel2: TPanel;
    AllText: TWPRichText;
    WPRuler1: TWPRuler;
    WPGutter1: TWPGutter;
    FieldA: TMemo;
    FieldB: TWPRichText;
    FieldC: TMemo;
    Panel3: TPanel;
    Panel4: TPanel;
    PostData: TButton;
    LoadData: TButton;
    Panel5: TPanel;
    Panel6: TPanel;
    WPToolBar1: TWPToolBar;
    Live: TCheckBox;
    StatusBar1: TStatusBar;
    procedure LoadDataClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AllTextCustomLinePaintBefore(Sender: TObject;
      RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
      EndOfPageRun: Boolean);
    procedure PostDataClick(Sender: TObject);
    procedure AllTextChangeCursorPos(Sender: TObject);
    procedure AllTextKeyPress(Sender: TObject; var Key: Char);
    procedure FieldCChange(Sender: TObject);
    procedure AllTextChange(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    currentband: TParagraph;
  end;

var
  WPSubParDemo: TWPSubParDemo;

implementation

uses Types;

{$R *.dfm}

procedure TWPSubParDemo.FormCreate(Sender: TObject);
begin
  // Protect the bands
  AllText.ProtectedProp := [ppParProtected];
  // Optimized for screen display - we do not need printing!
  AllText.FormatOptions := [
    wpfAlwaysFormatWithScreenRes,
    wpDisableAutosizeTables]; // when you use WordWrap=TRUE
end;

procedure TWPSubParDemo.AllTextCustomLinePaintBefore(Sender: TObject;
  RTFEngine: TWPRTFEngineBasis; Param: TWPVirtPagePaintParam;
  EndOfPageRun: Boolean);
begin
  if Param.Par.ParagraphType = wpIsXMLTopLevel then
  begin
    Param.Canvas.Brush.Color := clBtnFace;
    Param.Canvas.FillRect(Param.Rect);
    Param.Canvas.Font.Height := MulDiv(Param.Rect.Bottom - Param.Rect.Top, 2, 3);
    Param.Canvas.Font.Name := 'Vardana';
    if AllText.Focused and (Param.Par = currentband) then
      Param.Canvas.Font.Color := clRed
    else Param.Canvas.Font.Color := clWhite;
    Param.Canvas.Font.Style := [fsBold];
    Param.Canvas.TextOut(Param.Rect.Left + 50, Param.Rect.Top + Param.Canvas.Font.Height div 3, Param.Par.Name);
    Param.Canvas.Pen.Width := 0;
    Param.Canvas.Pen.Color := clBtnHighlight;
    Param.Canvas.MoveTo(Param.Rect.Left, Param.Rect.Top);
    Param.Canvas.LineTo(Param.Rect.Right, Param.Rect.Top);
    Param.Canvas.Pen.Color := clBtnShadow;
    Param.Canvas.MoveTo(Param.Rect.Left, Param.Rect.Bottom - 5);
    Param.Canvas.LineTo(Param.Rect.Right, Param.Rect.Bottom - 5);
  end;
end;

procedure TWPSubParDemo.LoadDataClick(Sender: TObject);
var par: TParagraph;
  block: TWPRTFDataBlock;
  mem: TMemoryStream;
  s: string;
  charattr_for_ANSI: Cardinal;
begin
  mem := TMemoryStream.Create;

  WPBandHeightTw[wpIsXMLTopLevel] := 250;

  AllText.LockScreen;
  try
    AllText.Clear;
   // AFTER the clear we calculate our ANSI character property
    AllText.HeaderFooter.RTFProps.AttrHelper.Clear;
    AllText.HeaderFooter.RTFProps.AttrHelper.SetFontName('Courier New');
    AllText.HeaderFooter.RTFProps.AttrHelper.SetFontSize(1000);
    charattr_for_ANSI := AllText.HeaderFooter.RTFProps.AttrHelper.CharAttr;
   // and now create the text
    AllText.CheckHasBody;
    block := AllText.ActiveText;
    par := block.FirstPar;
    par.ASet(WPAT_ParProtected, 1);
    par.Name := 'FieldA';
    par.ParagraphType := wpIsXMLTopLevel;
    s := FieldA.Text;
   // SetAllText creates a sub paragraph when the first #13#10 is found!
    if s <> '' then par.SetAllText(#13 + #10 + s, charattr_for_ANSI); // The first ANSI Text

    par.NextPar := TParagraph.Create(block);
    par := par.NextPar;
    par.ParagraphType := wpIsXMLTopLevel;
    par.ASet(WPAT_ParProtected, 1);
    par.Name := 'FieldB';
    par.ASet(WPAT_CharFontSize, 900);
    FieldB.SaveToStream(mem, 'WPTOOLS');
    mem.Position := 0;
    par.LoadFromStream(mem, 'AUTO', '', []); // The formatted Text

    par.NextPar := TParagraph.Create(block);
    par := par.NextPar;
    par.ParagraphType := wpIsXMLTopLevel;
    par.ASet(WPAT_ParProtected, 1);
    par.Name := 'FieldC';
    s := FieldC.Text;
    if s <> '' then par.SetAllText(#13 + #10 + s, charattr_for_ANSI); // The last ANSI Text
  finally
    mem.Free;
    AllText.UnLockScreen(true);
  end;
end;

procedure TWPSubParDemo.PostDataClick(Sender: TObject);
var par, cpar: TParagraph;
  mem: TMemoryStream;
begin
  par := AllText.FirstPar;
  while par <> nil do
  begin
    if par.ParagraphType = wpIsXMLTopLevel then
    begin
      if par.Name = 'FieldA' then
      begin
        FieldA.Text := par.GetAllText(false, false);
      end
      else if par.Name = 'FieldB' then
      begin
        FieldB.LockScreen;
        try
         // This code uses AppendParCopy() to copy the text --------------------
          FieldB.Clear;
          cpar := par.ChildPar;
          while cpar <> nil do
            FieldB.BodyText.AppendParCopy(cpar);
          FieldB.CheckHasBody;

         // The code uses a stream to copy the text ----------------------------
         {mem := TMemoryStream.Create;
          try
            if par.SaveToStream(mem, true, 'WPTOOLS') then
            begin
              mem.Position := 0;
              FieldB.LoadFromStream(mem, 'WPTOOLS', true);
            end
            else FieldB.Clear;
          finally
            mem.Free;
          end;}

        finally
          FieldB.UnLockScreen(true);
        end;

      end
      else if par.Name = 'FieldC' then
      begin
        FieldC.Text := par.GetAllText(false, false);
      end;

    end;
    par := par.NextPar; // do NOT use "next" here
  end;
end;

procedure TWPSubParDemo.AllTextChangeCursorPos(Sender: TObject);
begin
  currentband := AllText.ActiveParagraph;
  while (currentband <> nil) and (currentband.ParentPar <> nil) do
    currentband := currentband.ParentPar;
  // Only "FieldB" is a formatted text field!
  WPToolBar1.Enabled :=
    (currentband <> nil) and (currentband.Name = 'FieldB');
end;

procedure TWPSubParDemo.AllTextKeyPress(Sender: TObject; var Key: Char);
begin
    // This is necessary - otherwise we cannot enter an empty field agaian!
  if (Key = #13) and (AllText.ActiveParagraph.ParagraphType = wpIsXMLTopLevel)
    and AllText.ActiveParagraph.Empty([], false) then
    AllText.ActiveParagraph.ChildPar :=
      TParagraph.Create(AllText.ActiveParagraph.RTFData);
end;

procedure TWPSubParDemo.FieldCChange(Sender: TObject);
begin
  if Live.Checked and Live.Enabled then
  try
    Live.Enabled := FALSE;
    LoadDataClick(nil);
  finally
    Live.Enabled := TRUE;
  end;
end;

procedure TWPSubParDemo.AllTextChange(Sender: TObject);
begin
  if Live.Checked and Live.Enabled then
  try
    Live.Enabled := FALSE;
    PostDataClick(nil);
  finally
    Live.Enabled := TRUE;
  end;
end;

end.