📄 unitpas2htm.pas
字号:
unit UnitPas2htm;
interface
uses Classes,SysUtils,ComCtrls,Dialogs,UnitFormBrowse;
type TPas2Htm=class
private
{ Private declarations }
public
procedure SetFileName(AFileName:string);
procedure AddHtmlHead;
procedure AddHtmlTail(copyright:string);
procedure getchar;
procedure getbc;
procedure concat;
function IsLetter:boolean;
function IsDigit:boolean;
function IsReserve:boolean;
procedure Convert;
procedure BeginString;
procedure EndString;
procedure BeginKeyword;
procedure EndKeyword;
procedure BeginComment;
procedure EndComment;
procedure BeginDigit;
procedure EndDigit;
procedure BeginSymb;
procedure EndSymb;
procedure BeginIndint;
procedure EndIndint;
function NextCh:char;
function CovertSpecialCh(var s:string):boolean;
procedure SetProgressBarMax(AProgressBar:TProgressBar;Max:integer);
procedure SetProgressBarCurPosition(AProgressBar:TProgressBar;CurPosition:integer);
{ Public declarations }
protected
FKeywords: TStrings;
Token:string;
ch:char;
FileName:string;
OutStr:string;
SrcFile:TFileStream;
DesFile:TfileStream;
LastReserve:string;
CurReserve:string;
end;
implementation
var
PascalKeywords:TStrings;
procedure TPas2Htm.SetFileName(AFileName:string);
begin
FileName:=AFileName;
//
end;
procedure TPas2Htm.AddHtmlHead;
begin
outstr:='<html>'+#13#10+
'<head>'+#13#10+
'<meta http-equiv="Content-Language" content="en-us">'+#13#10+
'<meta name="GENERATOR" content="Microsoft FrontPage 5.0">'+#13#10+
'<meta name="ProgId" content="FrontPage.Editor.Document">'+#13#10+
'<meta http-equiv="Content-Type" content="text/html; charset=gb2312">'+#13#10+
'<title>'+ ExtractFileName(Filename)+' </title>'+#13#10+
'<link rel="stylesheet" href="style.css">'+#13#10+
'</head>'+#13#10+
'<BODY BGCOLOR="#FFFFFF">'+#13#10+
'<font color=#0000FF>';
end;
procedure TPas2Htm.AddHtmlTail(copyright: string);
begin
outstr:=outstr+'</font>'+#13#10+#13#10+'<HR><CENTER<I><p>Created by ImageSee 1.0</p> '+#13#10+'<p> 作者：姜亮</p>'+#13#10+
'<p> E-mail:jiangliang@163.com</p>'+
'</CENTER></I>' +#13#10+'</BODY> </HTML>';
end;
procedure Tpas2Htm.getchar;
begin
SrcFile.Read(ch,sizeof(char));
end;
procedure Tpas2Htm.getbc;
begin
while (ch=' ') or (ch=#13) do
begin
if ch=' ' then
outstr:=outstr+' '
else if ch=#13 then
begin
//跳过#10
getchar;
outstr:=outstr+'<br>';
end;
getchar;
end;
end;
procedure Tpas2Htm.concat;
begin
token:=token+ch;
end;
function Tpas2htm.IsLetter:boolean;
begin
if (ch in ['a'..'z','A'..'Z','_']) then
result:=true
else result:=false
end;
function Tpas2htm.IsDigit:boolean;
begin
if ch in['0'..'9']then
result:=true
else result:=false
end;
function Tpas2htm.Isreserve:boolean;
begin
FKeywords:=PascalKeywords;
if FKeywords.IndexOf(token)<0 then
result:=false
else
result:=true;
end;
procedure Tpas2Htm.Convert;
var
SpecialStr:string;
// a3_n:integer;
begin
// a:=$78;
LastReserve:='';
CurReserve:='';
try
SrcFile:=TFileStream.Create(filename,fmOpenRead);
getchar;
token:='';
SetProgressBarMax(FormBrowse.ProgressBar1,srcfile.Size);
while srcfile.Position <srcfile.Size do
begin
getbc;
case ch of
'a'..'z','A'..'Z':
begin //begin case ch of 'a'..'z','A'..'Z':
while Isletter or Isdigit do
begin
concat;
getchar;
end;
if IsReserve then
begin
LastReserve:=CurReserve;
CurReserve:=token;
if (LastReserve='end') and
((CurReserve='procedure') or (CurReserve='function')) then
outstr:=outstr+'<hr>';
BeginKeyWord;
outstr:=outstr+token;
EndKeyWord;
token:='';
end
else
begin
BeginIndint;
outstr:=outstr+token;
EndIndint;
token:='';
end;
end; //end case ch of 'a'..'z','A'..'Z':
'0'..'9':
begin //begin case of '0'..'9':
while Isdigit do
begin
concat;
getchar;
end;
BeginDigit;
outstr:=outstr+token;
EndDigit;
token:='';
end; //end case of '0'..'9':
'=', '+', '-', '_', '*', '>',
'<', ':', ';', ')', '@',
'.', ',', '[', ']', '^':
begin
BeginSymb;
outstr:=outstr+ch;
EndSymb;
getchar;
token:='';
end;
'$':
begin
BeginDigit;
while ch in ['$','0'..'9','a'..'d','A'..'D'] do
begin
outstr:=outstr+ch;
getchar;
end;
EndDigit;
end;
'#':
begin
BeginString;
while ch in ['#','0'..'9'] do
begin
outstr:=outstr+ch;
getchar;
end;
EndString;
end;
'{':
begin //begin case of '{':
BeginComment;
outstr:=outstr+ch;
getchar;
while ch<>'}' do
begin
if ch=#13 then
begin
outstr:=outstr+'<br>';
getchar;
end
else
begin
if CovertSpecialCh(SpecialStr) then
outstr:=outstr+SpecialStr
else
outstr:=outstr+ch;
getchar;
end;
end;
outstr:=outstr+ch;
EndComment;
getchar;
end; //end case of '{':
'(':
begin
if NextCh='*' then
begin
BeginComment;
repeat
outstr:=outstr+ch;
getchar;
until (ch='*') and (Nextch=')');
outstr:=outstr+ch;
getchar;
outstr:=outstr+ch;
EndComment;
getchar;
end
else
begin
BeginSymb;
outstr:=outstr+ch;
EndSymb;
getchar;
token:='';
end;
end;
'/':
begin
if Nextch='/' then
begin
BeginComment;
repeat
if CovertSpecialCh(SpecialStr) then
outstr:=outstr+SpecialStr
else
outstr:=outstr+ch;
getchar;
until (ch=#13);
//跳过#10
getchar;
outstr:=outstr+'<br>';
EndComment;
getchar;
end
else
begin
BeginSymb;
outstr:=outstr+ch;
EndSymb;
getchar;
token:='';
end;
end;
{
#13:
begin
if NextCh=#10 then
begin
outstr:=outstr+'<br>');
getchar;
getchar;
end;
end;
}
// #10:;
#39:
begin //begin #39
BeginString;
outstr:=outstr+ch;
getchar;
while ch<>#39 do
begin
if CovertSpecialCh(SpecialStr) then
outstr:=outstr+SpecialStr
else
outstr:=outstr+ch;
getchar;
end;
outstr:=outstr+ch;
Endstring;
getchar;
end; //end #39
else
begin
//showmessage(inttostr(ord(ch)));
outstr:=outstr+ch;
getchar;
end;
end; //end case
SetProgressBarCurPosition(FormBrowse.ProgressBar1,srcfile.Position);
//form1.ProgressBar1.Refresh;
//showmessage('ProgressBar1.Position='+inttostr(form1.ProgressBar1.Position) );
end; //end srcfile.Position <srcfile.Size
finally
AddHtmlTail('sdaf');
SrcFile.Free;
end;
try
DesFile:=TFileStream.Create(AppPath+'\pashtm.htm',fmopenwrite or fmcreate);
DesFile.WriteBuffer (Pointer(outstr)^, Length (outstr));
finally
desfile.Free;
end;
end;
procedure TPas2Htm.BeginIndint;
begin
Outstr:=Outstr+'<FONT color="#0000FF">';
end;
procedure TPas2Htm.EndIndint;
begin
Outstr:=Outstr+'</FONT>';
end;
procedure TPas2Htm.BeginKeyword;
begin
Outstr:=Outstr+ '<B><FONT COLOR="#000000">';
end;
procedure TPas2Htm.EndKeyword;
begin
Outstr:=Outstr+ '</B></font>';
end;
procedure TPas2Htm.BeginComment;
begin
Outstr:=Outstr+ '<FONT COLOR="#000080"><I>';
end;
procedure TPas2Htm.EndComment;
begin
Outstr:=Outstr+ '</I></FONT>';
end;
procedure TPas2Htm.BeginString;
begin
Outstr:=Outstr+ '<FONT COLOR="#FF00FF">';
end;
procedure TPas2Htm.EndString;
begin
Outstr:=Outstr+'</FONT>';
end;
procedure TPas2Htm.BeginDigit;
begin
Outstr:=Outstr+'<FONT COLOR="#FF0000">';
end;
procedure TPas2Htm.EndDigit;
begin
Outstr:=Outstr+'</FONT>';
end;
procedure TPas2Htm.BeginSymb;
begin
Outstr:=Outstr+'<FONT COLOR="#008080">';
end;
procedure TPas2Htm.EndSymb;
begin
Outstr:=Outstr+'</FONT>';
end;
function TPas2Htm.NextCh: char;
var
chtem:char;
begin
SrcFile.Read(chtem,sizeof(char));
result:=chtem;
srcfile.Position:=srcfile.Position-1;
end;
function TPas2Htm.CovertSpecialCh(var s: string): boolean;
begin
result:=false;
case ch of
'<':
begin
s:='<';
result:=true;
end;
'>':
begin
s:='>';
result:=true;
end;
' ':
begin
s:=' ';
result:=true;
end;
end; //end case
end;
procedure TPas2Htm.SetProgressBarMax(AProgressBar:TProgressBar;Max:integer);
begin
AProgressBar.Max:=Max;
end;
procedure TPas2Htm.SetProgressBarCurPosition(AProgressBar: TProgressBar;
CurPosition: integer);
begin
AProgressBar.Position:=CurPosition;
//
end;
initialization
PascalKeywords := TStringList.Create;
// Pascal Keywords
PascalKeywords.Add ('absolute');
PascalKeywords.Add ('abstract');
PascalKeywords.Add ('and');
PascalKeywords.Add ('array');
PascalKeywords.Add ('as');
PascalKeywords.Add ('asm');
PascalKeywords.Add ('assembler');
PascalKeywords.Add ('at');
PascalKeywords.Add ('automated');
PascalKeywords.Add ('begin');
PascalKeywords.Add ('case');
PascalKeywords.Add ('cdecl');
PascalKeywords.Add ('class');
PascalKeywords.Add ('const');
PascalKeywords.Add ('constructor');
PascalKeywords.Add ('contains');
PascalKeywords.Add ('default');
PascalKeywords.Add ('destructor');
PascalKeywords.Add ('dispid');
PascalKeywords.Add ('dispinterface');
PascalKeywords.Add ('div');
PascalKeywords.Add ('do');
PascalKeywords.Add ('downto');
PascalKeywords.Add ('dynamic');
PascalKeywords.Add ('else');
PascalKeywords.Add ('end');
PascalKeywords.Add ('except');
PascalKeywords.Add ('exports');
PascalKeywords.Add ('external');
PascalKeywords.Add ('file');
PascalKeywords.Add ('finalization');
PascalKeywords.Add ('finally');
PascalKeywords.Add ('for');
PascalKeywords.Add ('forward');
PascalKeywords.Add ('function');
PascalKeywords.Add ('goto');
PascalKeywords.Add ('if');
PascalKeywords.Add ('implementation');
PascalKeywords.Add ('in');
PascalKeywords.Add ('index');
PascalKeywords.Add ('inherited');
PascalKeywords.Add ('initialization');
PascalKeywords.Add ('inline');
PascalKeywords.Add ('interface');
PascalKeywords.Add ('is');
PascalKeywords.Add ('label');
PascalKeywords.Add ('library');
PascalKeywords.Add ('message');
PascalKeywords.Add ('mod');
PascalKeywords.Add ('nil');
PascalKeywords.Add ('nodefault');
PascalKeywords.Add ('not');
PascalKeywords.Add ('object');
PascalKeywords.Add ('of');
PascalKeywords.Add ('on');
PascalKeywords.Add ('or');
PascalKeywords.Add ('override');
PascalKeywords.Add ('packed');
PascalKeywords.Add ('pascal');
PascalKeywords.Add ('private');
PascalKeywords.Add ('procedure');
PascalKeywords.Add ('program');
PascalKeywords.Add ('property');
PascalKeywords.Add ('protected');
PascalKeywords.Add ('public');
PascalKeywords.Add ('published');
PascalKeywords.Add ('raise');
PascalKeywords.Add ('read');
PascalKeywords.Add ('record');
PascalKeywords.Add ('register');
PascalKeywords.Add ('repeat');
PascalKeywords.Add ('requires');
PascalKeywords.Add ('resident');
PascalKeywords.Add ('set');
PascalKeywords.Add ('shl');
PascalKeywords.Add ('shr');
PascalKeywords.Add ('stdcall');
PascalKeywords.Add ('stored');
PascalKeywords.Add ('string');
PascalKeywords.Add ('then');
PascalKeywords.Add ('threadvar');
PascalKeywords.Add ('to');
PascalKeywords.Add ('try');
PascalKeywords.Add ('type');
PascalKeywords.Add ('unit');
PascalKeywords.Add ('until');
PascalKeywords.Add ('uses');
PascalKeywords.Add ('var');
PascalKeywords.Add ('virtual');
PascalKeywords.Add ('while');
PascalKeywords.Add ('with');
PascalKeywords.Add ('write');
PascalKeywords.Add ('xor');
finalization
PascalKeywords.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -