ebookfrm.pas

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

     showmessage('目录文件不存在!');
   end;
end;

procedure Tmainfrm.FindDialogFind(Sender: TObject);
begin
  self.find_text_key :=self.FindDialog.FindText ;
   if self.FindDialog.Tag =0 then  //  '查找字符串 :在当前文件中'
   begin
      self.showMsg('查找字符串','在当前文件中');
      self.find_text_key :=self.FindDialog.FindText ;
     if (self.find_text =false)then
       messagebeep(0);
   end
   else
     self.find_text_in_all_file ;
end;

procedure Tmainfrm.PLToRtfWithStrings;
  var  list:Tstringlist;
    temp_file_ischange:boolean;
begin
    temp_file_ischange:=file_ischange;

    list:=Tstringlist.Create ;
    try
    plcon.Clear ;
    list.Assign(Tstrings(self.ret_show.Lines) );
    list.SaveToStream(Plcon);

    plcon.ReretRtf ;
    self.ret_show.Lines.LoadFromStream(PLcon);
    file_ischange:=temp_file_ischange;
    finally
      list.Free ;
    end;
end;

function Tmainfrm.save_file_without_message(sourceNode: TTreenode):boolean;
var StringList:Tstringlist;
    filename:string;
begin
if (sourceNode<>nil) and (self.GetFileName(sourcenode.Text ,filename) ) then
begin
  if self.filetype <>'.rtf' then
  begin
    stringlist:=Tstringlist.Create ;
    try
    /////取消自动换行
      if self.ret_show.WordWrap =false then
      begin
         stringList.AddStrings(Tstrings(self.ret_show.Lines )) ;
         stringlist.SaveToFile(filename);
      end
      else
      begin
        self.ret_show.WordWrap :=false;
           stringList.AddStrings(Tstrings(self.ret_show.Lines )) ;
           stringlist.SaveToFile(filename);
        self.ret_show.WordWrap :=true;
      end;
    finally
      stringlist.Free;
    end;
  end
  else
    self.ret_show.Lines.SaveToFile(filename);
  file_ischange:=false;
  result:=true;
end
else
  result:=false;
end;

procedure Tmainfrm.MmPLconfigClick(Sender: TObject);
var i:integer;
    PLName:string;
begin
  PLName:=self.PLCon.PLName ;
  if PLName<>'' then
    self.DEL_PL_cfg.Enabled  :=true
  else
    self.DEL_PL_cfg.Enabled  :=false;
  for i:=2 to self.MmPLconfig.Count -1 do
  begin
    if  (self.MmPLconfig.Items[i]) is  TMIStr then
    begin
      if PLname=TMIStr((self.MmPLconfig.Items[i])).str  then
        self.MmPLconfig.Items[i].Checked :=true
      else
        self.MmPLconfig.Items[i].Checked :=false;
    end;
  end;

end;

procedure Tmainfrm.DEL_PL_cfgClick(Sender: TObject);
begin
    self.PLcon.reset ;
end;

function Tmainfrm.GetFileName(const text: string;
  var fileName: string): boolean;
begin
if DirectoryExists(pathstring)then
begin
  fileName:=self.pathstring+text+self.filetype ;
  result:=true;
end
else
  result:=false;
end;

procedure Tmainfrm.CreateDir(DirFileName:string);
begin

     self.save_dir ;
     self.save_file(self.TVW_dir.Selected );

     //界面和参数初始化!
     TVW_dir.Items.Clear ;
     self.get_information_from_filename (Dirfilename);
     mkdir(pathstring);
     self.ret_show.Clear ;

     //创建最初节点!
     self.TVW_dir.Select ( self.TVW_dir .Items.Add(nil ,
                          copy(ExtractFileName(dirfilename),
                            1,length(ExtractFileName(dirfilename))-6)));
     self.save_file_without_message(self.TVW_dir.Selected );
     file_ischange:=false;
     TVW_dir.SaveToFile(Dirfilename );
     self.showMsg('创建目录文件',Dirfilename);
     //重新打开
     self.open_dir(dirfilename);
     self.showMsg('创建目录文件',Dirfilename);


