📄 main.pas
字号:
else
begin
ItemNew.Items[0].Default := True;
ItemNew.Items[0].Default := False;
end;
end;
//调整文件处理菜单
ItemBIG5.Checked := g_boolBIG5;
ItemGB.Checked := g_boolGB;
ItemHtml.Checked := g_boolHtml;
ItemChap.Checked := g_boolChap;
ItemHangD.Checked := g_boolHangD;
ItemUnderLine.Checked := g_boolUnderLine;
//调整编码处理菜单
ItemUnMimeCode.Checked := g_boolUnMimeCode;
ItemUnQPCode.Checked := g_boolUnQPCode;
ItemUnHZCode.Checked := g_boolUnHZCode;
//调整书签菜单
ItemLabel.Enabled := (g_strFilename <> '') and (g_strFilename <> '剪贴板');
ItemAddLabel.Enabled := not FboolCurrentLabel;
ItemEditLabel.Enabled := FboolCurrentLabel;
ItemDeleteLabel.Enabled := FboolCurrentLabel;
ItemLabelInput.Enabled := ItemLabel.Enabled and (ItemLabelInput.Count > 0);
//调整默认书签
if (boolMenu and ItemLabelInput.Enabled) then
begin
for i := 0 to ItemLabelInput.Count - 1 do
begin
if g_boolSinglePage then
ItemLabelInput.Items[i].Default := (g_nYeCurrent + FnYeOffset = FnLabelIndex[i])
else
ItemLabelInput.Items[i].Default := (g_nYeCurrent = FnLabelIndex[i]) or (g_nYeCurrent + 1 = FnLabelIndex[i]);
end;
end;
//调整指定页菜单
ItemInputYe.Enabled := (g_nYeCount > 2);
//调整自动翻页菜单
if boolMenu then
begin
ItemAutoPageMove.Checked := g_boolAutoPageMove;
ItemAutoPageMove.Caption := GetWord('自动翻页') + '(' + IntToStr(g_nAutoVal) + GetWord('秒') + ')';
end;
//调整背景音乐菜单
ItemMP3.Enabled := g_boolExistMP3;
//调整显示菜单
if boolMenu then
begin
if FormMain.Visible then
ItemShow.Caption := GetWord('隐藏书本')
else
ItemShow.Caption := GetWord('显示书本');
end;
//调整最大化显示菜单
if boolMenu then
begin
g_boolMax := (FormMain.WindowState = wsMaximized);
if g_boolMax then
ItemMax.Caption := GetWord('恢复显示')
else
ItemMax.Caption := GetWord('最大化显示');
end;
//调整测试自动翻页菜单
if boolMenu then
begin
if FboolTestAutoPage then
ItemRecordTime.Caption := GetWord('结束自动翻页测试') + c_strItemMore
else
ItemRecordTime.Caption := GetWord('开始自动翻页测试');
end;
//调整清除最新文件菜单
ItemClearNewItem.Enabled := (FstrNewFileList.Count > 0);
end;
//---打开文件菜单---
procedure TFormMain.ItemOpenClick(Sender: TObject);
var
nOpenFileIndex : integer; //打开文件索引
nOpenFileCount : integer; //打开文件总数
begin
//显示主窗口
ShowMainForm;
//打开对话框,错误则退出
with FDlgOpenTextFile do
begin
if isZipSubFile(g_strFilename) then
InitialDir := ExtractFilePath(Copy(g_strFilename, 1, pos(c_strZipSpilt, g_strFilename) - 1))
else
InitialDir := ExtractFilePath(g_strFilename);
if not Execute then
Exit;
end;
//刷新主窗口
UpdateMainForm;
//设置参数
FboolOpenFileFlag := False; //写标志:没有正确打开文件
FboolOpenLibFile := False; //写标志:没有打开书库文件
FnOpenFileCount := 0; //文件计数写0
//获得总文件数
nOpenFileCount := FDlgOpenTextFile.Files.Count;
if nOpenFileCount > c_nRegFilenameCount then
nOpenFileCount := c_nRegFilenameCount;
for nOpenFileIndex := nOpenFileCount - 1 downto 0 do
OpenItemFile(FDlgOpenTextFile.Files.Strings[nOpenFileIndex]); //打开菜单文件(仅把文件写入菜单)
//判断是否打开了书库文件,并且删除原最新菜单
if FboolOpenFileFlag and FboolOpenLibFile and g_boolClearNewItem then
begin
//删除最新文件菜单
for nOpenFileIndex := FnOpenFileCount to FstrNewFileList.Count - 1 do
DeleteNewItem(FnOpenFileCount);
//改变最新文件索引
if FnOpenNewIndex >= FnOpenFileCount then
FnOpenNewIndex := -1;
end;
//正确打开文件,则打开参数文件中第一个文件
if FboolOpenFileFlag then
begin
ItemNew.Items[0].Click;
end;
end;
//---保存文件菜单---
procedure TFormMain.ItemSaveClick(Sender: TObject);
begin
//显示主窗口
ShowMainForm;
//打开对话框,错误则退出
with FDlgSaveTextFile do
begin
if isZipSubFile(g_strFilename) then
InitialDir := ExtractFilePath(Copy(g_strFilename, 1, pos(c_strZipSpilt, g_strFilename) - 1))
else
InitialDir := ExtractFilePath(g_strFilename);
if not Execute then
Exit;
end;
//保存文件
SaveFile(FDlgSaveTextFile.Filename, True);
end;
//---打开最新文件---
procedure TFormMain.OnItemNewFileClick(Sender: TObject);
var
strFilename : string; //打开的文件名
strZipFileList : TStringList; //用于传送解压文件的文件列表
strZipFilename, strZipSubFilename : string; //ZIP文件名、子文件名
i : integer;
procedure InitOpenFile;
var
nCurrentLabel, nCountLabel : integer;
begin //初始化打开的文件
//初始化打开文件的索引的文件名
FnOpenNewIndex := TMenuItem(Sender).MenuIndex;
g_strFilename := strFilename;
//初始化处理设置
if (LowerCase(ExtractFileExt(strFilename)) = '.htm') or
(LowerCase(ExtractFileExt(strFilename)) = '.html') then
g_boolHtml := True;
//初始化书签变量
ItemLabelInput.Clear;
nCurrentLabel := RegReadInt(c_strRegFilePath,
c_strRegFilenameSort + IntToStr(FnOpenNewIndex),
-1);
if (nCurrentLabel >= 0) then
begin
for nCountLabel := 0 to c_nRegLabelCount - 1 do
begin
//读入书签设置
FnLabelIndex[nCountLabel] := RegReadInt(c_strRegLabelPath,
IntToStr(nCurrentLabel) + c_strRegLabel + IntToStr(nCountLabel),
0);
FstrLabelString[nCountLabel] := RegReadStr(c_strRegLabelPath,
IntToStr(nCurrentLabel) + c_strRegLabelString + IntToStr(nCountLabel),
'');
if FnLabelIndex[nCountLabel] <= 0 then
Break;
//增加指定书签菜单
FItemAddLabel := TMenuItem.Create(Self);
FItemAddLabel.Caption := FstrLabelString[nCountLabel];
FItemAddLabel.OnClick := OnLabelInputClick;
ItemLabelInput.Add(FItemAddLabel);
end;
end;
//写标志:正确打开文件
FboolOpenFileFlag := True;
//处理
Init_Text;
Init_Page_Do;
Init_Page;
//翻到第1页
ChangeYe(1);
//刷新主窗口
UpdateMainForm;
end;
begin
//没有最新文件则退出
if FstrNewFileList.Count <= 0 then Exit;
//得到文件名,判断该文件是否存在
strFilename := GetIndexFilename(TMenuItem(Sender).MenuIndex);
if not isFileExist(strFilename, True) then Exit;
//---打开文件---
//判断是否是ZIP子文件
if isZipSubFile(strFilename) then
begin
//得到ZIP子文件名
GetZipFilename(strFilename, strZipFilename, strZipSubFilename);
strZipSubFilename := g_strZipPassDir + '\' + strZipSubFilename;
//判断是否改变最新文件菜单顺序
if g_boolChangeItem then
begin
if not OpenItemFile(strFilename) then Exit;
Sender := ItemNew.Items[0];
end;
//打开文件
if OpenFile(strZipSubFilename) then
InitOpenFile;
//退出
Exit;
end;
//判断是否改变最新文件菜单顺序
if g_boolChangeItem then
begin
if not OpenItemFile(strFilename) then Exit;
Sender := ItemNew.Items[0];
end;
//判断是否是ZIP文件
if LowerCase(ExtractFileExt(strFilename)) = '.zip' then
begin //打开ZIP文件,选择需要解压的文件
//建立用于传送解压文件的文件列表
strZipFileList := TStringList.Create;
strZipFileList.Clear;
//浏览需要解压的文件
if ShowSelZipFile(strFilename, strZipFileList) then
begin
//刷新主窗口
UpdateMainForm;
//设置参数
FboolOpenFileFlag := False; //写标志:没有正确打开文件
i := 0;
//打开文件
while (i <= strZipFileList.Count - 1) do
begin
OpenItemFile(strZipFileList.Strings[i]);
inc(i);
end;
//若成功解压文件,则打开第一个文件(解压出来的文件)
if FboolOpenFileFlag then
ItemNew.Items[0].Click;
end;
//释放用于传送解压文件的文件列表
strZipFileList.Free;
//退出
Exit;
end;
//打开一般文件
if OpenFile(strFilename) then
InitOpenFile;
end;
//---保存书库文件菜单---
procedure TFormMain.ItemLibClick(Sender: TObject);
var
i : integer;
s : string;
begin
//显示主窗口
ShowMainForm;
//没有最新文件则退出
if FstrNewFileList.Count <= 0 then Exit;
//打开对话框,错误则退出
with FDlgSaveLibFile do
begin
if isZipSubFile(g_strFilename) then
InitialDir := ExtractFilePath(Copy(g_strFilename, 1, pos(c_strZipSpilt, g_strFilename) - 1))
else
InitialDir := ExtractFilePath(g_strFilename);
if not Execute then
Exit;
end;
//获得文件名
s := FDlgSaveLibFile.Filename;
//保存书库文件
try
AssignFile(FpLibFile, s);
Rewrite(FpLibFile);
//初始化显示信息
InitShowMess(0, FstrNewFileList.Count, GetWord('生成书库文件'));
for i := FstrNewFileList.Count - 1 downto 0 do
begin
//显示完成度信息
ShowMessPos(FstrNewFileList.Count - i);
//写文件
Writeln(FpLibFile, GetIndexFilename(i)); //保存菜单文件名
end;
except
Alert(GetWord('生成书库文件') + ' ' + s + ' ' + GetWord('失败!') + c_strReturn + GetWord('请检查磁盘是否错误。'));
end;
//关闭文件
CloseFile(FpLibFile);
//关闭显示信息
CloseShowMess;
end;
//---保存合并文件菜单---
procedure TFormMain.ItemUniteClick(Sender: TObject);
var
i : integer;
s : string;
SrcStream, DestStream : TMemoryStream;
strFilename, strFilename1 : string;
begin
//显示主窗口
ShowMainForm;
//没有最新文件则退出
if FstrNewFileList.Count <= 0 then Exit;
//打开对话框,错误则退出
with FDlgSaveUniteFile do
begin
if isZipSubFile(g_strFilename) then
InitialDir := ExtractFilePath(Copy(g_strFilename, 1, pos(c_strZipSpilt, g_strFilename) - 1))
else
InitialDir := ExtractFilePath(g_strFilename);
if not Execute then
Exit;
end;
//获得文件名
s := FDlgSaveUniteFile.Filename;
//保存合并文件
try
SrcStream := TMemoryStream.Create;
DestStream := TMemoryStream.Create;
try
//初始化显示信息
InitShowMess(0, FstrNewFileList.Count, GetWord('生成合并文件'));
for i := 1 to FstrNewFileList.Count do
begin
//显示完成度信息
ShowMessPos(i);
//写文件
strFilename := GetIndexFilename(i - 1);
if (LowerCase(ExtractFileExt(strFilename)) <> '.zip') and //非ZIP文件
(LowerCase(ExtractFileExt(strFilename)) <> '.rtf') and //非RTF文件
(isFileExist(strFilename, False)) then //文件存在
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -