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

📄 mainunit.pas

📁 一个漂亮的电子书籍阅读管理器
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      else pBuf^.DataType:=ANode.ImageIndex;
      ASrm.AddItemData(Ms);
      pBuf:=PTreeData(integer(pBuf)+sizeof(TTreeData));
      ANode:=ANode.GetNext;
    end;
    ASrm.FileHead:=Srm.FileHead;
    ASrm.SaveIndex(Msh,Msd);
    ASrm.SaveSrmFile;
    Free;
  end;

  Screen.Cursor:=crDefault;
  ASrm.Free;
  Ms.Free;
  Msh.Free;
  Msd.Free;

  CloseSrm;
  DeleteFile(AOldFileName);
  MoveFile(pchar(AFileName),pchar(AOldFileName));
  OpenSrm(AOldFileName);

  StatusBar.Refresh;
end;
//升级2.x版数据库-------------------------------------------------------
procedure TSrmForm.CovertMenuItemClick(Sender: TObject);
var
  Fn: string;
  F2,F3:integer;
  FTv:TTreeView;
  IdxBuf:PIntArray;
  Ms,Msh,Msd:TMemoryStream;
  i,n,size:integer;
  FSrm:TSrmObject;
  ANode:TTreeNode;
begin
  if CloseSrmQuery then CloseSrm else exit;  //关闭打开的数据文件
  //得打开文件名和要保存的文件名
  with OpenDialog do
  begin
    DefaultExt:=csTreExt;
    Filter:=csOldFilter;
    Title:=csOpenTitle;
  end;
  with SaveDialog do
  begin
    DefaultExt:=csSrmExt;
    Filter:=csSrmFilter;
    Title:=csSaveAsTitle;
  end;
  if not OpenDialog.Execute then Exit;
  if not SaveDialog.Execute then Exit;
  //旧数据文件不完整时
  Fn:=OpenDialog.FileName;
  Delete(Fn,Length(Fn)-2,3);
  if not (FileExists(Fn+csTreExt) and
          FileExists(Fn+csIdxExt) and
          FileExists(Fn+csDatExt)) then
  begin
    Application.MessageBox(csOldFileError,csAppName,MB_OK+MB_ICONSTOP);
    exit;
  end;

  FSrm:=TSrmObject.Create(SaveDialog.FileName,fmCreate);
  Ms:=TMemoryStream.Create;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  //装入标题到隐藏的视图中
  FTv:=TTreeView.Create(self);
  FTv.Parent:=self;
  FTv.Visible:=false;
  FTv.LoadFromFile(Fn+csTreExt);
  ANode:=FTv.Items.GetFirstNode;
  //读入索引
  GetMem(IdxBuf,sizeof(integer)*FTv.Items.Count);
  Msd.SetSize(sizeof(TTreeData)*FTv.Items.Count);
  F2:=FileOpen(Fn+csIdxExt,fmOpenRead);
  FileRead(F2,IdxBuf^,sizeof(integer)*FTv.Items.Count);

  F3:=FileOpen(Fn+csDatExt,fmOpenRead);

  n:=FTv.Items.Count-1;
  Screen.Cursor:=crHourGlass;
  Application.ProcessMessages;
  with TProgressBar.Create(self) do
  begin
    Parent:=StatusBar;
    Align:=alClient;
    Max:=n;
    StatusBar.Update;

    for i:=0 to n do
    begin
      Position:=i;
      //置数据段头缺省值
      with FSrm.DataHead do
      begin
        Author[0]:=#0;
        Password[0]:=#0;
        SearchKey[0]:=#0;
        Keep:=0;
        PubDate:=Now;
        if (ANode.GetFirstChild<>nil) then
          DataType:=1
        else
          DataType:=2;
        if IdxBuf^[i]=-1 then
          Num:=0
        else
          Num:=1;
//          Num:=0;
      end;
      PTdArray(Msd.Memory)^[i].DataType:=FSrm.DataHead.DataType;
      PTdArray(Msd.Memory)^[i].Pos:=FSrm.AddItemHead;
      //读入数据内容
      if IdxBuf^[i]<>-1 then
      begin
        FileSeek(F3,IdxBuf^[i],0);
        FileRead(F3,size,sizeof(integer));
        Ms.SetSize(size);
        FileRead(F3,Ms.Memory^,size);
        FSrm.AddItemData(Ms);
      end;
      ANode:=ANode.GetNext;
    end;
    Free;
  end;
  Screen.Cursor:=crDefault;
  //保存新文件索引
  FTv.SaveToStream(Msh);
  FSrm.SaveIndex(Msh,Msd);
  FSrm.SaveSrmFile;
  //释放内存
  FreeMem(IdxBuf);
  FileClose(F2);
  FileClose(F3);
  FTv.Free;
  Ms.Free;
  Msd.Free;
  Msh.Free;
  FSrm.Free;
  OpenSrm(SaveDialog.FileName);
  Mru.Add(SaveDialog.FileName);