end;

procedure Tmainfrm.forRun;
begin
    self.TVW_dir.Cursor  :=crdefault;
    self.ret_show.Cursor  :=crdefault;
end;

procedure Tmainfrm.forWait;
begin
    self.TVW_dir.Cursor  :=crHourGlass;
    self.ret_show.Cursor  :=crHourGlass;
end;

procedure Tmainfrm.PLToPtfWithFile(filename: string);
begin
   plcon.Clear ;
   plcon.LoadFromFile(filename);
   plcon.ReretRtf ;
   self.ret_show.Lines.LoadFromStream(PLcon);

end;

procedure Tmainfrm.SetPLMsg;
var
   IniFile: TIniFile;
   PLname:string;
begin
  if not fileexists(self.FPLConfigFileName ) then
  begin
    self.saveDefaultPLMsgs ;
  end;
  PLcon.reset ;
  IniFile:=TIniFile.Create(self.FPLConfigFileName );
    try
      if FileExists(self.FPLConfigFileName ) then
      begin
        PLname:=inifile.ReadString('link',filetype,'');
        if PLName<>'' then
        begin
           self.PLcon.loadfromInifile(FPLconfigfilename,PLName);

           ///自动换行为false
           //对于程序源码而言,自动换行没有多少意义
           self.ret_show.WordWrap :=false;
        end
        else
        begin
          //自动换==true
          self.ret_show.WordWrap :=true;
        end;
      end
      else
      begin
      end;
    finally
      inifile.Free ;
    end;
end;

procedure Tmainfrm.LoadMmPLName(inifilename: string; ParentMm: Tmenuitem);
var Inifile:Tinifile;
var word,PLnames:string;
    i,PLNamesLen:integer;
var newPLMm:TMIStr;
begin
  if not fileexists(inifilename) then
  begin
    self.saveDefaultPLMsgs ;
  end;
  inifile:=Tinifile.Create(inifilename);
  try
    plnames:=inifile.ReadString('PLName','Name' ,'');
    if PLNames<>'' then
    begin
      PLNames:=PLnames+' ';
      PLNamesLen:=length(PLNames);
      word:='' ;
      for i:=1 to PLNamesLen do
      begin
        if PLNames[i]<>' 'then
           word:= word+PLnames[i]
        else
        begin
          if word<>'' then
          begin
              newPLMm:=TMIStr.Create(parentMm);
              newPLMm.str :=word;
              newPLMm.Caption :=word;
              newPLMm.OnClick :=self.PLMmClick;
              ParentMm.Add(newPLMM);
              word:='';
          end;
        end;
      end;
    end;

  finally
    inifile.Free ;
  end;
end;

procedure Tmainfrm.PLMmClick(Sender: TObject);
begin
if sender is TMIStr then
begin
  self.forWait ;
  try

   self.PLcon.loadfromInifile(self.PLconfigfile ,(sender as TMIStr).str );

   self.PLToRtfWithStrings;
  finally
   self.forRun;
  end;
end;
end;

procedure Tmainfrm.Setinterface(hasDir:boolean);
begin

  self.Mmsearch.Enabled :=hasDir;
  self.Mmedit.Enabled :=hasDir;
  self.TVW_dir.Enabled :=hasDir;

  self.Tbdir.Enabled :=hasDir;
  self.TbShow .Enabled :=hasDir;

  self.ret_show .Enabled :=hasDir;
  self.ToolButton13.Enabled :=hasDir;
  self.ToolButton14.Enabled :=hasDir;
  self.ToolButton15.Enabled :=hasDir;
  self.ToolButton16.Enabled :=hasDir;
  self.ToolButton18.Enabled :=hasDir;
  self.ToolButton3.Enabled :=hasDir;
  self.ToolButton11.Enabled :=hasDir;
  self.ToolButton12.Enabled :=hasDir;
  self.ToolButton4.Enabled :=hasDir;
 
  self.PclOperation.Enabled :=hasdir;
  ///////
  self.PclOperation.ActivePageIndex :=0;
  self.Lbx_searchfile.Clear ;
