RtfLabel, Version 1.3c (alt)

Hinweis: dies ist nicht die neueste Version!

Zurück zur Übersicht

Datei: Sample/drtsamp.pas

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 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}

  {$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 := 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.
Flocke's Garage
Valid HTML 4.01 Transitional Valid CSS!
(C) 2005-2013 Volker Siebert.
Creative Commons-LizenzvertragDer gesamte Inhalt dieser Webseite steht unter einer Creative Commons-Lizenz (sofern nicht anders angegeben).