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

📄 mainunit.~pas

📁 一个漂亮的电子书籍阅读管理器
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
      UserPs:=string(Srm.FileHead.Password);
      if Ps<>UserPs then
      begin
        if ModalResult<>mrCancel then
          Application.MessageBox(csAppName,csPasswordError,MB_OK);
        Srm.Free;
        Srm:=nil;
        Result:=false;
        Free;
        Exit;
      end;
      Free;
    end;
  end;

  Screen.Cursor:=crHourGlass;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  Srm.LoadIndex(Msh,Msd);                 //装入索引

  AList := TStringList.Create;
  SrmForm.TreeView.Items.BeginUpdate;
  AList.LoadFromStream(Msh);              //装入到字符串列表中
  SendMessage(SrmForm.TreeView.Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
  AOldLevel := 0;
  AParentNode := nil;
  n:=AList.Count-1;
  p:=Msd.Memory;
  for i:=0 to n do                        //根据TAB的多少得到相应级别
  begin
    StrBuf:=PChar(AList.Strings[i]);
    ALevel:=0;
    while StrBuf^=#9 do                   //得该项所在层数
    begin
      Inc(StrBuf);
      Inc(ALevel);
    end;
    if (ALevel<AOldLevel) or (AParentNode<>nil) then
    begin                                 //返回该项的上级节点
      for j:=AOldLevel downto ALevel do
      begin
        AParentNode:=AParentNode.Parent;
      end;
    end;
    AParentNode:=SrmForm.TreeView.Items.AddChildObject(AParentNode,StrBuf,
                                      pointer(p.Pos));
    AParentNode.ImageIndex:=p.DataType;   //得该节点类型
    AOldLevel:=ALevel;
    p:=pointer(integer(p)+sizeof(TTreeData));
  end;
  SrmForm.TreeView.Items.EndUpdate;
  AList.Free;
  Msd.Free;
  Msh.Free;

  with Srm.FileHead,SrmForm do            //显示文件属性
  begin
    DbAuthorEdit.Text:=String(Author);
    DbPasswordEdit.Text:=String(Password);
    DbBuildDateEdit.Text:=DateToStr(BuildDate);
    DbEditDateEdit.Text:=DateToStr(EditDate);
  end;

  SrmForm.TreeView.Selected:=nil;         //置当前选择项为空
  with Srm do
  begin
    DbChanged:=false;                     //数据库变动标志复原
    IndexChanged:=false;                  //索引变动标志复原
    ItemHeadChanged:=false;
    ItemDataChanged:=false;
  end;

  Screen.Cursor:=crDefault;
end;    }



end;
//目录引入-----------------------------------------------------------------
procedure TSrmForm.DImportMenuItemClick(Sender: TObject);
var
  Temps:WideString;
  Dir,Mask:string;
  ANode:TTreeNode;
begin
  Temps:='';
//  if not SelectDirectory(csAppName,Temps,Dir) then exit;
  Dir:=BrowseFolder;
  If Dir='' Then exit;
  ANode:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,
       GetLastPathName(Dir),pointer(-1));
  ANode.ImageIndex:=1;
  with Srm.DataHead do
  begin
    DataType:=1;
    Author[0]:=#0;
    Password[0]:=#0;
  end;
  TreeView.Selected:=ANode;
  RichEdit.Modified:=true;
  if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\';
  Mask:='*.'+csTxtExt;
  Screen.Cursor:=crHourGlass;
  RichEdit.Perform(WM_SETREDRAW,0,0);  //禁止重绘
  ImportDir(Dir,Mask);
  RichEdit.Perform(WM_SETREDRAW,-1,0);  //允许重绘
  Richedit.Refresh;
  StatusBar.Refresh;
  SCreen.Cursor:=crDefault;
end;
//导出标题内容--------------------------------------------------------------
procedure TSrmForm.ExportMenuItemClick(Sender: TObject);
var
  Dir:string;
//  i,n:integer;     //对别的格式要导出其附件

  function FormatFileName(Fn:string):string;
  var
    i,n:integer;
    c:char;
  begin
    Result:=Fn;
    n:=Length(Result);
    for i:=1 to n do
    begin
      c:=Result[i];
      if ((c=#92) or (c=#47) or (c=#58) or (c=#42) or (c=#63) or
           (c=#34) or (c=#60) or (c=#62) or (c=#124)) then
        Result[i]:='$';  //替换掉系统不接受的文件命名的字符
    end;
  end;
  procedure OutPutSrm(ANode:TTreeNode;Dir:string);
  var
    SNode:TTreeNode;
    Ms:TMemoryStream;
    Fh:integer;
    Path:string;
  begin
    Ms:=TMemoryStream.Create;
    Path:=Dir;
    SNode:=ANode.GetFirstChild;
    while SNode<>nil do
    begin
      if SNode.ImageIndex=1 then
      begin
        Dir:=Path+FormatFileName(SNode.Text);
        MkDir(Dir);
        Dir:=Dir+'\';
        OutPutSrm(SNode,Dir);
      end
      else
      begin
        Srm.ReadItemHead(integer(SNode.Data));
        if ((Srm.DataHead.Password[0]=#0) and (Srm.DataHead.Num=1)) then
        begin       //没有口令的内容才导出
          Srm.ReadItemData(Ms);
          Fh:=FileCreate(Path+FormatFileName(SNode.Text)+'.'+csTxtExt);
          if Fh<>0 then FileWrite(Fh,Ms.Memory^,Ms.Size);
          FileClose(Fh);
        end;
      end;
      SNode:=SNode.GetNextSibling;
    end;
    Ms.Free;
  end;
begin
  if TreeView.Selected=nil then exit;
  if TreeView.Selected.GetFirstChild=nil then
  begin
    with SaveDialog do
    begin
      DefaultExt:=csTxtExt;
      Filter:=csTxtFilter;
      Title:=csSaveAsTitle;
      FileName:=TreeView.Selected.Text;
    end;
    if SaveDialog.Execute then
    begin
      RichEdit.Lines.SaveToFile(SaveDialog.FileName);
    end;
  end
  else
  begin
    Dir:=BrowseFolder;
    If Dir='' Then exit;
    if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\';
    Dir:=Dir+FormatFileName(TreeView.Selected.Text);
    if DirectoryExists(Dir) then
    begin
      Application.MessageBox(csDirExists,csAppName,MB_OK or MB_ICONERROR);
      exit;
    end;
    MkDir(Dir);
    Dir:=Dir+'\';
    Screen.Cursor:=crHourGlass;
    OutPutSrm(TreeView.Selected,Dir);
    Screen.Cursor:=crDefault;
  end;
end;
//打印内容------------------------------------------------------------------
procedure TSrmForm.PrintMenuItemClick(Sender: TObject);
begin
  if RichEdit.GetTextLen()=0 then
    RichEdit.Print(TitleLabel.Caption);
end;
//退出菜单-----------------------------------------------------------------
procedure TSrmForm.ExitMenuItemClick(Sender: TObject);
begin
  Close;
end;
//最近文件列表-----------------------------------------------------------------
procedure TSrmForm.ListMenuItemClick(Sender: TObject);
var
  Temps:string;
begin
  if CloseSrmQuery then closeSrm else exit;
  Temps:=Mru.FileList[TMenuItem(Sender).Tag];
  if Temps<>'' then
    if FileExists(Temps) then
     OpenSrm(Temps);
  if Srm=nil then
    Caption:=csAppName
  else
  begin
    Caption:=csAppName+' - '+Temps;
    Mru.Add(Temps);
  end;
end;
//我的最爱-----------------------------------------------------------------
procedure TSrmForm.MyLoveMenuItemClick(Sender: TObject);
begin
  if CloseSrmQuery then CloseSrm else exit;
  if AppIni.MyLoveFile<>'' then
    if FileExists(AppIni.MyLoveFile) then OpenSrm(AppIni.MyLoveFile);
  if Srm=nil then
    Caption:=csAppName
  else
    begin
      Caption:=csAppName+' - '+AppIni.MyLoveFile;
      Mru.Add(AppIni.MyLoveFile);
    end;
end;



//****************************************************************
//恢复菜单----------------------------------------------------------------
procedure TSrmForm.UndoMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,EM_UNDO,0,0);
end;

//---------------------------------------------------------------------
procedure TSrmForm.RedoMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,EM_UNDO,0,0);
end;

//重做菜单--------------------------------------------------------------
procedure TSrmForm.CutMenuItemClick(Sender: TObject);
begin
  SendMessage(GetFocus,WM_CUT,0,0);
end;

//拷贝------------------------------------------------------------------
procedure TSrmForm.CopyMenuItemClick(Sender: TObject);
begin
  SendMessage(GetFocus,WM_COPY,0,0);
end;

//粘贴----------------------------------------------------------------
procedure TSrmForm.PasteMenuItemClick(Sender: TObject);
begin
  SendMessage(GetFocus,WM_PASTE,0,0);
end;

//全选---------------------------------------------------------------
procedure TSrmForm.SelAllMenuItemClick(Sender: TObject);
begin
  RichEdit.SelectAll;
end;

//查找-----------------------------------------------------------------
procedure TSrmForm.FindMenuItemClick(Sender: TObject);
begin
  ReplaceDialog.ReplaceText:='';
  FindDialog.Execute;
end;

//查找下一个-------------------------------------------------------------
procedure TSrmForm.FindNextMenuItemClick(Sender: TObject);
begin
  if Length(ReplaceDialog.ReplaceText)<>0 then
  begin
    ReplaceDialog.Options:=ReplaceDialog.Options+[frReplace];
    ReplaceDialogReplace(Sender);
  end
  else if Length(FindDialog.FindText)<>0 then
  begin
    FindDialogFind(Sender);
  end
  else
    FindDialog.Execute;
end;

//替换------------------------------------------------------------------
procedure TSrmForm.ReplaceMenuItemClick(Sender: TObject);
begin
  ReplaceDialog.Execute;
end;
//删除空格---------------------------------------------------------------
procedure TSrmForm.DelSpaceMenuItemClick(Sender: TObject);
var
  i,Size:integer;
  OldBuf,NewBuf,TempOldBuf,TempNewBuf:pchar;
begin
  Size:=RichEdit.GetTextLen+2;
  GetMem(OldBuf,Size+1);
  GetMem(NewBuf,Size+1);
  TempOldBuf:=OldBuf;
  TempNewBuf:=NewBuf;
  RichEdit.GetTextBuf(OldBuf,Size);
  for i:=0 to Size do
  begin
    if TempOldBuf^=#32 then
    begin
      if ((pchar(integer(TempOldBuf-1))^>=#160) or
          (pchar(integer(TempOldBuf+1))^>=#160)) then
        inc(TempOldBuf)
      else
      begin
        TempNewBuf^:=TempOldBuf^;
        inc(TempNewBuf);
        inc(TempOldBuf);
      end;
    end
    else
    begin
      TempNewBuf^:=TempOldBuf^;
      inc(TempNewBuf);
      inc(TempOldBuf);
    end;
  end;
  TempNewBuf^:=#0;
  RichEdit.SetTextBuf(NewBuf);
  FreeMem(OldBuf);
  FreeMem(NewBuf);
end;
//合并成段---------------------------------------------------------------
procedure TSrmForm.CParaMenuItemClick(Sender: TObject);
var
  Stext,Dtext:pchar;
  OldStext,OldDtext:pchar;
  n:integer;
begin
  n:=RichEdit.SelLength;
  if n=0 then Exit;    //没有选择的文本则退出

  Inc(n);
  GetMem(OldStext,n);
  GetMem(OldDtext,n);  //分配内存准备COPY文本
  Stext:=OldStext;
  Dtext:=OldDtext;

  RichEdit.GetSelTextBuf(Stext,n);
  while Stext^<>#0 do
  begin
    if (Stext^=#10) or (Stext^=#13) then  //如果是回车换行符
      Inc(Stext)
    else
    begin
      Dtext^:=Stext^;
      Inc(Stext);
      Inc(Dtext);
    end;
  end;
  Inc(Dtext);
  Dtext^:=#0;
  RichEdit.SetSelTextBuf(OldDtext);

  FreeMem(OldStext);
  FreeMem(OldDtext);
end;
//分割段落---------------------------------------------------------------
procedure TSrmForm.DParaMenuItemClick(Sender: TObject);
var
  i,n:integer;
  s:string;
begin
  if (RichEdit.GetTextLen=0) or (not RichEdit.WordWrap) then Exit;

  Application.ProcessMessages;

  n:=RichEdit.Lines.Count-1;
  with TProgressBar.Create(self) do
  begin
    Parent:=StatusBar;
    Align:=alClient;
    Max:=n;
    StatusBar.Update;
    Screen.Cursor:=crHourGlass;
    RichEdit.Perform(WM_SETREDRAW,0,0);  //禁止重绘
    for i:=0 to n do
    begin
      s:=RichEdit.Lines[i];
      if s<>'' then RichEdit.Lines[i]:=Format('%s'#13#10,[s]);
      Position:=i;
    end;
    RichEdit.Perform(WM_SETREDRAW,-1,0);
    RichEdit.Refresh;
    Screen.Cursor:=crDefault;
    Free;
  end;
end;
//Gb To Big5转换--------------------------------------------------------
procedure TSrmForm.GbToBigMenuItemClick(Sender: TObject);
var
  Buf:pchar;
  n:integer;
begin
  n:=RichEdit.GetTextLen+1;
  GetMem(Buf,n);
  RichEdit.GetTextBuf(Buf,n);
  GbToBig(Buf);
  RichEdit.SetTextBuf(Buf);
  FreeMem(Buf);
end;
//Big5 To Gb转换--------------------------------------------------------
procedure TSrmForm.BigToGbMenuItemClick(Sender: TObject);
var
  Buf:pchar;
  n:integer;
begin
  n:=RichEdit.GetTextLen+1;
  GetMem(Buf,n);
  RichEdit.GetTextBuf(Buf,n);
  BigToGb(Buf);
  RichEdit.SetTextBuf(Buf);
  FreeMem(Buf);
end;


//****************************************************************
//工具栏显示---------------------------------------------------------
procedure TSrmForm.ToolsMenuItemClick(Sender: TObject);
begin
//
end;
//状态栏显示---------------------------------------------------------
procedure TSrmForm.StatusMenuItemClick(Sender: TObject);
var
  tmp:boolean;
begin
  tmp:=not StatusMenuItem.Checked;
  StatusMenuItem.Checked:=tmp;
  StatusBar.Visible:=tmp;
end;
//视图栏显示---------------------------------------------------------
procedure TSrmForm.TitleMenuItemClick(Sender: TObject);
var
  tmp:boolean;
begin
  tmp:=not TitleMenuItem.Checked;
  TitleMenuItem.Checked:=tmp;
  TitleToolButton.Down:=tmp;
  Splitter.Visible:=tmp;
  LeftForm.Visible:=tmp;
end;
//只读控制-----------------------------------------------------------
procedure TSrmForm.ReadOnlyMenuItemClick(Sender: TObject);
var
  tmp:boolean;
begin
  tmp:=not ReadOnlymenuItem.Checked;
  ReadOnlyMenuItem.Checked:=tmp;
  ReadOnlyToolButton.Down:=tmp;
  RichEdit.ReadOnly:=tmp;
end;
//自动换行------------------------------------------------------------
procedure TSrmForm.WordWrapMenuItemClick(Sender: TObject);
var
  tmp:boolean;
begin
  tmp:=not WordWrapMenuItem.Checked;
  WordWrapMenuItem.checked:=tmp;
  WordWrapToolButton.Down:=tmp;
  RichEdit.WordWrap:=tmp;
end;
//放大字体------------------------------------------------------------
procedure TSrmForm.BigFontMenuItemClick(Sender: TObject);
begin
  with RichEdit.Font do Size:=Size+1;
end;
//缩小字体--------------------------------------------------------------
procedure TSrmForm.SmallFontMenuItemClick(Sender: TObject);
begin
  with RichEdit.Font do Size:=Size-1;
end;
//选项设置--------------------------------------------------------------
procedure TSrmForm.OptionsMenuItemClick(Sender: TObject);
begin

⌨️ 快捷键说明

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