mailmun1.pas

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

unit MailMUn1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, Db, DBTables, Grids, DBGrids, ExtCtrls, ComCtrls,
  WPRuler, Wpdbrich, HintFormU, ShellAPI, wpDefActions, WPCTRRich, WPTbar,
  WPRTEDefs, WPCTRMemo;

  // removed WPRich, WPDefs, WPTbar, wprtfio, WPPrint, WpWinCtr, WPEmObj, 

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Table1: TTable;
    DBNavigator1: TDBNavigator;
    OpenTable: TButton;
    OpenDialog1: TOpenDialog;
    Panel2: TPanel;
    Panel3: TPanel;
    WPRichText1: TWPRichText;
    WPToolBar1: TWPToolBar;
    WPRuler1: TWPRuler;
    WPVertRuler1: TWPVertRuler;
    InsertField: TButton;
    FieldList: TListBox;
    DBNavigator2: TDBNavigator;
    WPMMDataProvider1: TWPMMDataProvider;
    Panel4: TPanel;
    AllRTFText: TWPRichText;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    ShowFields: TCheckBox;
    Button2: TButton;
    Label1: TLabel;
    WPDefaultActions1: TWPDefaultActions;
    Dummy: TCheckBox;
    DeleteFields: TButton;
    Button3: TButton;
    procedure OpenTableClick(Sender: TObject);
    procedure InsertFieldClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  {  procedure AllRTFTextActivateHotStyle(Sender: TObject; pa: PTAttr;
      par: PTParagraph; lin: PTLine; cp: Integer); }
    procedure AllRTFTextDeactivateHotStyle(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WPRichText1ChangeSelection(Sender: TObject);
    procedure ShowFieldsClick(Sender: TObject);
    procedure WPRichText1MeasureTextPage(Sender: TObject;
      PageInfo: TWPMeasurePageParam);
    procedure WPRichText1ActivatingHotStyle(Sender: TObject;
      par: TParagraph; posinpar: Integer);
    procedure Button2Click(Sender: TObject);
    procedure DummyClick(Sender: TObject);
    procedure DeleteFieldsClick(Sender: TObject);
    procedure WPRichText1DeactivateHotStyle(Sender: TObject);
    procedure WPRichText1ActivateHint(Sender: TObject; txtobj: TWPTextObj;
      par: TParagraph; posinpar: Integer);
    procedure Button3Click(Sender: TObject);
    procedure WPRichText1HyperLinkEvent(Sender: TObject; text, url: String;
      IgnoredNumber: Integer);
  private
    FHintForm : THintForm;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.OpenTableClick(Sender: TObject);
begin
   if OpenDialog1.Execute then
   begin
      Table1.Active := FALSE;
      Table1.DataBaseName := ExtractFilePath(OpenDialog1.FileName);
      Table1.TableName := ExtractFileName(OpenDialog1.FileName);
      Table1.Open;
      Table1.GetFieldNames(FieldList.Items);
      WPMMDataProvider1.AutoLoadData := TRUE;
   end;
end;

procedure TForm1.InsertFieldClick(Sender: TObject);
var i : Integer;
begin
  i := FieldList.ItemIndex;
  if i<0 then ShowMessage('Please open a table and select a field') else
  // WPRichText1.InputField('<',FieldList.Items[i]+'>',FieldList.Items[i]);
  WPRichText1.InputMergeField(FieldList.Items[i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i : Integer;
    tim : Cardinal;
    Section : TWPRTFSectionProps;
begin
   Table1.DisableControls;
   try
   AllRTFText.BeginUpdate;
   Table1.First;
   i := 0;
   while not Table1.EOF do begin Inc(i); Table1.Next; end;
   ProgressBar1.Max := i;
   Table1.First;
   i := 0;
   AllRTFText.Clear;
   tim := GetTickCount;
   while not Table1.EOF do
   begin
      ProgressBar1.Position := i;
      WPRichText1.MergeText;

      if i=0 then // FIRST RUN
      begin
         AllRTFText.AsString := WPRichText1.AsString;
         AllRTFText.CPPosition := MaxInt; // to end
      end
      else if i>0 then // SUBSEQUENT RUNS
      begin
         // Append a new paragragraph IF  the last line is not empty
         if AllRTFText.ActivePosInPar>0 then
             AllRTFText.InputString(#13);
         // Need page break
         AllRTFText.FastSetPageBreak(true, true);
         // and append the text
         Section := AllRTFText.FastAppendText(WPRichText1,true);
         Section.Select := [wpsec_ResetOutlineNums];
      end;
      Application.ProcessMessages;
      Table1.Next;
      inc(i);
   end;
   Label1.Caption := IntToStr(GetTickCount-tim);
   finally
   AllRTFText.EndUpdate;
   Table1.EnableControls;
  { AllRTFText.SaveToFile('c:\a.rtf',false,'RTF');
   AllRTFText.ReformatAll();
   AllRTFText.SaveToFile('c:\a2.rtf',false,'RTF-nonumberprops,-nomergefields,-nohyperlinks'); }
   end;
end;

procedure TForm1.DummyClick(Sender: TObject);
var i : Integer;
    tim : Cardinal;
    Section : TWPRTFSectionProps;
begin
   try
   AllRTFText.BeginUpdate;
   i := 0;
   ProgressBar1.Max := 500;
   i := 0;
   AllRTFText.Clear;
   tim := GetTickCount;
   AllRTFText.Header.Assign(WPRichText1.Header);
   while i<500 do
   begin
      ProgressBar1.Position := i;
      WPRichText1.MergeText;    //was: WPRichText1.FastMergeText;
      { Alternative, slower method to append the RTF data:
        AllRTFText.CPPosition := $FFFFFF;
        AllRTFText.SelectionAsString := WPRichText1.AsString; }
      AllRTFText.FastSetPageBreak(true, true);
      Section := AllRTFText.FastAppendText(WPRichText1, true);
      Section.Select := [wpsec_ResetOutlineNums];
      Application.ProcessMessages;
      inc(i);
   end;
   AllRTFText.Refresh;
   Label1.Caption := IntToStr(GetTickCount-tim);
   finally
   AllRTFText.EndUpdate;
 {  AllRTFText.SaveToFile('c:\a.rtf',false,'RTF');
   AllRTFText.ReformatAll();
   AllRTFText.SaveToFile('c:\a2.rtf',false,'RTF-nonumberprops,-nomergefields');   }
   end;
end;

(*
procedure TForm1.AllRTFTextActivateHotStyle(Sender: TObject; pa: PTAttr;
  par: PTParagraph; lin: PTLine; cp: Integer);  *)

procedure TForm1.WPRichText1ActivatingHotStyle(Sender: TObject;
  par: TParagraph; posinpar: Integer);
var p : TPoint;
    txtobj : TWPTextObj;
begin
  if par <> nil then
  begin
     txtobj := (Sender as TWPCustomRTFEdit).FieldGetInPar(par,posinpar);
     if txtobj<>nil then
     begin
     FHintForm.Caption := txtobj.Name;
     p := TWPCustomRTFEdit(Sender).GetPointFromParLin(par, posinpar);
     if p.x > TWPCustomRTFEdit(Sender).Width then p.x := TWPCustomRTFEdit(Sender).Width;
     p := TWPCustomRTFEdit(Sender).ClientToScreen(p);
     FHintForm.Left := p.x;
     FHintForm.Top := p.y;
     FHintForm.Show;
     end;
  end;
end;

procedure TForm1.WPRichText1ActivateHint(Sender: TObject;
  txtobj: TWPTextObj; par: TParagraph; posinpar: Integer);
var p : TPoint;
begin
  if par <> nil then
  begin
     if txtobj<>nil then
        FHintForm.Caption := txtobj.Name;

     p := TWPCustomRTFEdit(Sender).GetPointFromParLin(par, posinpar);
     if p.x > TWPCustomRTFEdit(Sender).Width then p.x := TWPCustomRTFEdit(Sender).Width;
     p := TWPCustomRTFEdit(Sender).ClientToScreen(p);
     FHintForm.Left := p.x;
     FHintForm.Top := p.y;
     FHintForm.Show;
  end;
end;

procedure TForm1.WPRichText1DeactivateHotStyle(Sender: TObject);
begin
   FHintForm.Hide;
end;

procedure TForm1.AllRTFTextDeactivateHotStyle(Sender: TObject);
begin
   FHintForm.Hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   FHintForm := THintForm.Create(Self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    FHintForm.Free;
end;

procedure TForm1.WPRichText1ChangeSelection(Sender: TObject);
begin
  Caption := Format('%d -> %d',[WPRichText1.SelStart, WPRichText1.SelLength]);
end;

procedure TForm1.ShowFieldsClick(Sender: TObject);
begin
  WPMMDataProvider1.ShowFieldNames :=  ShowFields.Checked;
end;

procedure TForm1.WPRichText1MeasureTextPage(Sender: TObject;
  PageInfo: TWPMeasurePageParam);
begin
 PageInfo.margintop     := 140;
 PageInfo.marginbottom  := 140;
 if (PageInfo.pagenr and 1)=1 then
 begin
   PageInfo.marginleft   := 140;
   PageInfo.marginright  := 720;
   PageInfo.widthtw := PageInfo.marginleft+PageInfo.marginright+1440;
 end
 else
 begin
    PageInfo.marginleft   := 720;
    PageInfo.marginright  := 140;
    PageInfo.widthtw := PageInfo.marginleft+PageInfo.marginright+2880;
 end;
 PageInfo.heighttw := 2880;
 PageInfo.Changed := TRUE;
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
  WPRichText1.ReplaceTokens('<','>');
end;

procedure TForm1.DeleteFieldsClick(Sender: TObject);
begin
  WPRichText1.DeleteFields;
end;







procedure TForm1.Button3Click(Sender: TObject);
var par : TParagraph;
    startobj, endobj : TWPTextObj;
begin
 par := WPRichText1.ActiveText.AppendNewPar();
 par.Append('This is a link: ');                              // Some Text
 startobj := par.AppendNewObject(wpobjHyperlink,true,false);  // Opening
 par.Append('WPCubed GmbH');                                  // More Text
 endobj   := par.AppendNewObject(wpobjHyperlink,true,true);   // Closing
 endobj.SetTag(startobj.NewTag);                              // Link Opening<->Closing

 startobj.Source := 'http://www.wpcubed.com';

 startobj.MakeStyle(true);
 startobj.Style.ASet(WPAT_CharFontSize, 2200);     // create a large font
 startobj.Style.ASetColor(WPAT_CharColor, clRed);  // as red text
 startobj.Style.ASetColor(WPAT_CharBGColor, clYellow); // on yellow background
 startobj.Style.ASetFontName('Courier New');

 // to display:
 WPRichText1.Refresh;
end;

procedure TForm1.WPRichText1HyperLinkEvent(Sender: TObject; text,
  url: String; IgnoredNumber: Integer);
begin
  if Pos('http:',url)>0 then
    ShellExecute(Handle, 'open', PChar(url), '', '', SW_SHOW	);
end;

end.