threadu.pas

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

unit ThreadU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WPRTEDefs, WPRTEPaint, WPCtrMemo, WPIO, WPCTRRich, FileCtrl;

{$DEFINE NOENVIROMENT} // Don't always need individual enviroments

type
  TWPMultiThread = class(TForm)
    DirName: TEdit;
    Label1: TLabel;
    Button1: TButton;
    SomeText: TEdit;
    Label2: TLabel;
    Template: TWPRichText;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    T : Integer;
  public
    { Public-Deklarationen }
  end;

  // The demo thread object. It does a simple mailmerge and save the
  // text as RTF file
  TWPToolsThread = class(TThread)
  private
    FCount: Integer;
    RichText: TWPCustomRtfEdit;
    Enviroment: TWPToolsEnviroment;
    FDirName, FSomeText : String;
  protected
    procedure Execute; override;

    procedure DoMailMergeGetText(Sender: TObject;
      const inspname: string; Contents: TWPMMInsertTextContents);

  public
    constructor Create(const SomeText, DirName, Text: string; Count: Integer);
    destructor Destroy; override;
  end;

var
  WPMultiThread: TWPMultiThread;

implementation

{$R *.dfm}

procedure TWPMultiThread.FormCreate(Sender: TObject);
begin
  DirName.Text :=
    ExtractFilePath(Application.ExeName) + 'files';
end;

procedure TWPMultiThread.Button1Click(Sender: TObject);
begin
   with TWPToolsThread.Create(SomeText.Text, DirName.Text,
     Template.AsANSIString('WPTOOLS'),
     100) do
   begin
    FreeOnTerminate := TRUE;    
    // OnTerminate := ThreadDone;
    // OnProgress  := ShowProgress;
   end;
   SomeText.Text := 'Test' + IntToStr(T);
   Inc(T);
end;

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

procedure TWPToolsThread.Execute; 
var i: Integer;
begin
  for i := 0 to FCount - 1 do
  begin
    RichText.MergeText;
    RichText.SaveToFile(FDirName + '\' + FSomeText + '-' + IntToStr(i) + '.RTF');
    // sleep(100);
  end;
end;

constructor TWPToolsThread.Create(const SomeText, DirName, Text: string; Count: Integer);
begin
  inherited Create(false);
  ForceDirectories(DirName);
  RichText := TWPCustomRtfEdit.CreateDynamic;
  {$IFNDEF NOENVIROMENT}
  Enviroment := TWPToolsEnviroment.Create(nil);
  Enviroment.Assign(GlobalWPToolsCustomEnviroment);
  RichText.Memo.RTFData.RTFProps.Enviroment := Enviroment;
  {$ENDIF}
  RichText.OnMailMergeGetText := DoMailMergeGetText;

  RichText.AsString := Text;
  FCount := Count;
  FSomeText := SomeText;
  FDirName := DirName;
end;

procedure TWPToolsThread.DoMailMergeGetText(Sender: TObject;
  const inspname: string; Contents: TWPMMInsertTextContents);
begin
  Contents.StringValue := IntToStr(Random(10000));
end;

destructor TWPToolsThread.Destroy;
begin
  {$IFNDEF NOENVIROMENT}
  Enviroment.Free;
  {$ENDIF}
  RichText.Free;
  inherited Destroy;   
end;



end.