stymainu.pas

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

unit StyMainU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls, StyChildU, WPRTEDefs, WPRTEPaint, WPCTRMemo, WPCTRRich,
  wpDefActions, WPAction, WPTbar, WPPanel, WPUtil, WPStyles, WPPrvFrm;

type
  TWPGlobalStyle = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    Windows1: TMenuItem;
    ile1: TMenuItem;
    WIndMenu: TMenuItem;
    WPToolPanel1: TWPToolPanel;
    NewText: TButton;
    WPComboBox1: TWPComboBox;
    WPComboBox2: TWPComboBox;
    WPComboBox3: TWPComboBox;
    WPComboBox4: TWPComboBox;
    StyleParent: TWPRichText;
    WPDefaultActions1: TWPDefaultActions;
    NameList: TListBox;
    StartDemo: TButton;
    InfoPanel: TPanel;
    Styles1: TMenuItem;
    EditStylesheet1: TMenuItem;
    WPStyleDlg1: TWPStyleDlg;
    GenerateText1: TMenuItem;
    CreateBigText: TMenuItem;
    WPPreviewDlg1: TWPPreviewDlg;
    procedure NewTextClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StyleParentInitializeRTFDataObject(Sender: TObject;
      var RTFDataObject: TWPRTFDataCollection;
      var RTFPropsObject: TWPRTFProps);
    procedure FormShow(Sender: TObject);
    procedure NameListClick(Sender: TObject);
    procedure ile1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure StartDemoClick(Sender: TObject);
    procedure EditStylesheet1Click(Sender: TObject);
    procedure CreateBigTextClick(Sender: TObject);
  private
    TextNr: Integer;
    FDemoRunning, FDemoStop : Boolean;
  public
    DataList: TStringList;
    function NewWindow(CreateText : Boolean = FALSE) : TWPGlobalStyleChild;
  end;

var
  WPGlobalStyle: TWPGlobalStyle;

  // This variable is initialized by the main form
  // It is a reference to a TWPRTFProps component which has
  // to be used for all TWPRichText objects which are using
  // the same styles. This way the color and font tables
  // are always synchronized!
  WPGlobalRTFProps: TWPRTFProps;

implementation

uses Math;

{$R *.dfm}

