📄 exfile.pas
字号:
{∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑
◎→
◎→ Tresss Studio
◎→ Project: UPCHM
◎→ Start Date:2005/12/08
◎→ System: Delphi6+WinXP
◎→ Author: Tresss
◎→ E-Mail: Tresss@sohu.com
◎→ Character: Exprot File And make CHM file;
◎→ Tips:;
◎→
∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑}
unit exfile;
interface
uses main,Comctrls,Sysutils;
Procedure exhhp; //写入hhp文件;
Procedure exhhc; //写入hhc文件;
Procedure Exhhk; //写入hhk文件;
implementation
Procedure exhhp;
Var
Fhhp:TextFile;
Intl:Integer;
Node:TTreeNode;
StrWindow:String;
Begin
AssignFile(Fhhp,FrmMain.CurDir+'Tresss.hhp');
Rewrite(Fhhp);
Try
Writeln(Fhhp,'[OPTIONS]');
Writeln(Fhhp,'Compatibility=1.1 or later');
Writeln(Fhhp,'Binary Index=Yes');
Writeln(Fhhp,'Title='+FrmMain.EdtCsTItle.Text);
Writeln(Fhhp,'Default Window=Main');
Writeln(Fhhp,'Default topic='+FrmMain.CboCSIndex.Text);
Writeln(Fhhp,'Default Font=宋体,9,134');
Writeln(Fhhp,'Language=0x804');
Writeln(Fhhp,'Compiled File='+FrmMain.EdtCSPath.Text);
Writeln(Fhhp,'Index File=Tresss.hhk');
Writeln(Fhhp,'Contents File=Tresss.hhc');
Writeln(Fhhp,'Full-text Search=Yes');
Writeln(Fhhp,'');
Writeln(Fhhp,'[WINDOWS]');
StrWindow:='Main="'+FrmMain.EdtCsTitle.Text+'","Tresss.hhc","Tresss.hhk",';
StrWindow:=StrWindow+'"'+FrmMain.CboCsIndex.Text+'",';
StrWindow:=StrWindow+',,,,,';
If FrmMain.ChbCsNone.Checked Then
StrWindow:=StrWindow+'0,'
Else
StrWindow:=StrWindow+'0x61520,';
StrWindow:=StrWindow+'180,0x104E,';
StrWindow:=StrWindow+'['+FrmMain.EdtCspLeft.Text+','+FrmMain.EdtCsptop.Text+',';
StrWindow:=StrWindow+FrmMain.EdtCspWidth.Text+','+FrmMain.EdtCspHeight.Text+'],';
StrWindow:=StrWindow+'0x0,0x0,,0,0,0,0';
Writeln(Fhhp,StrWindow);
Writeln(Fhhp,'');
Writeln(Fhhp,'[Files]');
For Intl:=0 To FrmMain.Trv1.Items.Count-1 Do
Begin
Node:=FrmMain.Trv1.Items[Intl];
If Node.Count=0 Then
Begin
Writeln(Fhhp,FrmMain.CurDir+FrmMain.StrPath.Strings[FrmMain.Intpath[IntL]]);
End;
End;
Finally
CloseFile(Fhhp);
End;
End;
Procedure exHhc;
Var
Fhhp:TextFile;
Intl,IntLoop,Intn:Integer;
Node:TTreeNode;
Begin
Assign(Fhhp,FrmMain.CurDir+'Tresss.hhc');
Rewrite(Fhhp);
Try
Writeln(Fhhp,'<html><head></head><body>');
Writeln(Fhhp,'<OBJECT type="text/site properties"><param name="Window Styles" value="0x227"></OBJECT>');
Writeln(Fhhp,'<UL>');
Intl:=0;
For IntLoop:=0 To FrmMain.Trv1.Items.Count-1 Do
Begin
Node:=FrmMain.Trv1.Items[IntLoop];
Intn:=Node.Level;
If Intn<Intl Then
Begin
For Intl:=Intl-1 DownTo Intn Do
Writeln(Fhhp,'</UL>');
Intl:=Intn;
End;
If Node.Count=0 Then
Begin
Writeln(Fhhp,'<LI><OBJECT TYPE="text/sitemap">');
Writeln(Fhhp,'<PARAM NAME="Name" VALUE="'+Node.Text+'">');
Writeln(Fhhp,'<PARAM NAME="Local" VALUE="'+FrmMain.StrPath.Strings[PInteger(Node.Data)^]+'">');
Writeln(Fhhp,'<PARAM NAME="ImageNumber" Value="11">');
Writeln(Fhhp,'</OBJECT>');
End
Else
Begin
Inc(Intl);
Writeln(Fhhp,'<LI><OBJECT TYPE="Text/sitemap">');
Writeln(Fhhp,'<PARAM NAME="Name" VALUE="'+Node.Text+'">');
Writeln(Fhhp,'</OBJECT><UL>');
End;
End;
If Intl>0 Then
Begin
For IntLoop:=0 To Intl-1 Do
Writeln(Fhhp,'</UL>');
End;
Writeln(Fhhp,'</UL></body></html>');
Finally
Close(Fhhp);
End;
End;
Procedure exHhk;
Var
Fhhp:TextFile;
IntLoop:Integer;
Node:TTreeNode;
Begin
Assign(Fhhp,FrmMain.CurDir+'Tresss.hhk');
Rewrite(Fhhp);
Try
Writeln(Fhhp,'<html><head></head><body><UL>');
For IntLoop:=0 To FrmMain.Trv1.Items.Count-1 Do
Begin
Node:=FrmMain.Trv1.Items[IntLoop];
If Node.Count=0 Then
Begin
Writeln(Fhhp,'<LI><OBJECT TYPE="text/sitemap">');
Writeln(Fhhp,'<PARAM NAME="Name" VALUE="'+Node.Text+'">');
Writeln(Fhhp,'<PARAM NAME="Local" VALUE="'+FrmMain.StrPath.Strings[PInteger(Node.Data)^]+'">');
Writeln(Fhhp,'<PARAM NAME="ImageNumber" Value="11">');
Writeln(Fhhp,'</OBJECT>');
End;
End;
Writeln(Fhhp,'</UL></body></html>');
Finally
Close(Fhhp);
End;
End;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -