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

📄 mainunit.pas

📁 一个漂亮的电子书籍阅读管理器
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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
  with TOptionForm.Create(self) do
  begin
    if ShowModal=mrOk then
    begin
      SetOpenSrmWithApp(SrmCheckBox.Checked);
      Mru.Visible:=FileListCheckBox.Checked;
      MyLoveMenuItem.Visible:=MyLoveCheckBox.Checked;
      MyLoveNextMenuItem.Visible:=MyLoveCheckBox.Checked;
      with AppIni do
      begin
        OpenSrmWithApp:=SrmCheckBox.Checked;
        LoadNearFile:=LoadSrmCheckBox.Checked;
        FileListVisible:=FileListCheckBox.checked;
        MyLoveVisible:=MyLoveCheckBox.Checked;
        SaveDbQuery:=SaveCheckBox.Checked;
        DelRecordQuery:=DelCheckBox.Checked;
        MyLoveFile:=MyLoveEdit.Text;
      end;
      TreeView.Color:=TvShape.Brush.Color;
      RichEdit.Color:=ReShape.Brush.Color;
      TreeView.Font:=TvLabel.Font;
      RichEdit.Font:=ReLabel.Font;
    end;
    Free;
  end;
  MyLoveMenuItem.Enabled:=AppIni.MyLoveFile<>'';
end;





//****************************************************************
//添加新节点----------------------------------------------------------
procedure TSrmForm.AddNodeMenuItemClick(Sender: TObject);
var
  ANode:TTreeNode;
  Id:integer;
begin
  ANode:=TreeView.Items.AddObjectFirst(TreeView.Selected,csNewDefaultTitle,
                                       pointer(-1));
  ANode.ImageIndex:=2;
  if ANode.Parent=nil then Id:=0 else Id:=integer(ANode.Parent.ItemId);
  SendMessage(TreeView.Handle,TVM_SORTCHILDREN,0,Id);   //自动排序当前同级标题
  TreeView.Selected:=ANode;

  ANode.EditText;
  StatusBar.Refresh;
  Srm.ItemDataChanged:=true;
end;
//添加新子节点--------------------------------------------------------
procedure TSrmForm.AddSubNodeMenuItemClick(Sender: TObject);
var
  ANode:TTreeNode;
  Id:integer;
begin
  ANode:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,csNewDefaultTitle,
                                            pointer(-1));
  ANode.ImageIndex:=2;
  ANode.Parent.ImageIndex:=1;
  if ANode.Parent=nil then Id:=0 else Id:=integer(ANode.Parent.ItemId);
  SendMessage(TreeView.Handle,TVM_SORTCHILDREN,0,Id);
  TreeView.Selected:=ANode;
  ANode.EditText;
  StatusBar.Refresh;
  Srm.ItemDataChanged:=true;
end;
//编辑节点-------------------------------------------------------------
procedure TSrmForm.EditNodeMenuItemClick(Sender: TObject);
begin
if TreeView.Selected <>nil then
begin
  TreeView.Selected.EditText;
  Srm.IndexChanged:=true;
end;
end;
//删除节点-------------------------------------------------------------
procedure TSrmForm.DelNodeMenuItemClick(Sender: TObject);
begin
  if AppIni.DelRecordQuery then
    if Application.MessageBox(csDeleteQuery,
           csAppName,MB_OKCANCEL or MB_ICONWARNING)<>IDOK then exit;
  TreeView.Selected.Delete;
  StatusBar.Refresh;
  Srm.IndexChanged:=true;
end;
//节点排序--------------------------------------------------------------
procedure TSrmForm.SortMenuItemClick(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  Application.ProcessMessages;

  TreeView.SortType:=stText;
  TreeView.AlphaSort;
  TreeView.SortType:=stNone;
  Srm.IndexChanged:=true;
  Screen.Cursor:=crDefault;
end;
//压缩数据库------------------------------------------------------------
procedure TSrmForm.CompressMenuItemClick(Sender: TObject);
var
  i,n:integer;
  Ms,Msh,Msd:TMemoryStream;
  ASrm:TSrmObject;
  AFileName,AoldFileName:string;
  ABuf:array[0..260] of char;
  ANode:TTreeNode;
  pBuf:PTreeData;
begin
  if Srm=nil then exit;  //如果没有打开的数据库则退出

  AOldFileName:=Srm.FileName;
  SaveSrm;

  GetTempFileName(pchar(ExtractFileDir(Srm.FileName)),'tmp',0,@ABuf[0]);
  AFileName:=string(ABuf);
  Ms:=TMemoryStream.Create;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  TreeView.SaveToStream(Msh);
  Msd.SetSize(sizeof(TTreeData)*TreeView.Items.Count);
  pBuf:=Msd.Memory;
  ASrm:=TSrmObject.Create(AFileName,fmCreate);
  n:=TreeView.Items.Count-1;
  ANode:=TreeView.Items.GetFirstNode;
  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;
      Srm.ReadItemHead(integer(ANode.Data));
      Srm.ReadItemData(Ms);
      ASrm.DataHead:=Srm.DataHead;
      pBuf^.Pos:=ASrm.AddItemHead;
      if ANode.GetFirstChild<>nil then pBuf^.DataType:=1

⌨️ 快捷键说明

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