unit ventanatextomejorada;
{$mode objfpc}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, StdCtrls, RichMemo, richmemoml;
type
{ TForm2 }
TForm2 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Panel1: TPanel;
RichMemo1: TRichMemo;
procedure BitBtn3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
texto : tstringlist;
procesar : boolean;
procedure TagFormat(Sender: TObject; var atagName: string; tagattr: TStrings; var afont: TFontParams; var txt: string; var tagCloses: Boolean );
procedure EntReplace(Sender: TObject; var txt: string; tagsStack: TStrings);
{ public declarations }
end;
var
ventex: TForm2;
tamano : integer;
colorf : string;
memon : TMemo;
implementation
{ TForm2 }
procedure TForm2.TagFormat(Sender: TObject; var atagName: string; tagattr: TStrings; var afont: TFontParams; var txt: string; var tagCloses: Boolean);
begin
if atagName='b' then
Include(afont.Style, fsBold)
else if atagName='i' then
Include(afont.Style, fsItalic)
else if atagName='s' then
Include(afont.Style, fsStrikeOut)
else if atagName='u' then
Include(afont.Style, fsUnderline)
else if atagName='h1' then begin
Include(afont.Style, fsBold);
afont.Size:=afont.Size*2;
end else if atagName='h2' then begin
Include(afont.Style, fsBold);
afont.Size:=round(afont.Size*1.5)
end else if atagName='pre' then begin
afont.Name:='Courier New'
end;
end;
procedure TForm2.EntReplace(Sender: TObject; var txt: string;tagsStack: TStrings);
begin
txt:=StringReplace(txt, '<', '<', [rfReplaceAll, rfIgnoreCase]);
txt:=StringReplace(txt, '>', '>', [rfReplaceAll, rfIgnoreCase]);
txt:=StringReplace(txt, '"', '"', [rfReplaceAll, rfIgnoreCase]);
end;
procedure TForm2.FormShow(Sender: TObject);
begin
RichMemo1.Clear;
if procesar then begin
memon.Lines:=texto;
Parse(memon.Text, RichMemo1, @TagFormat, @EntReplace);
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
texto:=TStringList.Create;
texto.Clear;
tamano:=10;
colorf:='clblack';
procesar:=false;
memon:=TMemo.Create;
end;
procedure TForm2.BitBtn3Click(Sender: TObject);
begin
close;
end;
initialization
{$I ventanatextomejorada.lrs}
end.