end;



//****************************************************************
//关于本软件----------------------------------------------------------
procedure TSrmForm.AboutMenuItemClick(Sender: TObject);
begin
  with TAboutForm.Create(self) do
  begin
    ShowModal;
    Free;
  end;
end;
//帮助文件----------------------------------------------------------
procedure TSrmForm.ReadmeMenuItemClick(Sender: TObject);
var
  TmpStr :string;
begin
  TmpStr:=Application.ExeName;
  Delete(TmpStr,Length(TmpStr)-2,3);
  TmpStr:=TmpStr+csHlpExt;
  if Sender is TWinControl then
  begin
    if TWinControl(Sender).HelpContext=0 then
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,10)
    else
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,
              TWinControl(Sender).HelpContext);
  end
  else
      WinHelp(Application.Handle,pchar(TmpStr),HELP_CONTEXT,10);
end;
//作者主页----------------------------------------------------------
procedure TSrmForm.HomePageMenuItemClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,nil,csHomePage,nil,nil,SW_SHOWNORMAL);
end;
//作者邮件----------------------------------------------------------
procedure TSrmForm.EMailMenuItemClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,nil,csEMail,nil,nil,SW_SHOWNORMAL);
end;
//技术支持----------------------------------------------------------
procedure TSrmForm.OtherMenuItemClick(Sender: TObject);
begin
  Application.MessageBox(csTechniqueSupport,csAppName,MB_OK+MB_ICONSTOP);
end;




//****************************************************************


//弹出文件菜单时-----------------------------------------
procedure TSrmForm.FileMenuItemClick(Sender: TObject);
begin
  if Srm=nil then    //没有打开的数据库时
  begin
    SaveMenuItem.Enabled:=false;
    CloseMenuItem.Enabled:=false;
    FImportMenuItem.Enabled:=false;
    DImportMenuItem.Enabled:=false;
  end
  else
  begin
    SaveMenuItem.Enabled:=true;
    CloseMenuItem.Enabled:=true;
    FImportMenuItem.Enabled:=true;
    DImportMenuItem.Enabled:=true;
    end;

  if TreeView.Selected=nil then   //没有被选择的标题时
  begin
    ExportMenuItem.Enabled:=false;
    PrintMenuItem.Enabled:=false;
  end
  else
  begin
    ExportMenuItem.Enabled:=true;
    PrintMenuItem.Enabled:=true;
  end;
end;
//弹出编辑菜单时---------------------------------------------
procedure TSrmForm.EditMenuItemClick(Sender: TObject);
begin
  if RichEdit.SelLength=0 then  //没有被选择的文本时
  begin
    CutMenuItem.Enabled:=false;
    CopyMenuItem.Enabled:=false;
  end
  else
  begin
    CutMenuItem.Enabled:=true;
    CopyMenuItem.Enabled:=true;
  end;
  if RichEdit.Modified=false then  //内容还未被修改过时
  begin
    UndoMenuItem.Enabled:=false;
    RedoMenuItem.Enabled:=false;
  end
  else
  begin
    UndoMenuItem.Enabled:=true;
    RedoMenuItem.Enabled:=true;
  end;
  OpenClipboard(Handle);
  if GetClipboardData(CF_TEXT)=0 then  //剪贴板中没有文本时
    PasteMenuItem.Enabled:=false
  else
    PasteMenuItem.enabled:=true;
  CloseClipboard;
  if RichEdit.SelLength>=RichEdit.GetTextLen then
    SelAllMenuItem.Enabled:=false
  else
    SelAllMenuItem.Enabled:=true;
end;

//数据库属性编辑框有变动时--------------------------------------
procedure TSrmForm.DbAuthorEditChange(Sender: TObject);
begin
  if LeftPageControl.ActivePage=PropertiyTabSheet then
    Srm.DbChanged:=true;
end;
//标题属性编辑框有变动时----------------------------------------
procedure TSrmForm.ContextAuthorEditChange(Sender: TObject);
begin
  if RightPageControl.ActivePage=ProTabSheet then
    Srm.ItemHeadChanged:=true;
end;

