⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 delphi 电子书阅读器 外观非常漂亮
💻 PAS
📖 第 1 页 / 共 5 页
字号:
		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 + -