ebookfrm.pas

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

              self.set_node_image(self.TVW_dir.Items [i]);
            self.TVW_dir.Refresh ;

            self.Setinterface(true);

            lastnode:=nil;
            if self.TVW_dir.Items.Count >0 then
            begin
               self.open_file(self.TVW_dir.Items [0]);
            end
            else
              showmessage('文件不存在');

            except
              showmessage('无法读取该文件,可试一下重新打开');
            end;
   end
   else
     self.LruMm.DeleteMI(dir_name);
  finally
   self.forRun;
  end;

end;

function Tmainfrm.save_dir:boolean;
begin
   try
     if fileexists(dirstring) then
     begin
       self.TVW_dir.SaveToFile(dirstring);
       result:=true;
     end
     else result:=false;
   except
     result:=false;
   end;


end;

procedure Tmainfrm.save_file(sourceNode:TTReenode);
begin
  if file_ischange and (sourcenode<>nil) then
  begin
    if fileexists( dirstring) then
    begin
      if MessageDlg('当前的<<'+sourceNode.Text +'>>文本要保存吗?',
       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      begin
        self.save_file_without_message(sourceNode);
      end;
    end
    else
      showmessage('文件不存在!!!');
  end;
end;

procedure Tmainfrm.FormShow(Sender: TObject);
var DirName:string;
begin

  self.file_link ;
  if self.LruMm.GetCurrentStr(dirName) then
  begin
    self.open_dir(dirName);
  end;
  file_ischange:=false;

end;

procedure Tmainfrm.ret_showChange(Sender: TObject);
begin
file_ischange:=true;
end;

procedure Tmainfrm.open_file(sourceNode: TTReenode);
var filename:string;
var fontFormat:boolean;
var tempNode:TTreenode;
    nodePath:string;
begin
   FontFormat:=self.IsInFormatFont ;
   if (sourcenode<>nil ) then
   begin
   try

     self.forWait ;
     self.save_file(lastnode);
     file_ischange:=false;//

     filename:=pathstring+sourcenode.Text+filetype;

     if fileexists(filename) then
     begin

        self.IsInFormatFont :=false;
        lastnode:=sourcenode;   // lastnode:=self.TVW_dir.Selected ;
        self.TVW_dir.Selected :=lastnode;
 ////////////////////////////////////////////////////////////////////////////
// 获取节点在树中的位置
      nodepath:='';
      tempnode:=sourcenode;
       while(tempnode<>nil)do
       begin
         nodepath:='\'+tempnode.Text+nodepath;
         tempnode:=tempnode.Parent ;
       end;
       nodepath:=' 位置:'+nodepath+self.filetype ;
        self.showMsg('打开文件',nodepath);
  ///////////////////////////////////////////////////////////////////////////
        if self.PLcon.ReallyGo then
        begin
          if ansilowercase(fileType)='.rtf' then
          begin
            self.ret_show.Lines.LoadFromFile(filename);
            self.PLToRtfWithStrings ;
          end
          else//非rtf
            self.PLToPtfWithFile(filename);
        end
        else
           self.ret_show.Lines.LoadFromFile(filename);

        self.TVW_dir.Select  (sourcenode);

        //显示文件的前面部分
        self.ret_show.SelStart :=0;
        ret_show.Perform(EM_SCROLLCARET, 0, 0);
     end
     else
        begin
         self.del_a_file(sourcenode) ;
        end;

   finally
    self.forRun ;
    self.IsInFormatFont :=FontFormat;
    if FontFormat then
      self.ret_show .Cursor  :=crhandpoint;
    file_ischange:=false;
   end;
  end;

end;



procedure Tmainfrm.ToolButton9Click(Sender: TObject);
begin
 self.open_file(self.TVW_dir.Selected.GetPrev  );
 self.showdir ;
end;

procedure Tmainfrm.TbnNextClick(Sender: TObject);
begin
 self.open_file(self.TVW_dir.Selected.Getnext  );
  self.showdir ;
end;

procedure Tmainfrm.TVW_dirClick(Sender: TObject);
begin
 if self.TVW_dir.Selected <>lastnode then
 self.open_file(self.TVW_dir.Selected );
end;

procedure Tmainfrm.MMSearchFilsClick(Sender: TObject);
var
  findcount,i,r:integer;
  f:tsearchrec;
  FileList:TStringList;
  FileTypeLength:integer;
  s:string;
begin
  FileList:=TStringList.Create ;
try
  try
     //设置文件后缀
      if self.TVW_dir.Items.Count =0 then
      begin
        self.showMsg('搜索文件','设置文件后缀');
        if not InputQuery('您正在设置文件后缀...  ','输入后缀:   ',filetype)then
           exit;//退出该过程
        s:=AnsiLowerCase(Trim(filetype));
        if s[1]<>'.' then  filetype:='.'+s
        else filetype:=s;
      end;
      FileTypeLength:=length(FileType);
      //加载 TVW_dir 数据 并排序
     Filelist.Sorted :=false;
     for i:=0 to self.TVW_dir.Items.Count -1 do
     begin
        filelist.Add(self.TVW_dir.Items[i].Text+filetype);
     end;
     filelist.Sorted :=true;
    findCount:=0;
    self.showMsg('搜索文件','查找中....');
    application.ProcessMessages ;
    //查找, 匹配, 加入
     r:=findfirst(pathstring+'*'+filetype,faanyfile,f);
     while r=0 do
     begin
        if  not FileList.Find(f.Name ,i) then
        begin
          self.set_node_image(TVW_dir.Items.Add(TVW_dir.Selected ,
          copy(f.Name,1,length(f.Name )-FileTypeLength)));
          self.showMsg('搜索文件','找到: '+f.Name);
          application.ProcessMessages ;
          inc(findCount);
        end;
        r:=findnext(f);
     end;
     self.showMsg('搜索文件','查找完毕,找到文件个数: '+inttostr(findCount));

     TVW_dir.Refresh ;

  except

     showmessage('文件不存在!!!');
  end;
finally
     FileList.Free;
end;
end;

procedure Tmainfrm.BTn_add_FileClick(Sender: TObject);
begin
 self.add_a_file(self.TVW_dir.Selected,naadd);
end;

procedure Tmainfrm.btn_add_Chlid_FileClick(Sender: TObject);
begin
  self.add_a_file(self.TVW_dir.Selected,naaddchildfirst);
  self.set_node_image(self.TVW_dir.Selected.Parent );
end;

procedure Tmainfrm.btn_insert_fileClick(Sender: TObject);
begin
  self.add_a_file(self.TVW_dir.Selected,nainsert);
end;

procedure Tmainfrm.del_a_file(sourcenode: TTreenode);
var source_parentNode:TTreeNode;
begin
if sourcenode<>nil  then
begin
if not sourcenode.HasChildren then
begin
  if sourcenode=cut_node then
   cut_node:=nil;

  if fileexists(pathstring+sourcenode.Text+filetype) then
  begin
      if MessageDlg('你正在永久删除目录'+#13#10+'及其相应的文档!继续吗?',
           mtConfirmation, [mbYes, mbNo], 0) = mrYes then
       begin
           DeleteFile(pathstring+sourcenode.Text+filetype);
           source_parentNode:=sourcenode.Parent ;
           self.TVW_dir .Items.Delete(sourcenode);
           self.set_node_image(source_parentNode);
           lastnode:=nil;
       end;
  end
  else
  begin
      showmessage('抱歉!文件不存在!!!'+#13+'该节点将被删除!');
      DeleteFile(pathstring+sourcenode.Text+filetype);
      source_parentNode:=sourcenode.Parent ;
      self.TVW_dir .Items.Delete(sourcenode);
      self.set_node_image(source_parentNode);
  end;
end
else
begin
  if fileexists(pathstring+sourcenode.Text+filetype) then
       showmessage('抱歉!不支持父节点删除!!!')
  else
  begin
     showmessage('抱歉!文件不存在!!!'+#13
                      +'但不支持父节点删除!'+#13
                      +'将创建相应文件');
     self.ret_show.Clear ;
     file_ischange:=false;
     self.ret_show.Lines.SaveToFile(pathstring+sourcenode.Text+filetype);
     self.open_file(sourceNode);
  end;

end;
end;

end;

procedure Tmainfrm.rename_a_file(sourcenode: TTreenode);
var old_filename,new_filename:string;
begin
   old_filename:=pathstring+sourcenode.Text +filetype;

   if fileexists(old_filename) then
   begin
       new_filename:=sourcenode.Text ;
      if self.get_new_filename(new_filename,
                 '重命名文件:'+sourcenode.Text )then
      begin
        renamefile(old_filename,pathstring+new_filename +filetype);
        sourcenode.Text :=new_filename;
      end;
   end
   else
   begin
      self.del_a_file(sourcenode) ;
   end;
end;

procedure Tmainfrm.btn_rename_fileClick(Sender: TObject);
begin
self.rename_a_file(self.TVW_dir.Selected );
end;

procedure Tmainfrm.btn_del_fileClick(Sender: TObject);
begin
  self.del_a_file(self.TVW_dir.Selected );
end;

procedure Tmainfrm.btn_new_dirClick(Sender: TObject);
var Dirfilename:string;
begin
  self.OpenDialog_dir.Title :='将创建相应文件夹和文件';
  self.OpenDialog_dir.Filter :='全部文件|*.*';
  self.OpenDialog_dir.DefaultExt :='';
  self.OpenDialog_dir.FileEditStyle :=fsEdit;
  self.showMsg('创建目录文件');
  if self.OpenDialog_dir.Execute  then
  begin
    Dirfilename:=OpenDialog_dir.FileName+'\'+
                 ExtractFileName(OpenDialog_dir.FileName)+'.ebook';
    self.CreateDir(DirFileName);
  end;
  self.OpenDialog_dir.Title :='';
  self.OpenDialog_dir.Filter :='ebook|*.ebook|全部文件|*.*';
  self.OpenDialog_dir.Title:='';
end;

procedure Tmainfrm.creat_file_from_Clipboard(sourcenode:TTreenode);
var s,nodetext:string;
     i:integer;
begin
   self.save_file(self.TVW_dir.Selected )   ;

   s:='';
   self.ret_show .Clear ;
   self.ret_show.PasteFromClipboard  ;

   //显示文件的前面部分
   self.ret_show.SelStart :=0;
   ret_show.Perform(EM_SCROLLCARET, 0, 0);

   for i:=0 to  self.ret_show.Lines.Count -1 do
      if trim(self.ret_show.Lines.Strings[i])<>'' then
         break;

   if i< self.ret_show.Lines.Count then
          s:=trim(self.ret_show.Lines.Strings[i])
   else
   begin
         showmessage('剪切板中没有可用文档');
         file_ischange:=false;
         exit;
   end;


   //删除非法字符
   nodetext:='';
   for i:=1 to length(s) do
   begin
      if not(s[i]in ['\','/',':','*','?','<','>','|','"']) then
      begin
        nodetext:=nodetext+s[i];
      end;
   end;

  i:=1;
  nodetext:=trim(nodetext);
  if nodetext<>'' then
  begin
   s:=nodetext;
    while fileexists( pathstring+nodetext+filetype) do
    begin
      nodetext:=s+inttostr(i);
      i:=i+1;
    end;
    try
      self.TVW_dir.Select  (self.TVW_dir.Items.Insert(self.TVW_dir.Selected ,
                                                      nodetext));
      self.save_file_without_message (self.TVW_dir.Selected ) ;

      lastnode:=self.TVW_dir.Selected ;
      self.set_node_image(self.TVW_dir.Selected ) ;
      file_ischange:=false;
    except
      showmessage('文件名：'+#13+'  '+nodetext+#13+'不可用!'+#13+'创建失败'  );
    end;


 end
 else
 begin
  showmessage('剪切板中没有可用文档');
  file_ischange:=false;
 end;
end;

procedure Tmainfrm.N15Click(Sender: TObject);
begin
    //向下选择
    self.ret_show .SelLength :=length(self.ret_show .Text )-
                                      self.ret_show .SelStart+1 ;
end;

procedure Tmainfrm.N16Click(Sender: TObject);
var sel_end:integer;
begin
   //向上选择
   sel_end:=self.ret_show .SelStart ;
   self.ret_show .SelStart :=0;
   self.ret_show .SelLength:=sel_end;
end;

procedure Tmainfrm.btn_undoClick(Sender: TObject);
begin
   self.ret_show.Undo ;
end;

procedure Tmainfrm.btn_cutClick(Sender: TObject);
begin
   self.ret_show.CutToClipboard ;
end;

procedure Tmainfrm.btn_copyClick(Sender: TObject);
begin
self.ret_show.CopyToClipboard ;
end;

procedure Tmainfrm.btn_pasteClick(Sender: TObject);
begin
self.ret_show.PasteFromClipboard ;
end;

procedure Tmainfrm.btn_saveClick(Sender: TObject);
begin
 if self.save_file_without_message(self.TVW_dir.Selected ) then
   showmessage('保存成功!')
 else
   showmessage('保存失败!');
end;

procedure Tmainfrm.btn_selectAllClick(Sender: TObject);
begin
   self.ret_show.SelectAll ;
end;

procedure Tmainfrm.btn_readonlyClick(Sender: TObject);
begin
  btn_readonly.Checked :=not btn_readonly.Checked ;
  self.ret_show.ReadOnly :=self.btn_readonly.Checked ;
end;

procedure Tmainfrm.btn_seclectfontClick(Sender: TObject);
begin
     with FontDialog.font do
      begin
       Color :=ret_show.SelAttributes.Color ;
       Style := ret_show.SelAttributes.Style ;
       size:=ret_show.SelAttributes.Size ;
       Height:=ret_show.SelAttributes.Height ;
       Charset:=ret_show.SelAttributes.Charset ;
       name:=ret_show.SelAttributes.Name ;
       pitch:=ret_show.SelAttributes.Pitch ;
      end;
 if fontdialog.Execute then
     self.ret_show.SelAttributes.Assign(fontdialog.Font );
end;

function Tmainfrm.find_text:boolean;
const STypes: array[Boolean, Boolean] of TSearchTypes =
  (([],[stMatchCase]),
    ([stWholeWord],[stWholeWord, stMatchCase]));
var Start, len, loc: Integer;
begin

  Start := TRichEdit(ret_show ).SelStart + TRichEdit(ret_show).SelLength;
  len := TRichEdit(ret_show ).GetTextLen - Start;
  loc := TRichEdit(ret_show).FindText(self.find_text_key , Start, len,
  STypes[frWholeWord in Finddialog.Options, frMatchCase in Finddialog.Options]);


  if loc = -1 then
   result:=false
  else
  begin
    TRichEdit(ret_show).SelStart := loc;
    TRichEdit(ret_show).SelLength :=Length(FindDialog.FindText);
    ret_show.Perform(EM_SCROLLCARET, 0, 0);
    result:=true;
  end;
  ret_show.SetFocus ;
end;

procedure Tmainfrm.btn_findClick(Sender: TObject);
begin
  self.FindDialog.FindText :=self.find_text_key ;
  self.FindDialog.Tag :=0;
  self.showMsg('查找字符串');
  finddialog.Execute  ;
 
end;

procedure Tmainfrm.N21Click(Sender: TObject);
begin
  self.FindDialog.FindText :=self.find_text_key ;
if self.FindDialog.FindText <>'' then
begin
   finddialog.Execute  ;
  if (self.find_text =false)then
    messagebeep(0);
end
else
begin
  self.btn_find.Click;
end;
end;

procedure Tmainfrm.btn_format_fontClick(Sender: TObject);
begin
  with ForMatFont do
  begin
    Color :=ret_show.SelAttributes.Color ;
    Style := ret_show.SelAttributes.Style ;
    size:=ret_show.SelAttributes.Size ;
    Height:=ret_show.SelAttributes.Height ;
    Charset:=ret_show.SelAttributes.Charset ;
    name:=ret_show.SelAttributes.Name ;
    pitch:=ret_show.SelAttributes.Pitch ;
    ret_show.Cursor :=crhandpoint;