unit drtsamp;
interface
{$I ..\Rich3Conf.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TFormDrawRtfText = class(TForm)
Panel1: TPanel;
Panel1a: TPanel;
Panel2: TPanel;
Button1: TButton;
Label1: TLabel;
Panel3: TPanel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Panel4: TPanel;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
CheckBox2: TCheckBox;
PaintBox1: TPaintBox;
Button2: TButton;
OpenDialog1: TOpenDialog;
FontDialog1: TFontDialog;
Label2: TLabel;
ComboBox1: TComboBox;
Label3: TLabel;
ComboBox2: TComboBox;
Label4: TLabel;
Memo1: TMemo;
LabelSep: TLabel;
Button3: TButton;
procedure PaintBox1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ComboBox2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
public
FText: AnsiString;
end;
var
FormDrawRtfText: TFormDrawRtfText;
implementation
{$R *.dfm}
uses
RichEditDll, DrawRichText;
const
CDefaultText =
'{\rtf1\ansi\ansicpg1252' +
'{\colortbl ;\red255\green0\blue128;\red224\green255\blue0;}{'#13#10 +
'Enter your text here, using normal RTF code for markup ' +
'(\b bold\b0 , \i italic\i0 , '#13#10 +
'\ul underline\ul0 for example), ' +
'then press the {\b {\ul U}pdate} button\par'#13#10 +
'You can also press the {\cf1\b {\ul L}oad} button and ' +
'take a look at some of the sample files or '#13#10 +
'browse your {\fs36 {\super hard}{\sub disk} }and ' +
'{\highlight2\b pick some} of your own RTF files...' +
'}}';
procedure TFormDrawRtfText.Button1Click(Sender: TObject);
var
fs: TFileStream;
begin
OpenDialog1.FileName := '';
if OpenDialog1.Execute then
begin
fs := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyWrite);
try
SetLength(FText, fs.Size);
fs.ReadBuffer(FText[1], fs.Size);
try
Memo1.Lines.Text := string(FText);
except
end;
finally
fs.Free;
PaintBox1.Invalidate;
end;
end;
end;
procedure TFormDrawRtfText.Button2Click(Sender: TObject);
begin
FontDialog1.Font.Assign(PaintBox1.Font);
if FontDialog1.Execute then
begin
PaintBox1.Font.Assign(FontDialog1.Font);
PaintBox1.Invalidate;
end;
end;
procedure TFormDrawRtfText.Button3Click(Sender: TObject);
begin
FText := AnsiString(Memo1.Lines.Text);
PaintBox1.Invalidate;
end;
procedure TFormDrawRtfText.CheckBox2Click(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
procedure TFormDrawRtfText.ComboBox2Click(Sender: TObject);
var
k: Integer;
v: TRichEditVersion;
begin
k := ComboBox2.ItemIndex;
v := TRichEditVersion(Integer(ComboBox2.Items.Objects[k]));
UseRichEditVersions := [v];
PaintBox1.Invalidate;
end;
procedure TFormDrawRtfText.FormCreate(Sender: TObject);
var
a: TRichEditVersions;
v, v1: TRichEditVersion;
s: string;
begin
if Screen.Fonts.IndexOf('Tahoma') >= 0 then
Font.Name := 'Tahoma';
{$IFDEF DELPHI_4_UP}
Constraints.MinWidth := Panel1.Width + 220 + (Width - ClientWidth);
Constraints.MinHeight := (Label4.Top + Label4.Height + 8)
+ Height - ClientHeight;
{$ENDIF}
Icon.Assign(Application.Icon);
FText := CDefaultText;
try
Memo1.Lines.Text := string(FText);
except
end;
ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(' 100');
a := AvailableRichEditModules;
v1 := rvNone;
for v := Low(TRichEditVersion) to High(TRichEditVersion) do
if v in a then
with RichEditModules[v] do
begin
//if v1 = rvNone then // uncomment to pick the smallest version available
v1 := v;
s := Format('%d.%d', [Version div 10, Version mod 10]);
ComboBox2.Items.AddObject(s, Pointer(Ord(v)));
end;
UseRichEditVersions := [v1];
v := GetRichEditModule;
with RichEditModules[v] do
s := Format('%d.%d', [Version div 10, Version mod 10]);
ComboBox2.ItemIndex := ComboBox2.Items.IndexOf(s);
UseRichEditVersions := [v];
end;
procedure TFormDrawRtfText.PaintBox1Paint(Sender: TObject);
var
X, Y, W, H, Z: Integer;
Format: TRtfTextFormat;
rc, rcc: TRect;
begin
W := PaintBox1.ClientWidth;
H := PaintBox1.ClientHeight;
PaintBox1.Canvas.Pen.Color := RGB(224, 224, 244);
X := 10;
while X < W do
begin
PaintBox1.Canvas.MoveTo(X, 0);
PaintBox1.Canvas.LineTo(X, H);
inc(X, 10);
end;
Y := 10;
while Y < H do
begin
PaintBox1.Canvas.MoveTo(0, Y);
PaintBox1.Canvas.LineTo(W, Y);
inc(Y, 10);
end;
Format := [];
if RadioButton1.Checked then
include(Format, rtfLeft)
else if RadioButton2.Checked then
include(Format, rtfCenter)
else
include(Format, rtfRight);
if RadioButton4.Checked then
include(Format, rtfTop)
else if RadioButton5.Checked then
include(Format, rtfVerticalCenter)
else
include(Format, rtfBottom);
if CheckBox2.Checked then
include(Format, rtfWordbreak);
Z := StrToIntDef(ComboBox1.Items[ComboBox1.ItemIndex], 100);
rc := PaintBox1.ClientRect;
InflateRect(rc, -8, -8);
rcc := rc;
DrawRtfText(PaintBox1.Canvas, rcc, FText, Format + [rtfCalcRect], Z);
Label4.Caption := SysUtils.Format('Size: %d x %d px', [rcc.Right - rcc.Left,
rcc.Bottom - rcc.Top]);
DrawRtfText(PaintBox1.Canvas, rc, FText, Format, Z);
end;
end. |