booktest.pas

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

unit BookTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, 
  WPRTEDefs, WPCTRMemo, WPCTRRich;

type
  TForm1 = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    Label1: TLabel;
    Bookmarks: TComboBox;
    Extract: TButton;
    WPRichText2: TWPRichText;
    Back: TButton;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    ShowBookmarkCodes: TCheckBox;
    Button3: TButton;
    BListBox: TListBox;
    Label2: TLabel;
    Button4: TButton;
    procedure BookmarksDropDown(Sender: TObject);
    procedure ExtractClick(Sender: TObject);
    procedure BackClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ShowBookmarkCodesClick(Sender: TObject);
    procedure WPRichText1CodeGetText(Sender: TObject;
      var DisplayText: String; const sName, sExtra: String; IsOpening,
      IsClosing: Boolean; p: PTTextObj; par: PTParagraph; lin: PTLine;
      cp: Integer);
    procedure WPRichText1GetAttributeColor(Sender: TObject;
      var CharStyle: TCharacterAttr; par: TParagraph; posinpar: Integer);
    procedure FormCreate(Sender: TObject);
    procedure WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
      TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
      HeightInPix: Integer; var PaintObject: TWPTextObj; Xres,
      YRes: Integer);
    procedure WPRichText1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure WPRichText1ChangeCursorPos(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure OnPaintObject(Sender : TWPTextObj;
    OutCanvas  : TCanvas;
    XRes, YRes : Integer;
    X, Y, W, H, BASE: Integer );
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BookmarksDropDown(Sender: TObject);
begin
  WPRichText1.BookmarkGetList( Bookmarks.Items );
end;

procedure TForm1.ExtractClick(Sender: TObject);
begin
  if WPRichText1.BookmarkSelect( Bookmarks.Text, true ) then
  begin
     WPRichText2.AsString := WPRichText1.SelectionAsString;
     WPRichText1.ClearSelection;
  end;
end;

procedure TForm1.BackClick(Sender: TObject);
begin
  if WPRichText1.BookmarkMoveTo( Bookmarks.Text ) then
  begin
     WPRichText1.CPMoveNext;
     WPRichText1.SelectionAsString := WPRichText2.AsString;
     WPRichText2.Clear;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Edit1.Text='' then ShowMessage('Please enter a bookmark name!')
  else WPRichText1.BookmarkInput(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WPRichText1.BookmarkSelect( Bookmarks.Text, true );
  WPRichText1.SetFocus;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if MessageDlg('Delete Bookmark ' +Bookmarks.Text,  mtConfirmation, [mbYes, mbNo], 0)=IDYES then
 begin
   WPRichText1.BookmarkDelete(  Bookmarks.Text , true, false );
   WPRichText1.Refresh;
   Bookmarks.ItemIndex := -1;
 end;
end;

procedure TForm1.ShowBookmarkCodesClick(Sender: TObject);
begin
  if ShowBookmarkCodes.Checked then WPRichText1.FormatOptions :=
       [wpShowBookmarkCodes]
  else WPRichText1.FormatOptions :=[];
end;

procedure TForm1.WPRichText1CodeGetText(Sender: TObject;
  var DisplayText: String; const sName, sExtra: String; IsOpening,
  IsClosing: Boolean; p: PTTextObj; par: PTParagraph; lin: PTLine;
  cp: Integer);
//!!var pa : PTAttr;
begin
  // uses unit: WPrtfTXT
  if IsOpening then
  begin
     DisplayText := '<' + sName + '{';
  end
  else
  begin
     DisplayText := '}>';
  end;

  // Access the attribute directly:
  //  pa := lin^.pa;
  //   inc(pa,cp);
  //   pa^.color := 2;

end;

// Replaces: WPRichText1GetAttrColor
procedure TForm1.WPRichText1GetAttributeColor(Sender: TObject;
  var CharStyle: TCharacterAttr; par: TParagraph; posinpar: Integer);
var bobj : TWPTextObj;
begin
  // Get the object at this position. '-1' because the cursor is
  // imediately AFTER the start object
  bobj := par.ObjectRef[posinpar-1];
  if (bobj<>nil) and (bobj.Name = 'TEXT') then
  begin
    CharStyle.UseTextColor := TRUE;
    CharStyle.TextColor := Random(100000);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WPRichText1.Memo.RTFData.SpecialTextAttr[wpBookmarkedText].UseOnGetAttrColorEvent := TRUE;
end;

procedure TForm1.WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
  TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
  HeightInPix: Integer; var PaintObject: TWPTextObj; Xres, YRes: Integer);
begin
  if not ShowBookmarkCodes.Checked then
  begin
     PrintString := '';
  end else
  if TXTObject.ObjType=wpobjBookmark then
  begin
     // simple test:
     // PrintString := '<------------>';
     //
     // If you set PaintObject to anything <> nil PrintString will be ignored!
     // Here you can initialize an event for an owner draw object
     PaintObject := TXTObject;
     PaintObject.OnPaint := OnPaintObject;
     WidthInPix := RefCanvas.TextWidth(TXTObject.Name+'<'+#32);
     PrintString := '';
  end;
end;

procedure TForm1.OnPaintObject(Sender : TWPTextObj;
    OutCanvas  : TCanvas;
    XRes, YRes : Integer;
    X, Y, W, H, BASE: Integer );
var s : string;
begin
  if ShowBookmarkCodes.Checked then
  begin
    OutCanvas.Rectangle(x,y,x+w,y+h);
    OutCanvas.MoveTo(x+w,y+1);
    OutCanvas.LineTo(x+w,y+h);
    OutCanvas.LineTo(x+1,y+h);
    if wpobjIsClosing in Sender.Mode then
       s := '>' + Sender.Name
    else s := Sender.Name + '<';
    OutCanvas.TextOut(x+2,y+BASE,s);
  end;
end;


procedure TForm1.WPRichText1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var Code: TWPTextObj;
begin
   if WPRichText1.BookmarkAtXY(X,Y,Code) then
     Label2.Caption := Code.Name;
end;

procedure TForm1.WPRichText1ChangeCursorPos(Sender: TObject);
var TempList : TWPTextObjList; i : Integer;
begin
   TempList := TWPTextObjList.Create;
   WPRichText1.OpenCodesAtCP(TempList,wpobjBookmark); // was: wpcoBookMark
   BListBox.Items.Clear;
   for i:=TempList.Count-1 downto 0 do
      BListBox.Items.Add(TempList[i].Name) ;
   //was: BListBox.Items.Add(WPRichText1.Memo.TxtObjLst.Names[Integer(TempList[i])]) ;
   TempList.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
var s : string;
begin
 s := WPRichText1.AsString;
 WPRichText1.AsString := s;


end;

end.