mainunit.~pas

一个漂亮的电子书籍阅读管理器

  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
  TreeView.Selected.EditText;
  Srm.IndexChanged:=true;
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
      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 TreeView.Selected=nil then exit;
  if TreeView.Selected.GetPrev<>nil then
    TreeView.Selected:=TreeView.Selected.GetPrev;
end;
//下一标题-------------------------------------------------
procedure TSrmForm.NextSpeedButtonClick(Sender: TObject);
begin
  if TreeView.Selected=nil then exit;
  if TreeView.Selected.GetNext<>nil then
    TreeView.Selected:=TreeView.Selected.GetNext;
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;

end.