end;

procedure Tmainfrm.saveDefaultPLMsgs;
var Inifile:Tinifile;
  procedure savePLmsg(PLname,keys,comments,symbols:string;
            isUpLow:boolean;stringsybol:char;
            keyCl,commentCl,stringCl,NumberCl:Tcolor  );
  begin
      inifile.Writebool(PLname,'isUpLow',isUpLow);
      inifile.WriteString(PLname,'keys',keys) ;
      inifile.WriteString(PLname,'comments',comments) ;
      inifile.WriteString(PLname,'symbols',symbols) ;
      inifile.WriteString(PLname,'stringsymbol',stringsybol) ;
      //Color
      inifile.WriteInteger(PLname,'keycolor',keyCl) ;
      inifile.WriteInteger(PLname,'commentcolor',commentCl) ;
      inifile.WriteInteger(PLname,'stringcolor',stringCl) ;
      inifile.WriteInteger(PLname,'numbercolor',NumberCl) ;
  end;
begin
    inifile:=Tinifile.Create(PLconfigfile);
    try
      inifile.WriteString('PLName','Name','pascal c\c++');
      inifile.writeString('PLName','linkfiles','.h .cpp .c .pas');
      savePLMsg('pascal',getpascalKeys,'{ } // NULL (* *)',getpascalSymbols,
             false,'''',clDefault,$800000,$800000,$800000);
      savePLMsg('c\c++',getcPPKeys,'/* */ // NULL',getcPPSymbols,
             true,'"',clGreen,$800000,clFuchsia,clFuchsia);
      inifile.WriteString('link','.h','c\c++');
      inifile.WriteString('link','.c','c\c++');
      inifile.WriteString('link','.cpp','c\c++');
      inifile.WriteString('link','.pas','pascal');
    finally
      inifile.Free ;
    end;
end;

procedure Tmainfrm.showMsg(Msg1, Msg2: string);
begin
  self.Sbr_show.Panels.Items[2].Text :=msg1;
  self.Sbr_show.Panels.Items[3].Text :=msg2;
end;

procedure Tmainfrm.MmOptionClick(Sender: TObject);
begin
///////////////////////////////////////////////////////////////
//   配置界面
 if pathstring='' then
 begin
    self.MMSearchFils.Enabled :=false ;
    self.MmPLconfig.Enabled :=false;
 end
 else
 begin
    self.MMSearchFils.Enabled :=true;
    self.MmPLconfig.Enabled :=true;
 end;
end;

procedure Tmainfrm.MM_CreateFileFromClipboardClick(Sender: TObject);
begin
  try
    self.forWait ;
    self.creat_file_from_Clipboard(self.TVW_dir.Selected );
  finally
    self.forRun;
  end;
end;

procedure Tmainfrm.Ebook1Click(Sender: TObject);
var FrmfileMOve:TfileSearch ;
begin
   FrmfileMOve:=TfileSearch.Create(nil);
   try
    FrmfileMOve.ShowModal ;
   finally
     FrmfileMOve.Free ;
   end;
end;

procedure Tmainfrm.N9Click(Sender: TObject);
 var aboutfrm: TAboutBox;
begin
  aboutfrm:= TAboutBox.Create (self);
  try

    aboutfrm.ShowModal ;
  finally
    aboutfrm.Free;
  end;
end;

procedure Tmainfrm.showdir;
begin
  if self.PclOperation .Width =0 then
      self.Splitter1.Left:=100;
end;



procedure Tmainfrm.PnlKeywordResize(Sender: TObject);
begin
// self.SbnKeyword.Left :=self.PnlKeyword.Width -self.SbnKeyword.Width-3;
 self.EdtKeyword.Width :=self.PnlKeyword.Width -self.lblKeyword.Width
                 -self.PNlopeation.Width ;

end;

procedure Tmainfrm.dealsearchfileMsg(var msg: Tmessage);
begin
//     0 , 0 :开始                            //
//     1 , n  :现在搜索到第n 个了             //
//     2 , n  :第n个符合条件                  //
//     3 , 0 :  结束                          //
  case msg.WParam of
    0: begin
     //   self.PnlShowProgress.Visible :=true;
       end;
    1: begin
       self.Pbr_searchfile.Position := msg.Lparam;
       end;
    2: begin
         self.Lbx_searchfile.Items.Add(self.filelist.Strings[msg.Lparam]);
       end;
    3: begin

        //允许进行搜索
        self.Pbr_searchfile.Position :=0;
        self.SbnKeyword.Enabled :=true;
       // self.PnlShowProgress.Visible :=false;
       end;
  end;

end;

procedure Tmainfrm.SbnKeywordClick(Sender: TObject);
var i:integer;
   endvalue:integer;
   st:TsearchKeyThread;
   Key:string;
begin
  Key:= self.EdtKeyword.Text ;

  if trim(key)<>'' then
  begin
    self.FindDialog.CloseDialog ;
    endvalue:= self.TVW_dir.Items.Count-1 ;
    filelist.Clear ;
    self.Lbx_searchfile.Clear ;
    self.find_text_key := Key;
    for i:=0 to endvalue  do
    filelist.Add(self.TVW_dir.Items.Item[i].Text) ;
    self.SbnKeyword.Enabled :=false;
    self.Pbr_searchfile.Max :=self.filelist.Count ;

    //启动搜索线程
    st:=TsearchKeyThread.Create( self.find_text_key,filelist,
                       self.pathstring ,self.filetype ,
                       self.Cbx_sensitivity.Checked ,self.Handle );
    st.FreeOnTerminate :=true;
    st.Resume ;

 end
 else
 begin
   showmessage('关键字不允许为空!');
 end;
end;

procedure Tmainfrm.Lbx_searchfileClick(Sender: TObject);
var i:integer;
     selectIndex:integer;
     fname:string;
begin
   selectindex:=-1;


 for i:=0 to self.Lbx_searchfile.Items.Count -1 do
 begin
   if self.Lbx_searchfile.Selected[i]then
   begin
     selectindex:=i;
     break;
   end;
 end;
 if selectindex<>-1 then
 begin
    fname:=self.Lbx_searchfile.Items.Strings[selectindex];
    for I:=0 to self.TVW_dir.Items.Count -1 do
    begin
      if self.TVW_dir.Items.Item[i].Text =fname then
      begin

        self.MM_findall.Click ;
        self.open_file(self.TVW_dir.Items[i]);
        break;
      end;
    end;
 end;

end;
 procedure Tmainfrm.EdtKeywordKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
//转移焦点
begin
  self.SbnKeyword.Click ;
end;
end;

procedure Tmainfrm.FindDialogShow(Sender: TObject);
begin
self.FindDialog.Left :=self.Left +self.Width-432;
self.FindDialog.Top :=self.Top+self.Height -185;
end;

function Tmainfrm.getTreenodeIndex(startindex:integer;nodetext: string): integer;
var i,endvalue:integer;
begin
  result:=-1;
  endvalue:=self.TVW_dir.Items.Count -1 ;
  for i:=startindex to endvalue do
  begin
   if self.TVW_dir.Items[i].Text =nodetext then
   begin
     result:=i;
     break;
   end;
  end;
end;

procedure Tmainfrm.N29Click(Sender: TObject);
var fileischange:boolean;
begin
fileischange:=self.file_ischange ;
self.ret_show.WordWrap  :=not self.ret_show.WordWrap;
self.file_ischange :=fileischange;
end;

procedure Tmainfrm.dealMiOnclick(var msg: Tmessage);
var DirName:string;
begin
    if self.LruMm.GetCurrentStr(dirName)then
    self.open_dir(dirName);
end;

procedure Tmainfrm.ToolButton3MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
 //self.TbShow.Hint :=(sender as TToolButton).Hint;
end;

end.