procedure TSrmForm.ContextTypeRadioGroupClick(Sender: TObject);
begin
  if RightPageControl.ActivePage=ProTabSheet then
  begin
    Srm.DbChanged:=true;
    if TreeView.Selected<>nil then
      TreeView.Selected.ImageIndex:=ContextTypeRadioGroup.ItemIndex+1;
    Srm.ItemHeadChanged:=true;
    Srm.IndexChanged:=true;
  end;
end;

//上一标题-------------------------------------------------
procedure TSrmForm.PrevSpeedButtonClick(Sender: TObject);
begin
if   LeftPageControl.ActivePage=IndexTabsheet then
begin
  if TreeView.Selected=nil then exit;
  if TreeView.Selected.GetPrev<>nil then
    TreeView.Selected:=TreeView.Selected.GetPrev;
end
else
if LeftPageControl.ActivePage=SearchTabSheet then
begin
if SearchListBox.ItemIndex<>0 then
SearchListBox.ItemIndex:=SearchListBox.itemIndex-1;
TreeView.Selected := TreeView.Items[LongInt(SearchListBox.Items.objects
[SearchListBox.ItemIndex])]
end;
end;
//下一标题-------------------------------------------------
procedure TSrmForm.NextSpeedButtonClick(Sender: TObject);
begin
if   LeftPageControl.ActivePage=IndexTabsheet then
begin
  if TreeView.Selected=nil then exit;
  if TreeView.Selected.GetNext<>nil then
    TreeView.Selected:=TreeView.Selected.GetNext;
end
else
if LeftPageControl.ActivePage=SearchTabSheet then
begin

SearchListBox.ItemIndex:=SearchListBox.itemIndex+1;
TreeView.Selected := TreeView.Items[LongInt(SearchListBox.Items.objects
[SearchListBox.ItemIndex])];
end;
end;





//编辑框有变动时------------------------------------------
procedure TSrmForm.RichEditChange(Sender: TObject);
type
  TTextRange = record
    chrg: TCharRange;
    lpstrText: PChar;
  end;
var
  Idx:integer;
  Tr:TTextRange;
  s:string;
begin
  if RichEdit.SelStart=0 then exit;
  Idx:=RichEdit.SelStart-1;
  Tr.chrg.cpMin:=RichEdit.Perform(EM_FINDWORDBREAK,WB_LEFTBREAK,Idx);
  Tr.chrg.cpMax:=RichEdit.Perform(EM_FINDWORDBREAK,WB_RIGHTBREAK,Idx);
  if Tr.chrg.cpMin<Tr.chrg.cpMax then
  begin
      SetLength(s,Tr.chrg.cpMax-Tr.chrg.cpMin);
      Tr.lpstrText:= @S[1];
      RichEdit.Perform(EM_GETTEXTRANGE, 0, Integer(@Tr));
      s:=LowerCase(s);
      if s='http://' then
      begin
        RichEdit.Perform(EM_HIDESELECTION,1,1);
        RichEdit.Perform(EM_SETSEL,Tr.chrg.cpMin,Tr.chrg.cpMax);
        RichEdit.SelAttributes.Color:=clRed;
        RichEdit.Perform(EM_HIDESELECTION,0,0);
      end;
  end;
//  RichEdit.
  StatusBar.Refresh;
end;
//编辑框有按键事件时
procedure TSrmForm.RichEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//var
//  a:word;
begin
{
  a:=GetKeyboardLayout(0);
  if a<>$804 then                                       //如果不是中文输入法
    RichEdit.DefAttributes.CharSet:=RichEdit.Font.CharSet; //置当前字体为原字体
}
end;

procedure TSrmForm.ControlBarDockOver(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
begin
  Accept := (Source.Control is TToolBar);
end;

procedure TSrmForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i:integer;
begin
if integer(key)=13 then     //*如果是回车的话
begin
SearchListBox.Items.Clear;
for i:=0 to TreeView.Items.Count-1 do
   begin
 if Pos(Lowercase(edit1.Text),Lowercase(TreeView.Items[i].Text))<>0 then
SearchListBox.items.AddObject(TreeView.Items[i].Text,TObject(i));
 //*查找,把节点号也加入到STRINGS类中去!
end;
LeftPageControl.ActivePage :=SearchTabSheet;
RichEdit.Lines.Clear;
end;
end;

procedure TSrmForm.SearchListBoxClick(Sender: TObject);
begin
TreeView.Selected := TreeView.Items[LongInt(SearchListBox.Items.objects[SearchListBox.ItemIndex])];
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -