unit ventanatextomejorada;
{$mode objfpc} {$H+}
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;
Label1: TLabel;
Panel1: TPanel;
RichMemo1: TRichMemo;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RichMemo1KeyPress(Sender: TObject; var Key: char);
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;
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 else if atagName='rojo' then
afont.Color:=clRed
else if atagName='azul' then
afont.Color:=clBlue
else if atagName='amarillo' then
afont.Color:=clYellow
else if atagName='verde' then
afont.Color:=clGreen;
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;
richmemo1.Font.Size:=12;
richmemo1.Font.Color:=clBlack;
{$IFDEF WINDOWS} // all windows
if procesar then
Parse(texto.Text, RichMemo1, @TagFormat, @EntReplace)
else
richmemo1.Lines:=texto;
{$ELSE}
richmemo1.Lines:=texto;
{$ENDIF}
label1.Caption:='';
end;
procedure TForm2.RichMemo1KeyPress(Sender: TObject; var Key: char);
begin
if key=#27 then
BitBtn3Click(sender);
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
texto:=TStringList.Create;
texto.Clear;
tamano:=12;
procesar:=false;
end;
procedure TForm2.BitBtn3Click(Sender: TObject);
begin
close;
end;
procedure TForm2.BitBtn1Click(Sender: TObject);
begin
richmemo1.SelectAll;
end;
procedure TForm2.BitBtn2Click(Sender: TObject);
begin
richmemo1.CopyToClipboard;
label1.Caption:='Texto copiado al portapapeles';
end;
initialization
{$I ventanatextomejorada.lrs}
end.