ebookfrm.pas

用于制作和整理（文件搜索方式）编程技术文档和各类源代码, 可以如编程工具一样分色显示程序(C++, Delphi , java, Vb, SQL ……)(用算法实现), 主要用于查找相应的类和函数

 
{*******************************************************************}
{                                                                   }
{       Support: [e-mail]                                     }
{       // xcwen 2005-7~~~2005-8     delphi7                        }
{      finish 2005-12                                               }
{*******************************************************************}
unit Ebookfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, Menus, ActnMan, ActnColorMaps, StdCtrls, ComCtrls,
  ToolWin, ExtCtrls, WinSkinData, Buttons , WinSkinStore ,
  {////}inifiles,Registry,UnitPlToRtf,Lru_mm,
      UnitFileMove,unitabout, set_infor_frm,shellapi,unit_searchfilethread;


const
         //该节点没有子文件时的标识
         dir_imageindex  =0;
         dir_selectindex =1;

         //该节点没有子文件时的标识
         file_imageindex  =16;
         file_selectindex =17;

         //每相邻级别的节点在X轴上的差值
         level_width =19;
         node_front_width=30;
type
  Tmainfrm = class(TForm)
    MainMenu: TMainMenu;
    f1: TMenuItem;
    images: TImageList;
    btn_new_dir: TMenuItem;
    btn_open_dir: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    MmOption: TMenuItem;
    MMLastfiles: TMenuItem;
    Pnlshow: TPanel;
    TbShow: TToolBar;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ret_show: TRichEdit;
    Menu_dir: TPopupMenu;
    BTn_add_File: TMenuItem;
    btn_add_Chlid_File: TMenuItem;
    btn_insert_file: TMenuItem;
    btn_del_file: TMenuItem;
    btn_rename_file: TMenuItem;
    btn_cut_file: TMenuItem;
    btn_paste_file: TMenuItem;
    OpenDialog_dir: TOpenDialog;
    SaveDialog_dir: TSaveDialog;
    menu_show: TPopupMenu;
    btn_copy: TMenuItem;
    btn_cut: TMenuItem;
    btn_paste: TMenuItem;
    btn_save: TMenuItem;
    btn_selectAll: TMenuItem;
    btn_seclectfont: TMenuItem;
    btn_readonly: TMenuItem;
    FontDialog: TFontDialog;
    FindDialog: TFindDialog;
    Mmsearch: TMenuItem;
    btn_find: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    MMSearchFils: TMenuItem;
    N25: TMenuItem;
    N6: TMenuItem;
    Mmedit: TMenuItem;
    btn_undo: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    btn_format_font: TMenuItem;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton18: TToolButton;
    N1: TMenuItem;
    N2: TMenuItem;
    N7: TMenuItem;
    N9: TMenuItem;
    N20: TMenuItem;
    N24: TMenuItem;
    N26: TMenuItem;
    MM_findall: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    Sbr_show: TStatusBar;
    MmPLconfig: TMenuItem;
    DEL_PL_cfg: TMenuItem;
    N34: TMenuItem;
    ToolButton17: TToolButton;
    N19: TMenuItem;
    MM_CreateFileFromClipboard: TMenuItem;
    Ebook1: TMenuItem;
    N23: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    PclOperation: TPageControl;
    TabSheet1: TTabSheet;
    PnlDir: TPanel;
    TbDir: TToolBar;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    TBnCreateFileFromClipboard: TToolButton;
    ToolButton8: TToolButton;
    tbnPrev: TToolButton;
    TbnNext: TToolButton;
    TVW_dir: TTreeView;
    TabSheet2: TTabSheet;
    Splitter1: TSplitter;
    Lbx_searchfile: TListBox;
    PnlKeyword: TPanel;
    lblKeyword: TLabel;
    EdtKeyword: TEdit;
    PnlShowProgress: TPanel;
    Pbr_searchfile: TProgressBar;
    Panel2: TPanel;
    PNlopeation: TPanel;
    SbnKeyword: TSpeedButton;
    Cbx_sensitivity: TCheckBox;
    N29: TMenuItem;
    procedure N4Click(Sender: TObject);
    procedure btn_open_dirClick(Sender: TObject);
    procedure TVW_dirDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TVW_dirDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure ret_showChange(Sender: TObject);

    procedure ToolButton9Click(Sender: TObject);
    procedure TbnNextClick(Sender: TObject);
    procedure TVW_dirClick(Sender: TObject);
    procedure MMSearchFilsClick(Sender: TObject);
    procedure BTn_add_FileClick(Sender: TObject);
    procedure btn_add_Chlid_FileClick(Sender: TObject);
    procedure btn_insert_fileClick(Sender: TObject);
    procedure btn_rename_fileClick(Sender: TObject);
    procedure btn_del_fileClick(Sender: TObject);
    procedure btn_new_dirClick(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure btn_undoClick(Sender: TObject);
    procedure btn_cutClick(Sender: TObject);
    procedure btn_copyClick(Sender: TObject);
    procedure btn_pasteClick(Sender: TObject);
    procedure btn_saveClick(Sender: TObject);
    procedure btn_selectAllClick(Sender: TObject);
    procedure btn_readonlyClick(Sender: TObject);
    procedure btn_seclectfontClick(Sender: TObject);
    procedure btn_findClick(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure btn_format_fontClick(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure del_all_lastfilesClick(Sender: TObject);
    procedure ret_showSelectionChange(Sender: TObject);
    procedure btn_cut_fileClick(Sender: TObject);
    procedure btn_paste_fileClick(Sender: TObject);
    procedure Menu_dirPopup(Sender: TObject);
    procedure TVW_dirKeyPress(Sender: TObject; var Key: Char);
    procedure N20Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure MM_findallClick(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure FindDialogFind(Sender: TObject);
    procedure MmPLconfigClick(Sender: TObject);
    procedure DEL_PL_cfgClick(Sender: TObject);
    procedure MmOptionClick(Sender: TObject);
    procedure MM_CreateFileFromClipboardClick(Sender: TObject);
    procedure Ebook1Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure PnlKeywordResize(Sender: TObject);
    procedure SbnKeywordClick(Sender: TObject);
    procedure Lbx_searchfileClick(Sender: TObject);
    procedure EdtKeywordKeyPress(Sender: TObject; var Key: Char);
    procedure FindDialogShow(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure ToolButton3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    pathstring :string;        //保存当前目录的路径!
    dirstring:string;
    filetype: string;      // 当前的文件格式
    FPLConfigFileName:string;
    FCfgFile:string;//最近文件的配置文件

    filelist:Tstringlist;
    lastnode :TTreenode;  //最近选择的节点
    cut_node:TTreenode;   //进行 节点剪切 的节点保存
    find_node_key:string; //保存节点关键字
    find_text_key:string;//保存文件中的关键字
    //ret_show
    file_ischange:boolean;    //当前文件是否改变过
    IsInFormatFont :boolean; //进行格式刷操作标识
    ForMatFont:TFont;
    last_form_top, last_form_left,last_form_width,last_form_height:integer;



    procedure PLMmClick(Sender: TObject)  ;


    procedure save_file(sourceNode:TTReenode) ;
    procedure open_file(sourceNode:TTReenode) ;
    function  save_dir:boolean;
    procedure set_node_image(SourceNode: TTreeNode)  ;
    function  get_new_filename(var filename:string;showmsg:string):boolean;
    procedure get_information_from_filename(Dirfilename:string);
    procedure add_a_file(sourcenode:TTreenode;Method: TNodeAttachMode) ;
    procedure del_a_file(sourcenode:TTreenode) ;
    procedure rename_a_file(sourcenode:TTreenode);
    procedure creat_file_from_Clipboard(sourcenode:TTreenode);
    function find_text:boolean;
    procedure find_text_in_all_file;
    procedure find_node(start_index:integer;key:string);
    procedure file_link;
    function get_node_index(node_text:string):integer;
    PROCEDURE FinishDropped ( VAR Msg : TMessage );Message WM_DropFiles ;
    procedure dealsearchfileMsg(var msg:Tmessage);message WM_searchfile;
       //wm_searchfile 在 unit_searchfileThread定义
    procedure dealMiOnclick(var msg:Tmessage);message WM_MiOnClick;
                                 
    function save_file_without_message(sourceNode:TTreenode):boolean;
    function GetFileName(const text:string ;var fileName:string):boolean;
    procedure CreateDir(DirFileName:string);
    procedure forRun;
    procedure forWait;
    procedure SetPLMsg;//根据 filetype
    procedure LoadMmPLName(inifilename:string;ParentMm:Tmenuitem);
    procedure Setinterface(hasDir:boolean);
    procedure showMsg(Msg1:string ='';Msg2:string='');
    procedure showdir();
    function getTreenodeIndex(startindex:integer;nodetext:string) :integer;

  public
    PLCon:TPlconversion;
    LruMm:TlruMm; //最近文件的菜单
    property  PLconfigfile:string read FPLconfigfilename write FPLconfigfilename;
    procedure PLToRtfWithStrings;
    procedure PLToPtfWithFile(filename:string);

    procedure SaveToReg;
    procedure LoadFromReg;
    procedure saveDefaultPLMsgs;
    procedure open_dir (dir_name:string);
    { Public declarations }
  end;


var
  mainfrm: Tmainfrm;


implementation

{$R *.dfm}

procedure Tmainfrm.N4Click(Sender: TObject);
begin
  self.Close ;
end;

procedure Tmainfrm.btn_open_dirClick(Sender: TObject);
begin
 self.showMsg('打开目录');
 if self.OpenDialog_dir.Execute then
 begin
    self.open_dir(opendialog_dir.FileName );
 end;

 
end;

procedure Tmainfrm.TVW_dirDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  TargetNode, SourceNode: TTreeNode;
begin

  TargetNode := self.TVW_dir.GetNodeAt (X, Y);

  if (Source = Sender) and (TargetNode <> nil) then
  begin
    Accept := True;
    SourceNode := tvw_dir.Selected;

    //保证  TargetNode 不是 SourceNode 的子节点
    while (TargetNode.Parent <> nil) and
        (TargetNode <> SourceNode) do
    TargetNode := TargetNode.Parent;

    if TargetNode = SourceNode then
      Accept := False;
  end
  else
    Accept := False;

end;

procedure Tmainfrm.TVW_dirDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  source_parentnode,TargetNode, SourceNode: TTreeNode;
begin
  TargetNode := tvw_dir.GetNodeAt (X, Y);
  if TargetNode <> nil then
  begin

    SourceNode := tvw_dir.Selected;
    source_parentnode:=sourcenode.Parent ;
    if (X<level_width * targetNode.Level+node_front_width ) then
    begin
       SourceNode.MoveTo (TargetNode,naInsert);
    end
    else
    begin
       SourceNode.MoveTo (TargetNode,naAddChildFirst);
       if sourcenode.Parent <>nil then
             sourcenode.Parent.Expanded :=false;
       self.set_node_image(targetnode);
    end  ;
    self.set_node_image(source_parentnode);
  end;
end;

procedure Tmainfrm.set_node_image(SourceNode: TTreeNode);
begin
    //
   if sourcenode<>nil then
   begin
   if sourcenode.HasChildren  then
   begin
        sourceNode.imageIndex    := dir_imageindex;
        sourceNode.SelectedIndex :=dir_selectindex;
   end
   else
   begin
        sourceNode.imageIndex    := file_imageindex;
        sourceNode.SelectedIndex :=file_selectindex;
   end;
   end;
end;

function Tmainfrm.get_new_filename(var filename: string;showmsg:string):boolean;
var filename_canuse:boolean;
var i:integer;
begin
    if filename='' then
       filename:='未命名';
    result:=false;
    repeat
       filename_canuse:=true;
        if not InputQuery('您正在'+showmsg+'...   ','输入文件名:    '+#13+
        '(若重名时重新弹出..)     ', filename) then
           exit;//退出该过程
        filename:=Trim(filename);
        for i:=1 to length(filename) do
           if filename[i] in ['\','/',':','*','?','<','>','|'] then
           begin
              filename_canuse:=false;
              showmessage('出现非法字符:'+filename[i]);
              break;
           end;
    until (filename_canuse and not(FileExists(pathstring+filename+filetype )));
    result:=true;
end;

procedure Tmainfrm.get_information_from_filename(Dirfilename: string);
 var r :integer;
  f:tsearchrec;
  var s:string;
begin
   pathstring:= ExtractFilePath(Dirfilename);
   dirstring:=Dirfilename;
   //搜索相关文件后缀
   filetype:='.rtf';
   if self.TVW_dir.Items.Count >0 then
   begin
      r:=findfirst(pathstring+'*.*',faanyfile,f);
      while r=0 do
      begin
        s:=f.Name;
        if ExtractFileExt(s )<>'.ebook' then
        begin
          s:=copy(s,1,length(s)-length(ExtractFileExt(s )));
          if self.TVW_dir.Items.Item [0].Text =s then
          begin
            filetype:=ExtractFileExt(f.Name );
            break;
          end;
         end;
        r:=findnext(f);
      end;
  end;
end;

procedure Tmainfrm.FormCreate(Sender: TObject);
begin

///////
self.LruMm:=TLruMm.Create(self.Handle,self.MMLastfiles ,10,true);

/////////////////
self.FCfgFile := ExtractFilePath(application.ExeName)+ 'lastfiles.ini';
self.LruMm.LoadFromIniFile(self.FCfgFile);
PLCon:=TPlconversion.Create ;
FPLConfigFileName:=ExtractFilePath(paramstr(0))+'PLconfig.ini';
self.LoadMmPLName(self.FPLConfigFileName ,self.MmPLconfig );
self.Setinterface(false);
filelist:=Tstringlist.Create;

self.tbnPrev.Hint :=self.tbnPrev.Hint +#13+'ctrl+alt+W';
self.tbnNext.Hint :=self.tbnNext.Hint +#13+'ctrl+alt+S';
self.TBnCreateFileFromClipboard.Hint :=self.TBnCreateFileFromClipboard.Hint +#13+'ctrl+D';

filetype:='.rtf';

self.LoadFromReg ;

ForMatFont:=TFont.Create ;
DragAcceptFiles(self.Handle,True);//注册可拖放!
end;






procedure Tmainfrm.FormDestroy(Sender: TObject);
begin

///////
while self.MmPLconfig.Count >2 do
begin
  self.MmPLconfig.Delete(self.MmPLconfig.Count -1);
end;
PLCon.Free ;
ForMatFont.Free ;
end;

procedure Tmainfrm.add_a_file(sourcenode: TTreenode;
  Method: TNodeAttachMode);
var filename :string;
var showmsg:string;
begin
  self.save_file(self.TVW_dir.Selected );
  case Method of
    naadd:   showmsg:='添加新文件';
    nainsert:   showmsg:='插入新文件';
    naAddChildFirst:showmsg:='添加新的子文件';
    else showmsg:='创建新文件';
  end;
  filename:='';
  self.showMsg(showmsg,'');
  if self.get_new_filename(filename,showmsg) then
  begin
    tvw_dir.Select(self.TVW_dir.Items.AddNode(
                   nil,sourcenode,filename,nil,method));

    self.set_node_image(tvw_dir.Selected );
    self.ret_show.Clear ;
    file_ischange:=false;
    self.save_file_without_message(self.TVW_dir.Selected );

    lastnode:=self.TVW_dir.Selected ;
    file_ischange:=false;
    self.showMsg(showmsg,filename+filetype);
    tvw_dir.Refresh ;
  end;

end;

procedure Tmainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    self.save_file(self.TVW_dir.Selected );
    self.save_dir;
    self.SaveToReg ;
    self.LruMm.SaveToIniFile(self.FCfgFile );
    DragAcceptFiles(self.Handle ,false);
end;

procedure Tmainfrm.open_dir(dir_name:string);
var i:integer;
var f:integer;
begin
  try
   self.forWait ;

   // f 用来测试 dir_name 是否可以打开 !@@@
   //
   f:=FileOpen(dir_name, fmOpenWrite)  ;
   if f>0 then
   begin
            Fileclose(f);  //关闭f


            self.showdir ;
            self.showMsg('打开目录文件',dir_name);
            self.save_dir ;
            self.save_file(self.TVW_dir.Selected );


            //加载
            try
             self.TVW_dir.Items.BeginUpdate ;
              ///////////////////////////////
              ///// 如果 dir_name 被的程序占用则会出现异常
              // 问题经常出现在打开对话框时
              /////////////////////////////////
             self.TVW_dir.LoadFromFile(dir_name);
             self.TVW_dir.Items.EndUpdate ;
             self.LruMm.AddMI(dir_name);

            self.get_information_from_filename(dir_name);
            self.SetPLMsg ;

            //设置节点图标
            for i:=0 to self.TVW_dir.Items.Count -1 do