RtfLabel, Version 1.3a (alt)
Hinweis: dies ist nicht die neueste Version!
Datei: Sample/drtsamp.pas
unit drtsamp; interface {$I Rich3Conf.inc} uses Windows, Messages, SysUtils, Variants, 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 FormShow(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } FText: string; end; var FormDrawRtfText: TFormDrawRtfText; implementation {$R *.dfm} uses {$IFDEF RICHEDIT_DEBUG} Debugging, DebugOutputForm, {$ENDIF} 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 := 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 := 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 RICHEDIT_DEBUG} RichEditDebugOutputProc := DebugOutputLine; {$ENDIF} Constraints.MinWidth := Panel1.Width + 220 + (Width - ClientWidth); Constraints.MinHeight := (Label4.Top + Label4.Height + 8) + Height - ClientHeight; Icon.Assign(Application.Icon); FText := CDefaultText; try Memo1.Lines.Text := 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.FormShow(Sender: TObject); begin {$IFDEF RICHEDIT_DEBUG} DebugOutputLine('TFormRtfLabelExample.FormShow'); frmDebugOutputForm.Visible := True; {$ENDIF} 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. |