unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, inifiles, XPMan, ExtCtrls, StdCtrls, Menus, Buttons, Tabs, ShellApi;
type
TForm1 = class(TForm)
XPManifest1: TXPManifest;
Panel1: TPanel;
OpenDialog1: TOpenDialog;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
Panel2: TPanel;
Notebook1: TNotebook;
Memo1: TMemo;
Splitter1: TSplitter;
Memo2: TMemo;
TabSet1: TTabSet;
PopupMenu1: TPopupMenu;
ViewHtmlResult1: TMenuItem;
About1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Open1: TMenuItem;
N2: TMenuItem;
Option1: TMenuItem;
PureOutput1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure ViewHtmlResult1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure PureOutput1Click(Sender: TObject);
private
{ Private declarations }
function _TranPas(Str: String):String;
function _TagEncode(ATagStr: String): String;
function _GetFuncName(AStr: String): String;
procedure _ReadRecivedData;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses James2003;
var MyIni: TIniFile;
MyPath: String;
TranDataList: TStringList;
TranType: String;
flag_marked: boolean;
flag_marked_type: String;
implement_flag: boolean; //2003/12/17
{$R *.dfm}
//---------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
//Form1.BorderStyle:=bsNone; //bsNone , bsSizeable
//Form1.FormStyle:=fsNormal; //fsNormal , fsStayOnTop
//Form1.Position:=poScreenCenter;
//Form1.WindowState:=wsMaximized; //wsMaximized , wsNormal , wsMinimized
MyIni := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
MyPath := ExtractFilePath(Application.ExeName);
TranDataList := TStringList.Create;
TranDataList.Clear;
_ReadRecivedData;
TabSet1.TabIndex:=0;
Notebook1.PageIndex:=TabSet1.TabIndex;
end;
//---------------------------------------------------------------------------
procedure TForm1.FormActivate(Sender: TObject);
begin
PureOutput1.Checked:=MyIni.ReadBool('Parameter','PureOutPut',false);
end;
//---------------------------------------------------------------------------
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//
end;
//---------------------------------------------------------------------------
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//MyIni.WriteInteger('Parameter', 'Tag', Form1.Tag);
TranDataList.Free;
MyIni.WriteBool('Parameter','PureOutPut',PureOutput1.Checked);
MyIni.Free;
end;
//---------------------------------------------------------------------------
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//
end;
//---------------------------------------------------------------------------
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
if (UpperCase(_Right(OpenDialog1.FileName,3))='PAS') then TranType:='pas';
//for express
Panel1.Caption:='Process...';
Refresh;
SpeedButton2Click(self);
Panel1.Caption:='';
end;
end;
//---------------------------------------------------------------------------
procedure TForm1.SpeedButton2Click(Sender: TObject);
var i:integer;
www: string;
pre_str:String;
flo_str:String;
lnk_str:String;
begin
flag_marked:=false;
implement_flag:=false; //2003/12/17
Memo2.Lines.Clear();
Memo2.Lines.Add('<html>');
Memo2.Lines.Add('<head>');
Memo2.Lines.Add('<meta http-equiv="Content-Type" content="text/html; charset=big5">');
Memo2.Lines.Add('<title>'+ChangeFileExt(ExtractFileName(OpenDialog1.FileName),'.html')+'</title>');
Memo2.Lines.Add('</head>');
Memo2.Lines.Add('<!-- Generated by bruce0211@yahoo.com.tw HTML exporter -->');
Memo2.Lines.Add('<body text="#000000" bgcolor="#FFFFFF" link="#FF00FF" vlink="#FF00FF" alink="#FF00FF">'); //#0000FF(藍色), #FF00FF(桃紅), #008000(綠色) //2003/12/17
Memo2.Lines.Add('<pre><code>');
Memo2.Lines.Add('<font size=2 face="Courier New"><font color="#000000">');
for i:=0 to Memo1.Lines.Count-1 do
begin
if (TranType='pas') then
begin
//2003/12/17
if (_Left(Memo1.Lines.Strings[i],14)='implementation') then
implement_flag:=true;
if (PureOutput1.Checked=false) and (implement_flag) and (flag_marked_type<>'{') and ((_Left(Memo1.Lines.Strings[i],8)='function') or (_Left(Memo1.Lines.Strings[i],9)='procedure') or (_Left(Memo1.Lines.Strings[i],11)='constructor') or (_Left(Memo1.Lines.Strings[i],10)='destructor') ) then
pre_str:='<p><a name="'+_GetFuncName(Memo1.Lines.Strings[i])+'">Content</a> , (<a href="#0">Go Header</a>)<br></p>'+
'<table border="1" width="100%" bgcolor="#F7F7FF"><tr><td><pre><font face="Courier New">' //#F7F7FF(淡藍), #E1F5FF(藍), #EFEFEF(灰), #FFFFD7(黃), #E8FFE8(綠)
else
pre_str:='';
if (PureOutput1.Checked=false) and (implement_flag) and (flag_marked_type<>'{') and (_Left(Memo1.Lines.Strings[i],4)='end;') then
flo_str:='</font></pre></td></tr></table><p> </p>'
else
flo_str:='';
if (PureOutput1.Checked=false) and (_Left(Memo1.Lines.Strings[i],9)='interface') then
begin
pre_str:='<a name="#0">';
flo_str:='</a">';
end;
if (PureOutput1.Checked=false) and (implement_flag=false) and (flag_marked_type<>'{') and (_GetFuncName(Memo1.Lines.Strings[i])<>'') then
lnk_str:=' (<a href="#'+_GetFuncName(Memo1.Lines.Strings[i])+'">Content</a>)'
else
lnk_str:='';
Memo2.Lines.Add(pre_str+_TranPas(Memo1.Lines.Strings[i])+flo_str+lnk_str);
end;
end;
Memo2.Lines.Add('</font>');
Memo2.Lines.Add('</code></pre>');
Memo2.Lines.Add('</body>');
Memo2.Lines.Add('</html>');
if (Trim(OpenDialog1.FileName)<>'') then
begin
Memo2.Lines.SaveToFile(ChangeFileExt(OpenDialog1.FileName,'.htm'));
//ShowMessage(ChangeFileExt(OpenDialog1.FileName,'.htm')+' 轉檔完成!!');
//for express
www:=ChangeFileExt(OpenDialog1.FileName,'.htm');
shellexecute(0,nil,pchar(www),nil,nil,sw_showdefault);
end
else
begin
Memo2.Lines.SaveToFile('c:\dump.htm');
ShowMessage('c:\dump.htm 轉檔完成!!');
end;
end;
//---------------------------------------------------------------------------
procedure TForm1.SpeedButton3Click(Sender: TObject);
var i:integer;
begin
flag_marked:=false;
Memo2.Lines.Clear();
Memo2.Lines.Add('<html>');
Memo2.Lines.Add('<head>');
Memo2.Lines.Add('<title>'+ChangeFileExt(ExtractFileName(OpenDialog1.FileName),'.html')+'</title>');
Memo2.Lines.Add('</head>');
Memo2.Lines.Add('<!-- Generated by bruce0211@yahoo.com.tw HTML exporter -->');
Memo2.Lines.Add('<body text="#000000" bgcolor="#FFFFFF" link="#FF00FF" vlink="#FF00FF" alink="#FF00FF">'); //#0000FF(藍色) //2003/12/17
Memo2.Lines.Add('<pre><code>');
Memo2.Lines.Add('<font size=2 face="Courier New"><font color="#000000">');
for i:=0 to Memo1.Lines.Count-1 do
begin
Memo2.Lines.Add(_TranPas(Memo1.Lines.Strings[i]));
end;
Memo2.Lines.Add('</font>');
Memo2.Lines.Add('</code></pre>');
Memo2.Lines.Add('</body>');
Memo2.Lines.Add('</html>');
Memo2.Lines.SaveToFile('c:\dump.htm');
ShowMessage('c:\dump.htm 轉檔完成!!');
end;
//---------------------------------------------------------------------------
function TForm1._TranPas(Str: String):String;
var r,tmp,tran_str,test,comp_str,Seg: String;
i,p,index1,index2: integer;
c,s:integer; //for bug_fix
begin
s:=1; //for bug_fix
if (flag_marked_type='//') or (flag_marked_type='''') then
begin
flag_marked:=false;
flag_marked_type:='';
end;
if (Trim(Str)='') then
begin
result:='';
exit;
end;
r:=_LeftSpace(Str); //保留字串左邊所有的空白
tmp:=Trim(Str);
Seg:='';
while tmp<>'' do
begin
if (flag_marked) then //進入被 marked 的區塊 , 都不用轉碼
begin
if (flag_marked_type='//') then //後面通通不用轉
begin
r:=r+_TagEncode(tmp)+'</i></font>';
tmp:='';
continue;
end;
if (flag_marked_type='{') then
begin
p:=Pos('}',tmp);
if (p=0) then
begin
r:=r+_TagEncode(tmp);
tmp:='';
continue;
end
else
begin
r:=r+_TagEncode(_Left(tmp,p-1))+'}</i></font>'; //較特殊 !!
tmp:=_CutLeft(tmp,p+1);
flag_marked:=false;
flag_marked_type:=''; //2003/12/17
continue;
end;
end;
if (flag_marked_type='''') then
begin
p:=Pos('''',tmp);
if (p=0) then
begin
r:=r+_TagEncode(tmp);
tmp:='';
continue;
end
else
begin
r:=r+_TagEncode(_Left(tmp,p-1))+'''</font>'; //較特殊 !!
tmp:=_CutLeft(tmp,p);
flag_marked:=false;
flag_marked_type:=''; //2003/12/17
continue;
end;
end;
end;
{
//片語比對
comp_str="TObject *Sender";
if (_Left(tmp,comp_str.Length())=comp_str) then
begin
Result=Result+"Sender: TObject";
tmp=_CutLeft(tmp,comp_str.Length());
continue;
end;
comp_str="void __fastcall";
if (_Left(tmp,comp_str.Length())==comp_str)
begin
Result=Result+"procedure";
tmp=_CutLeft(tmp,comp_str.Length());
continue;
end;
comp_str="int __fastcall";
if (_Left(tmp,comp_str.Length())==comp_str)
begin
Result=Result+"function(:int)";
tmp=_CutLeft(tmp,comp_str.Length());
continue;
end;
comp_str="String __fastcall";
if (_Left(tmp,comp_str.Length())==comp_str)
begin
Result=Result+"function(:String)";
tmp=_CutLeft(tmp,comp_str.Length());
continue;
end;
}
//預先比對
if (_Left(tmp,2)='//') then
begin
r:=r+'<font color="#0000FF"><i>//'; //#0000FF(藍), #000080(深藍), #008000(綠) 2003/12/17
tmp:=_CutLeft(tmp,2);
if tmp='' then r:=r+'</i></font>'; //2003/12/09
flag_marked:=true; //進入被 marked 的區塊
flag_marked_type:='//';
continue;
end;
if (_Left(tmp,1)='{') then
begin
r:=r+'<font color="#0000FF"><i>{'; //#0000FF(藍), #000080(深藍), #008000(綠) 2003/12/17
tmp:=_CutLeft(tmp,1);
flag_marked:=true; //進入被 marked 的區塊
flag_marked_type:='{';
continue;
end;
if (_Left(tmp,1)='''') then
begin
r:=r+'<font color="#FF0000">''';
tmp:=_CutLeft(tmp,1);
flag_marked:=true; //進入被 marked 的區塊
flag_marked_type:='''';
continue;
end;
if (_Left(tmp,1)=' ') then
begin
r:=r+' ';
s:=1; //for bug_fix
tmp:=_CutLeft(tmp,1);
continue;
end;
{在 <pre> tag 中就不需要轉換了,所以 Mark
if (_Left(tmp,1)='<') then
begin
r:=r+'<';
tmp:=_CutLeft(tmp,1);
continue;
end;
if (_Left(tmp,1)='>') then
begin
r:=r+'>';
tmp:=_CutLeft(tmp,1);
continue;
end;
}
//擷取適合的字串區段
index1:=1;
c:=0; //for bug_fix
for i:=1 to Length(tmp) do
begin
index2:=i;
//因為經過 預先比對 過濾過 , 此處找到的應該不會是在第一個位置
//if (tmp[i]='''') or (tmp[i]=' ') or (tmp[i]=':') or (tmp[i]='/') or (tmp[i]='{') or (tmp[i]='(') then
if (tmp[i] in ['''',' ',';',':','/','{','(',',',';','=','+','-','*','<','>','.']) then
begin
c:=1; //for bug_fix
break;
end;
end;
if (index2=Length(tmp)) and (c=0) then index2:=index2+1;//用來騙 字典比對程序 //2003/12/09
//字典比對
{
for i:=index2 downto 1 do
begin
tran_str:=TranDataList.Values[_Left(tmp,i)];
if (tran_str<>'') then
begin
r:=r+tran_str;
tmp:=_CutLeft(tmp,i);
break;
end
end;
}
tran_str:=TranDataList.Values[_Left(tmp,index2-1)];
//if (tran_str<>'') then
if (tran_str<>'') and (s=1) then
begin
r:=r+tran_str;
tmp:=_CutLeft(tmp,index2-1);
continue;
end;
s:=0; //for bug_fix
//剩下沒人要的,只有一個一個原封不動的轉了
r:=r+_Left(tmp,1);
//空白已在前面被攔掉,所以此處多餘,故 Mark
if (tmp[1] in [' ',';',',']) then
begin
s:=1;
end
else
begin
s:=0;
end;
tmp:=_CutLeft(tmp,1);
end;
result:=r;
end;
//---------------------------------------------------------------------------
function TForm1._TagEncode(ATagStr: String): String;
var i:integer;
r:String;
begin
r:='';
for i:=1 to Length(ATagStr) do
begin
if ATagStr[i]='<' then
begin
r:=r+'<';
continue;
end;
if ATagStr[i]='>' then
begin
r:=r+'>';
continue;
end;
r:=r+ATagStr[i];
end;
result:=r;
end;
//---------------------------------------------------------------------------
function TForm1._GetFuncName(AStr: String): String;
var n,i:integer;
tmp,r:String;
begin
r:='';
tmp:=Trim(AStr);
if (Copy(LowerCase(tmp),1,8) <> 'function') and
(Copy(LowerCase(tmp),1,9) <> 'procedure') and
(Copy(LowerCase(tmp),1,11) <> 'constructor') and
(Copy(LowerCase(tmp),1,10) <> 'destructor') then
begin
result:=r;
exit;
end;
if (Copy(LowerCase(tmp),1,8) = 'function') then n:=9;
if (Copy(LowerCase(tmp),1,9) = 'procedure') then n:=10;
if (Copy(LowerCase(tmp),1,11) = 'constructor') then n:=12;
if (Copy(LowerCase(tmp),1,10) = 'destructor') then n:=11;
for i:=n to Length(tmp) do
begin
if (tmp[i]='(') or (tmp[i]=';') or ((r<>'') and (tmp[i]=' ')) then break;
if (tmp[i]='.') then
begin
r:='';
continue;
end;
r:=r+Trim(tmp[i]);
end;
result:=r;
end;
//---------------------------------------------------------------------------
procedure TForm1._ReadRecivedData;
begin
TranDataList.Clear();
TranDataList.Add('and=<b>and</b>');
TranDataList.Add('as=<b>as</b>');
TranDataList.Add('begin=<b>begin</b>');
TranDataList.Add('case=<b>case</b>');
TranDataList.Add('class=<b>class</b>');
TranDataList.Add('constructor=<b>constructor</b>');
TranDataList.Add('destructor=<b>destructor</b>');
TranDataList.Add('do=<b>do</b>');
TranDataList.Add('else=<b>else</b>');
TranDataList.Add('end=<b>end</b>');
TranDataList.Add('except=<b>except</b>');
TranDataList.Add('finally=<b>finally</b>');
TranDataList.Add('for=<b>for</b>');
TranDataList.Add('function=<b>function</b>');
TranDataList.Add('implementation=<b>implementation</b>');
TranDataList.Add('inherited=<b>inherited</b>');
TranDataList.Add('if=<b>if</b>');
TranDataList.Add('in=<b>in</b>');
TranDataList.Add('interface=<b>interface</b>');
TranDataList.Add('mod=<b>mod</b>');
TranDataList.Add('nil=<b>nil</b>');
TranDataList.Add('not=<b>not</b>');
TranDataList.Add('of=<b>of</b>');
TranDataList.Add('or=<b>or</b>');
TranDataList.Add('overload=<b>overload</b>');
TranDataList.Add('override=<b>override</b>');
TranDataList.Add('private=<b>private</b>');
TranDataList.Add('procedure=<b>procedure</b>');
TranDataList.Add('property=<b>property</b>');
TranDataList.Add('protected=<b>protected</b>');
TranDataList.Add('public=<b>public</b>');
TranDataList.Add('published=<b>published</b>');
TranDataList.Add('repeat=<b>repeat</b>');
TranDataList.Add('then=<b>then</b>');
TranDataList.Add('to=<b>to</b>');
TranDataList.Add('try=<b>try</b>');
TranDataList.Add('type=<b>type</b>');
TranDataList.Add('unit=<b>unit</b>');
TranDataList.Add('until=<b>until</b>');
TranDataList.Add('uses=<b>uses</b>');
TranDataList.Add('var=<b>var</b>');
TranDataList.Add('while=<b>while</b>');
//TranDataList.Add('<=<');
//TranDataList.Add('>=>');
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
var www:string;
begin
Memo2.Lines.SaveToFile('c:\dump.htm');
www:='c:\dump.htm';
shellexecute(0,nil,pchar(www),nil,nil,sw_showdefault);
end;
procedure TForm1.ViewHtmlResult1Click(Sender: TObject);
begin
SpeedButton4Click(self);
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
ShellExecute(0,nil,'http://home.kimo.com.tw/bruce0211',nil,nil,sw_showdefault);
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
SpeedButton1Click(self);
end;
procedure TForm1.PureOutput1Click(Sender: TObject);
begin
PureOutput1.Checked:=not PureOutput1.Checked;
end;
end.