unit Unit1;
interface
uses
SysUtils, Forms, Classes, StdCtrls,
ExtCtrls, ComCtrls, Controls, Dialogs;
type
TFormular = class(TForm)
DolniPanel: TPanel;
MemoPAS: TMemo;
MemoHTML: TMemo;
OpenDialogPAS: TOpenDialog;
SaveDialogPAS: TSaveDialog;
SaveDialogHTML: TSaveDialog;
ProgressBarHTML: TProgressBar;
ButtonLoadPAS: TButton;
ButtonSavePAS: TButton;
ButtonSaveHTML: TButton;
ButtonPreved: TButton;
CheckBoxPreformatovani: TCheckBox;
ButtonVymazPAS: TButton;
CheckBoxBarvy: TCheckBox;
CheckBoxZpet: TCheckBox;
ButtonHelp: TButton;
Splitter1: TSplitter;
procedure ButtonLoadPASClick(Sender: TObject);
procedure ButtonSavePASClick(Sender: TObject);
procedure ButtonSaveHTMLClick(Sender: TObject);
procedure ButtonPrevedClick(Sender: TObject);
procedure ButtonVymazPASClick(Sender: TObject);
procedure ButtonHelpClick(Sender: TObject);
function KlicoveSlovoJe(var s: string): boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Formular: TFormular;
implementation
{$R *.DFM}
procedure TFormular.ButtonLoadPASClick(Sender: TObject);
begin
if OpenDialogPAS.Execute then
try
with MemoPAS do begin
Lines.Clear;
Lines.LoadFromFile(OpenDialogPAS.FileName);
Enabled:=true;
end;
except on EInOutError do MessageDlg('Soubor se neotevřel, došlo k chybě', mtError, [mbOk], 0);
end;
end;
procedure TFormular.ButtonSavePASClick(Sender: TObject);
begin
try
if SaveDialogPAS.Execute then MemoPAS.Lines.SaveToFile(SaveDialogPAS.Filename);
except on EInOutError do MessageDlg('Soubor se neuložil, došlo k chybě', mtError, [mbOk], 0);
end;
end;
procedure TFormular.ButtonSaveHTMLClick(Sender: TObject);
begin
try
if SaveDialogHTML.Execute then MemoHTML.Lines.SaveToFile(SaveDialogHTML.Filename);
except on EInOutError do MessageDlg('Soubor se neuložil, došlo k chybě', mtError, [mbOk], 0);
end;
end;
function TFormular.KlicoveSlovoJe(var s: string): boolean;
begin
s:=uppercase(s);
KlicoveSlovoJe:=false;
if s='AND' then KlicoveSlovoJe:=true;
if s='ARRAY' then KlicoveSlovoJe:=true;
if s='AS' then KlicoveSlovoJe:=true;
if s='ASM' then KlicoveSlovoJe:=true;
if s='BEGIN' then KlicoveSlovoJe:=true;
if s='CASE' then KlicoveSlovoJe:=true;
if s='CLASS' then KlicoveSlovoJe:=true;
if s='CONST' then KlicoveSlovoJe:=true;
if s='CONSTRUCTOR' then KlicoveSlovoJe:=true;
if s='DESTRUCTOR' then KlicoveSlovoJe:=true;
if s='DISPINTERFACE' then KlicoveSlovoJe:=true;
if s='DIV' then KlicoveSlovoJe:=true;
if s='DO' then KlicoveSlovoJe:=true;
if s='DOWNTO' then KlicoveSlovoJe:=true;
if s='ELSE' then KlicoveSlovoJe:=true;
if s='END' then KlicoveSlovoJe:=true;
if s='EXCEPT' then KlicoveSlovoJe:=true;
if s='EXPORTS' then KlicoveSlovoJe:=true;
if s='FILE' then KlicoveSlovoJe:=true;
if s='FINALIZATION' then KlicoveSlovoJe:=true;
if s='FINALLY' then KlicoveSlovoJe:=true;
if s='FOR' then KlicoveSlovoJe:=true;
if s='FUNCTION' then KlicoveSlovoJe:=true;
if s='GOTO' then KlicoveSlovoJe:=true;
if s='IF' then KlicoveSlovoJe:=true;
if s='IMPLEMENTATION' then KlicoveSlovoJe:=true;
if s='IN' then KlicoveSlovoJe:=true;
if s='INHERITED' then KlicoveSlovoJe:=true;
if s='INITIALIZATION' then KlicoveSlovoJe:=true;
if s='INLINE' then KlicoveSlovoJe:=true;
if s='INTERFACE' then KlicoveSlovoJe:=true;
if s='IS' then KlicoveSlovoJe:=true;
if s='LABEL' then KlicoveSlovoJe:=true;
if s='LIBRARY' then KlicoveSlovoJe:=true;
if s='MOD' then KlicoveSlovoJe:=true;
if s='NIL' then KlicoveSlovoJe:=true;
if s='NOT' then KlicoveSlovoJe:=true;
if s='OBJECT' then KlicoveSlovoJe:=true;
if s='OF' then KlicoveSlovoJe:=true;
if s='OR' then KlicoveSlovoJe:=true;
if s='OUT' then KlicoveSlovoJe:=true;
if s='PACKED' then KlicoveSlovoJe:=true;
if s='PROCEDURE' then KlicoveSlovoJe:=true;
if s='PROGRAM' then KlicoveSlovoJe:=true;
if s='PROPERTY' then KlicoveSlovoJe:=true;
if s='RAISE' then KlicoveSlovoJe:=true;
if s='RECORD' then KlicoveSlovoJe:=true;
if s='REPEAT' then KlicoveSlovoJe:=true;
if s='RESOURCESTRING' then KlicoveSlovoJe:=true;
if s='SET' then KlicoveSlovoJe:=true;
if s='SHL' then KlicoveSlovoJe:=true;
if s='SHR' then KlicoveSlovoJe:=true;
if s='STRING' then KlicoveSlovoJe:=true;
if s='THEN' then KlicoveSlovoJe:=true;
if s='THREADVAR' then KlicoveSlovoJe:=true;
if s='TO' then KlicoveSlovoJe:=true;
if s='TRY' then KlicoveSlovoJe:=true;
if s='TYPE' then KlicoveSlovoJe:=true;
if s='UNIT' then KlicoveSlovoJe:=true;
if s='UNTIL' then KlicoveSlovoJe:=true;
if s='USES' then KlicoveSlovoJe:=true;
if s='VAR' then KlicoveSlovoJe:=true;
if s='WHILE' then KlicoveSlovoJe:=true;
if s='WITH' then KlicoveSlovoJe:=true;
if s='XOR' then KlicoveSlovoJe:=true;
if s='BSOLUTE' then KlicoveSlovoJe:=true;
if s='ABSTRACT' then KlicoveSlovoJe:=true;
if s='ASSEMBLER' then KlicoveSlovoJe:=true;
if s='AUTOMATED' then KlicoveSlovoJe:=true;
if s='CDECL' then KlicoveSlovoJe:=true;
if s='CONTAINS' then KlicoveSlovoJe:=true;
if s='DEFAULT' then KlicoveSlovoJe:=true;
if s='DISPID' then KlicoveSlovoJe:=true;
if s='DYNAMIC' then KlicoveSlovoJe:=true;
if s='EXPORT' then KlicoveSlovoJe:=true;
if s='EXTERNAL' then KlicoveSlovoJe:=true;
if s='FAR' then KlicoveSlovoJe:=true;
if s='FORWARD' then KlicoveSlovoJe:=true;
if s='IMPLEMENTS' then KlicoveSlovoJe:=true;
if s='INDEX' then KlicoveSlovoJe:=true;
if s='MESSAGE' then KlicoveSlovoJe:=true;
if s='NAME' then KlicoveSlovoJe:=true;
if s='NEAR' then KlicoveSlovoJe:=true;
if s='NODEFAULT' then KlicoveSlovoJe:=true;
if s='OVERLOAD' then KlicoveSlovoJe:=true;
if s='OVERRIDE' then KlicoveSlovoJe:=true;
if s='PACKAGE' then KlicoveSlovoJe:=true;
if s='PASCAL' then KlicoveSlovoJe:=true;
if s='PRIVATE' then KlicoveSlovoJe:=true;
if s='PROTECTED' then KlicoveSlovoJe:=true;
if s='PUBLIC' then KlicoveSlovoJe:=true;
if s='PUBLISHED' then KlicoveSlovoJe:=true;
if s='READ' then KlicoveSlovoJe:=true;
if s='READONLY' then KlicoveSlovoJe:=true;
if s='REGISTER' then KlicoveSlovoJe:=true;
if s='REINTRODUCE' then KlicoveSlovoJe:=true;
if s='REQUIRES' then KlicoveSlovoJe:=true;
if s='RESIDENT' then KlicoveSlovoJe:=true;
if s='SAFECALL' then KlicoveSlovoJe:=true;
if s='STDCALL' then KlicoveSlovoJe:=true;
if s='STORED' then KlicoveSlovoJe:=true;
if s='VIRTUAL' then KlicoveSlovoJe:=true;
if s='WRITE' then KlicoveSlovoJe:=true;
if s='WRITEONLY' then KlicoveSlovoJe:=true;
if s='AT' then KlicoveSlovoJe:=true;
if s='ON' then KlicoveSlovoJe:=true;
end;
procedure TFormular.ButtonPrevedClick(Sender: TObject);
var pas, html, slovo, uslovo, pridatS: string;
radek, pismeno, pocetEnd, mpocetEnd, k: integer;
p, Up: char;
JeSlovo, nepridavat, JeKomentar1, JeKomentar2, JeKomentar3, JeRetezec, JeASM: boolean;
//JeKomentar1 '{comments}'
//JeKomentar2 '(*comments*)'
//JeKomentar3 '//comments'
barvaK, barvaK_: string; //komentář
barvaR, barvaR_: string; //řetězec
barvaP, barvaP_: string; //pozadí
barvaS, barvaS_: string; //klíčové slovo
barvaA, barvaA_: string; //assambler
begin
if CheckBoxBarvy.Checked=false
then
begin
barvaK:='<FONT color="blue"><I>'; //delphi
BarvaK_:='</I></FONT>';
barvaR:='<FONT color="red">';
BarvaR_:='</FONT>';
barvaP:='<BODY text="black" bgcolor="white"><FONT face="Courier">';
barvaP_:='</FONT></BODY>';
barvaS:='<B>';
barvaS_:='</B>';
barvaA:='<FONT color="green">';
barvaA_:='</FONT>';
end
else
begin
barvaK:='<FONT color="CCCCCC"><I>'; //standardní pascal
BarvaK_:='</I></FONT>';
barvaR:='<FONT color="white">';
BarvaR_:='</FONT>';
barvaP:='<BODY text="yellow" bgcolor="#5555FF"><FONT face="Courier">';
barvaP_:='</FONT></BODY>';
barvaS:='<FONT color="white"><B>';
barvaS_:='</B></FONT>';
barvaA:='<FONT color="55FF55">';
barvaA_:='</FONT>';
end;
ProgressBarHTML.Max:=MemoPAS.Lines.Count;
ProgressBarHTML.Width:=MemoHTML.Width;
ProgressBarHTML.Left:=MemoHTML.Left;
ProgressBarHTML.Top:=MemoHTML.Height-ProgressBarHTML.Height;
ProgressBarHTML.Position:=0;
MemoHTML.Visible:=false;
ProgressBarHTML.Visible:=true;
JeKomentar1:=false; JeKomentar2:=false; JeRetezec:=false; JeSlovo:=false; JeASM:=false;
pocetEnd:=0; mpocetEnd:=0;
with MemoHTML do begin
Lines.Clear;
Lines.add('<HTML>'); //hlavicka HTML souboru
Lines.add('<HEAD>');
Lines.add('<META content="text/html; charset=windows-1250" http-equiv=Content-Type>'); //nastavení kódování
Lines.Add('<TITLE>Výpis souboru typu PAS</TITLE>');
Lines.add('</HEAD>');
Lines.Add(barvaP);
if CheckBoxPreformatovani.Checked then Lines.add('<CODE>')
else Lines.add('<PRE>');
end;
//řádek po řádku
for radek:=0 to MemoPAS.Lines.Capacity-1 do
begin
pas:=MemoPAS.Lines[radek];
ProgressBarHTML.Step:=5; //krokování progressBaru, pokud je smooth=true
//může se program značně zpomalit svoji činnost
//při nastavení smooth=false je překreslování rychlé
//a tudíž i činnost programu je rychlá
if radek mod 5 = 0 then ProgressBarHTML.StepIt;
if CheckBoxPreformatovani.Checked then
begin
html:=pas;
for k:=1 to length(pas) do
begin
if (pos(' ',html)=1) then delete(html,1,1) else break;
end;
pas:=html;
end;
if (Pos('<',pas)>0) or (Pos('>',pas)>0) or (Pos('&',pas)>0) then
begin //převede speciální znaky do formátu HTML pokud řádek tyto znaky obsahuje
html:=pas; pas:='';
for pismeno:=1 to length(html) do
Case html[pismeno] of
'<': pas:=pas + '<';
'>': pas:=pas + '>';
'&': pas:=pas + '&';
else pas:=pas + html[pismeno];
end;
end;
html:=''; JeKomentar3:=false;
//práce s jedním řádkem
for pismeno:=1 to length(pas) do
begin
p:=pas[pismeno]; Up:=upcase(p); nepridavat:=false;
//zpracování klíčových slov
if (((up>='A') and (up<='Z')) or ((up>='0') and (up<='9')))
and not (JeRetezec or JeKomentar1 or JeKomentar2 or JeKomentar3) then
begin
slovo:=slovo+p;
nepridavat:=true;
end;
if not (((up>='A') and (up<='Z')) or ((up>='0') and (up<='9')))
or (length(pas)=pismeno) then
begin
USlovo:=uppercase(slovo);
(* for k:=0 to MemoKS.Lines.Capacity-1 do
if uslovo = MemoKS.Lines[k] then
begin
JeSlovo:=true;
if (uslovo='BEGIN') or (uslovo='ASM') or (uslovo='CASE')
or (uslovo='RECORD') or (uslovo='OBJECT')
{or (uslovo='UNIT') }or (uslovo='TRY')
or (uslovo='TYPE') then inc(pocetEnd);
if uslovo='END' then dec(pocetEnd);
break;
end
else JeSlovo:=false; *)
if KlicoveSlovoJe(USlovo)=true then
begin
JeSlovo:=true;
if (uslovo='BEGIN') or (uslovo='ASM') or (uslovo='CASE')
or (uslovo='RECORD') or (uslovo='OBJECT')
{or (uslovo='UNIT') }or (uslovo='TRY')
or (uslovo='TYPE') then inc(pocetEnd);
if uslovo='END' then dec(pocetEnd);
//break;
end
else JeSlovo:=false;
if JeSlovo and (uslovo='END') and jeASM then html:=html + barvaA_;
if JeSlovo then html:=html + barvaS + slovo + barvaS_
else html:=html + slovo;
if JeSlovo and (uslovo='ASM') then begin html:=html + barvaA; jeASM:=true; end;
slovo:='';
end;
//zpracování klíčových slov - konec
//zpracování komentářů a řetězců
if ((p='/') and (pas[pismeno+1]='/') and not (JeKomentar1 or JeRetezec or JeKomentar2))
or JeKomentar3 then
begin
if JeKomentar3 then html:=html + p
else begin
JeKomentar3:=true;
pridatS:=barvaK;
html:=html + pridatS + p;
end;
nepridavat:=true;
end;
if (p='}') and not (JeRetezec or JeKomentar3 or JeKomentar2) then
begin
JeKomentar1:=false;
pridatS:=barvaK_;
html:=html + p + pridatS;
nepridavat:=true;
end;
if (p='{') and not (JeRetezec or JeKomentar3 or JeKomentar2) then
begin
JeKomentar1:=true;
pridatS:=barvaK;
html:=html + pridatS + P;
nepridavat:=true;
end;
if ((pas[pismeno-1]='*') and (p=')')) and not (JeRetezec or JeKomentar3 or JeKomentar1) then
begin
JeKomentar2:=false;
pridatS:=barvaK_;
html:=html + p + pridatS;
nepridavat:=true;
end;
if ((p='(') and (pas[pismeno+1]='*')) and not (JeRetezec or JeKomentar3 or JeKomentar1) then
begin
JeKomentar2:=true;
pridatS:=barvaK;
html:=html + pridatS + P;
nepridavat:=true;
end;
if (p='''') and not (JeKomentar1 or JeKomentar2 or JeKomentar3) then
begin
if JeRetezec then begin
JeRetezec:=false;
pridatS:=barvaR_;
html:=html + p + pridatS;
nepridavat:=true;
end
else begin
JeRetezec:=true;
pridatS:=barvaR;
html:=html + pridatS + p;
nepridavat:=true;
end;
end;
if not nepridavat then html:=html+p;
end;
//konec práce s řádkem
if JeKomentar3 then html:=html + barvaK_;
if CheckBoxPreformatovani.Checked and (pocetEnd>0)
then begin
if mpocetEnd<=pocetEnd then for k:=1 to 2*pocetEnd do html:=' '+html
else for k:=1 to 2*mpocetEnd do html:=' '+html;
end;
mpocetEnd:=pocetEnd;
html:=html + '<BR>';
if CheckBoxPreformatovani.Checked then html:=html + '<BR>';
MemoHTML.Lines.Add(html);
end;
//konec práce s řádky
ProgressBarHTML.Position:=MemoPAS.Lines.Capacity-1;
with MemoHTML do begin
Lines.Add(' <BR>');
if CheckBoxPreformatovani.Checked then Lines.add('</CODE>')
else Lines.add('</PRE>');
if CheckBoxZpet.Checked then Lines.Add('<P align=right><B><I><A HREF="JavaScript:history.back()"><FONT SIZE=+2 color="red">Zpět</FONT></A></I></B>');
Lines.add(barvaP_);
Lines.Add('</HTML>');
end;
ProgressBarHTML.Visible:=false;
MemoHTML.Visible:=true;
end;
procedure TFormular.ButtonVymazPASClick(Sender: TObject);
begin
MemoPAS.Lines.Clear;
end;
procedure TFormular.ButtonHelpClick(Sender: TObject);
begin
application.helpcontext(1);
end;
end.
Zpět