function TWPGlobalStyle.NewWindow(CreateText : Boolean = FALSE) : TWPGlobalStyleChild;
begin
    Result := TWPGlobalStyleChild.Create(Self);

    Result.WPRichText1.LayoutMode := wplayNormal;

    inc(TextNr);
    Result.Caption := 'Text_' + IntToStr(TextNr);
    DataList.Append('');
    NameList.Items.Append(Result.Caption);

    if CreateText then
       Result.WPRichText1.InputString('This is the text' + #13 + 'number ' + IntToStr(TextNr));

    Result.Show;
end;

procedure TWPGlobalStyle.NewTextClick(Sender: TObject);
begin
  NewWindow(true);
end;

procedure TWPGlobalStyle.FormCreate(Sender: TObject);
begin
  // Inititialize WPGlobalRTFProps
  WPGlobalRTFProps := TWPRTFProps.Create;
  WPGlobalRTFProps.Locked := TRUE;

  DataList := TStringList.Create;
end;

procedure TWPGlobalStyle.StyleParentInitializeRTFDataObject(
  Sender: TObject; var RTFDataObject: TWPRTFDataCollection;
  var RTFPropsObject: TWPRTFProps);
begin
  RTFPropsObject := WPGlobalRTFProps;
end;

procedure TWPGlobalStyle.EditStylesheet1Click(Sender: TObject);
begin
  WPStyleDlg1.RTFProps := WPGlobalRTFProps;
  WPStyleDlg1.Execute;
end;

procedure TWPGlobalStyle.FormShow(Sender: TObject);
begin
  StyleParent.RTFText.Apply; // This loads the styles
end;

procedure TWPGlobalStyle.FormDestroy(Sender: TObject);
begin
  WPGlobalRTFProps.Free;
  DataList.Free;
end;

procedure TWPGlobalStyle.NameListClick(Sender: TObject);
var s: string;
  i: Integer;
begin
  if NameList.ItemIndex >= 0 then
  begin
    s := NameList.Items[NameList.ItemIndex];
    for i := 0 to MDIChildCount - 1 do
    begin
      if MDIChildren[i].Caption = s then
      begin
        MDIChildren[i].BringToFront;
        exit;
      end;
    end;
    with TWPGlobalStyleChild.Create(Self) do
    begin
      WPRichText1.LayoutMode := wplayNormal;
      WPRichText1.AsString := DataList.Strings[NameList.ItemIndex];
      Caption := s;
      Show;
    end;
  end; 
end;

procedure TWPGlobalStyle.CreateBigTextClick(Sender: TObject);
var i : Integer;
    rtfdataobj : TWPRTFDataBlock;
    s : String;
begin
   StyleParent.HeaderFooter.Clear(true,true);
   StyleParent.HeaderFooter.RTFProps.Assign(WPGlobalRTFProps);
   for i:=MDIChildCount-1 downto 0 do
      MDIChildren[i].Close;

   StyleParent.InputString(#13+#13);
   StyleParent.InputMergeField(WPTOC_FIELDNAME,'TOC will be created here ....');
   StyleParent.InputString(#13+#13);

   for i:=0 to DataList.Count-1 do
   begin
     // Create Caption
     StyleParent.ActiveStyleName := ''; // no style, no attribute
     // Create bookmark tags <a>|</a>. The name always starts with "_Toc"
     StyleParent.BookmarkInput('_Toc_' + NameList.Items[i],true);
     // Create the text inside
     StyleParent.InputString(NameList.Items[i]);
     // Skip the closing bookmark tag </a>
     StyleParent.CPMoveNext;
     // Make sure this line has the outline property ans set some attributes
     StyleParent.ActiveParagraph.ASet(WPAT_ParIsOutline,1);
     StyleParent.ActiveParagraph.ASetCharStyle(true, WPSTY_UNDERLINE);
     StyleParent.ActiveParagraph.ASetCharStyle(true, WPSTY_BOLD);
     StyleParent.ActiveParagraph.ASetFontName('Times New Roman');
     StyleParent.ActiveParagraph.ASet(WPAT_CharFontSize,1100); // 11pt
     StyleParent.InputString(#13);
     StyleParent.WritingAttr.Clear;
     StyleParent.SelectionAsString := DataList.Strings[i];
     StyleParent.InputString(#13);
   end;

   // StyleParent.CPPosition := 0;
   StyleParent.CreateTableOfContents('','_Toc_',[wptocUseParIsOutline]);
   //StyleParent.ReformatAll;
   StyleParent.SaveToFile('c:\toc.rtf');
   StyleParent.Refresh;
   WPPreviewDlg1.Execute;
end;


procedure TWPGlobalStyle.ile1Click(Sender: TObject);
begin
  Tile;
end;

// It would be better to save the style part and the RTF text into a database
// but since we want to create a database independent application
// we abuse our StyleParent to create one big text.
procedure TWPGlobalStyle.Save1Click(Sender: TObject);
var i : Integer;
    rtfdataobj : TWPRTFDataBlock;
    s : String;
begin
   StyleParent.HeaderFooter.Clear(true,true);

   StyleParent.HeaderFooter.RTFProps.Assign(WPGlobalRTFProps);

   for i:=MDIChildCount-1 downto 0 do
      MDIChildren[i].Close;
   for i:=0 to DataList.Count-1 do
   begin
     rtfdataobj := StyleParent.HeaderFooter.Append(wpIsOwnerSelected,
       wpraOnAllPages, NameList.Items[i]);
     s := DataList.Strings[i];


     rtfdataobj.RtfText.AsString := s;
   end;
   StyleParent.InputString('This text contains :');
   StyleParent.InputString(DataList.Count);
   StyleParent.InputString(' sub texts');
   StyleParent.TextSaveFormat := 'WPTOOLS';
   StyleParent.Save;
end;

procedure TWPGlobalStyle.Open1Click(Sender: TObject);
var i : Integer;
    rtfdataobj : TWPRTFDataBlock;
begin
  StyleParent.TextLoadFormat := 'WPTOOLS';
  if StyleParent.Load then
  begin
     TextNr := 0;
     DataList.Clear;
     NameList.Items.Clear;

     WPGlobalRTFProps.Assign(StyleParent.HeaderFooter.RTFProps);

     for i:=0 to StyleParent.HeaderFooter.Count-1 do
     begin
        rtfdataobj := StyleParent.HeaderFooter.Items[i];
        if (rtfdataobj.Kind=wpIsOwnerSelected) and (rtfdataobj.Name<>'') then
        begin
           NameList.Items.Append(rtfdataobj.Name);
           rtfdataobj.RtfText.Format := 'WPTOOLS';
           DataList.Append(rtfdataobj.RtfText.AsString);
        end;
     end;
  end;
end;

procedure TWPGlobalStyle.StartDemoClick(Sender: TObject);
var sty : TWPTextStyle;
    win1, win2 : TWPGlobalStyleChild;
    i : Integer;
    procedure Sleep(m : Integer);
    var tim : Cardinal;
    begin 
      if fsBold in StartDemo.Font.Style then
           StartDemo.Font.Style := []
      else StartDemo.Font.Style := [fsBold];
      tim := GetTickCount + m;
      while not FDemoStop and (tim>GetTickCount) do
        Application.ProcessMessages;
    end;
begin
   if FDemoRunning then
      FDemoStop := TRUE
   else
   try
   FDemoRunning := TRUE;
   FDemoStop := FALSE;
   Tile;
   ShowMessage('This demo show how a global paragraph style'
    + #13 + 'is used by two different texts.'
    + #13 + 'This also works when the text are'
    + #13 + 'currently not displayed (loaded).'
    +#13 + #13 + 'Please sit back...' );
   // Clear all
   for i:=MDIChildCount-1 downto 0 do
      MDIChildren[i].Close;
   NameList.Items.Clear;
   DataList.Clear;
   TextNr := 0;
   StyleParent.Clear;
   // --------------------------------------------------------------------------
   // define a style in WPGlobalRTFProps!
   sty := WPGlobalRTFProps.ParStyles.AddStyle('Color');
   sty.ASetColor(WPAT_CharColor, clRed);
   sty.ASetCharStyle(true, WPSTY_BOLD);
   // --------------------------------------------------------------------------

   win1 := NewWindow;
   with win1.WPRichText1 do
   begin
      WritingAttr.SetFontName('Courier New');
      WritingAttr.SetFontSize(10);
      InputString('This is Text ONE, using Style "Color" - now red');
      { note:
        To assign the style you could use
          ActiveStyleName := 'Color';
          or CurrAttr.StyleName := 'Color'
        but this resets the current writing (WritingAttr.Clear)
      }
      ActiveParagraph.ABaseStyleName := 'Color';

      InputString(#13);
   end;
   Sleep(2000);

   win2 := NewWindow;
   with win2.WPRichText1 do
   begin
      WritingAttr.SetFontName('Arial');
      WritingAttr.SetFontSize(8);
      InputString('This is Text 2, also using Style "Color"');
      ActiveParagraph.ABaseStyleName := 'Color';
      InputString(#13);
      Sleep(2000);
      InputString(#13);
      Sleep(1000);
      InputString('We now close window ONE.' + #10 + '(-> Save + Free)');
      InputString(#13);
      Sleep(2000);
      win1.Close;
      Sleep(2000);
      InputString(#13);
      InputString('Now change style "color"');
      InputString(#13);
      Sleep(2000);
      sty.ASetColor(WPAT_CharColor, clGreen);
      Refresh;
      Sleep(2000);
      InputString(#13);
      InputString('G R E E N!');
      InputString(#13);
      Sleep(1000);
      InputString(#13);
      InputString('We close&save this text!');
      Sleep(2000);
      win2.Close;
   end;
   Sleep(500);
   InfoPanel.Font.Style := [];
   InfoPanel.Font.Size := 11;
   InfoPanel.Caption := 'Load text ONE. It is now Green!';
   InfoPanel.Visible := TRUE;
   Sleep(2000);
   InfoPanel.Font.Style := [fsBold];
   Sleep(2000);
   InfoPanel.Visible := FALSE;
   NameList.ItemIndex := 0;
   NameListClick(nil);
   // -------- finished .... ---------------------------------------------------
   finally
   StartDemo.Enabled := TRUE;
   StartDemo.Font.Style := [];
   FDemoRunning := FALSE;
   end;
end;   




end.