📄 textobjunit1.pas
字号:
unit TextObjUnit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, WPRTEDefs, WPCTRMemo, WPRTEPaint, WPCTRRich;
type
TForm1 = class(TForm)
WPRichText1: TWPRichText;
Panel1: TPanel;
MergeField: TButton;
PageNumber: TButton;
CustomObj: TButton;
TxtObjText: TEdit;
CustomMarker: TButton;
InsertImage: TButton;
Image1: TImage;
PageNumberInHeader: TButton;
Button1: TButton;
procedure MergeFieldClick(Sender: TObject);
procedure PageNumberClick(Sender: TObject);
procedure CustomObjClick(Sender: TObject);
procedure WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
HeightInPix: Integer; var PaintObject: TWPTextObj; Xres,
YRes: Integer);
procedure TxtObjTextChange(Sender: TObject);
procedure CustomMarkerClick(Sender: TObject);
procedure WPRichText1TextObjectClick(Sender: TWPCustomRtfEdit;
pobj: TWPTextObj; obj: TWPObject; var ignore: Boolean);
procedure WPRichText1TextObjectMouseMove(Sender: TWPCustomRtfEdit;
pobj: TWPTextObj; obj: TWPObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure InsertImageClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure OnPaintMarker(Sender : TWPTextObj;
OutCanvas : TCanvas;
XRes, YRes : Integer;
X, Y, W, H, BASE: Integer );
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.MergeFieldClick(Sender: TObject);
begin
WPRichText1.InputMergeField('NAME','Julian Ziersch');
end;
procedure TForm1.PageNumberClick(Sender: TObject);
var dropmarker : Integer;
begin
if Sender=PageNumberInHeader then
begin
dropmarker := WPRichText1.TextCursor.DropMarker;
WPRichText1.ActiveText := WPRichText1.HeaderFooter.Get
(wpIsHeader, wpraOnAllPages, '');
WPRichText1.ActiveText.Clear;
end else dropmarker := 0;
WPRichText1.InputString('Page ');
WPRichText1.InputTextField(wpoPageNumber);
WPRichText1.InputString(' of ');
WPRichText1.InputTextField(wpoNumPages);
if dropmarker<>0 then
begin
WPRichText1.InputString(#10);
WPRichText1.TextObjects.InsertNewObject(wpobjHorizontalLine,false,false).Height := 4;
WPRichText1.WorkOnText := wpBody;
WPRichText1.TextCursor.GotoMarker(dropmarker);
end;
WPRichText1.SetFocus;
end;
// Custom Text field Object
procedure TForm1.CustomObjClick(Sender: TObject);
begin
WPRichText1.InputTextFieldName('CHANGEME');
end;
procedure TForm1.WPRichText1TextObjGetTextEx(RefCanvas: TCanvas;
TXTObject: TWPTextObj; var PrintString: WideString; var WidthInPix,
HeightInPix: Integer; var PaintObject: TWPTextObj; Xres, YRes: Integer);
begin
if TXTObject.Name='CHANGEME' then
begin
PrintString := #32+ TxtObjText.Text + #32;
RefCanvas.Font.Height := -Round(YRes/72*9); // 9 pt!
RefCanvas.Font.Color := clRed;
RefCanvas.Brush.Color := clYellow;
end
else if TXTObject.Name='MARKER' then
begin
WidthInPix := Xres div 5;
TXTObject.OnPaint := OnPaintMarker;
// This line is required:
PaintObject := TXTObject;
end;
end;
procedure TForm1.TxtObjTextChange(Sender: TObject);
begin
WPRichText1.ReformatAll(true,true); // Initialize!!
end;
// ---------- MARKER
procedure TForm1.CustomMarkerClick(Sender: TObject);
begin
WPRichText1.InputTextFieldName('MARKER');
end;
procedure TForm1.OnPaintMarker(Sender : TWPTextObj;
OutCanvas : TCanvas;
XRes, YRes : Integer;
X, Y, W, H, BASE: Integer );
var o : Integer;
begin
OutCanvas.Pen.Color := clBlack;
OutCanvas.Brush.Color := clYellow;
OutCanvas.RoundRect(x,y,x+w,y+h,XRes div 10, YRes div 10);
OutCanvas.Pen.Color := clRed;
o := XRes div 60;
OutCanvas.Pen.Width := 0;
OutCanvas.MoveTo(x + o*2, y + h div 2);
OutCanvas.LineTo(x + w - o*3, y + h div 2);
OutCanvas.MoveTo(x + w - o * 6, y + h div 2 - o * 3);
OutCanvas.LineTo(x + w - o*3, y + h div 2);
OutCanvas.LineTo(x + w - o * 6, y + h div 2 + o * 3);
end;
procedure TForm1.WPRichText1TextObjectClick(Sender: TWPCustomRtfEdit;
pobj: TWPTextObj; obj: TWPObject; var ignore: Boolean);
begin
if (pobj.ObjType=wpobjTextObject)
and (pobj.Name='MARKER')
then
begin
// locate next data record or similar ...
ShowMessage('Object was clicked!' + #13 +
pobj.AGetWPSS );
end;
end;
procedure TForm1.WPRichText1TextObjectMouseMove(Sender: TWPCustomRtfEdit;
pobj: TWPTextObj; obj: TWPObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (pobj.ObjType=wpobjTextObject)
// and (pobj.Name='CHANGEME')
then
begin
// locate next data record or similar ...
// ShowMessage('Object "' + pobj.Name + '" was clicked!');
Screen.Cursor := crHandPoint;
end;
end;
// Insert an image
procedure TForm1.InsertImageClick(Sender: TObject);
begin
WPRichText1.TextObjects.InsertCopy(Image1.Picture.Graphic);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WPRichText1.SelectionAsString :=
'{\rtf{\*\field{\fldinst{MARKER}}{\fldrslt{params}}}}'; // If you need to set the text in 'params'
// WPRichText1.SelectionAsString :=
// '{\rtf{\*\field\fldinst{MARKER sourcetext}}}'; // short form, sourcetext -> TextObj.Source
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -