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

📄 unitformbrowse.pas

📁 图象处理的一些相关内容 不是很难的,实现简单,希望对大家有帮助
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  //  showmessage(inttostr(key));
    key:=0;
    // showmessage(inttostr(key));

    exit;
  end;
}
  if (not IsRefreshImageFinshi) then

  //if not self.Enabled then
  key:=0;


end;

procedure TFormBrowse.ListView2DblClick(Sender: TObject);
var
  FileName:string;
  FolderName:string;
//  TxtFileName:string;
//  HtmFileName:string;
//  PasFileName:string;
  str:string;
//  Node: TTreeNode;
begin
  if ListView2.SelCount=0 then exit;
  str:=OtherFileList.Strings[ListView2.Selected.Index];
    //截去前面两个标志字符
  case str[1] of
    '0':   //文件夹
      begin
        FolderName:=copy(str,3,length(str)-2);
        //showmessage('1'+FolderName);
        if RightStr(FolderName,2)='..' then
        begin
          FolderName:=copy(FolderName,1, LastDelimiter('\',FolderName)-1);
          FolderName:=copy(FolderName,1, LastDelimiter('\',FolderName)-1);
          //showmessage('2'+FolderName);
          ShellTreeView1Change2(FolderName);

        end
        else if RightStr(FolderName,1)='.' then
          exit
          else
            ShellTreeView1Change2(FolderName);

      end;
    '1':    //文本文件
      begin
        FileName:=copy(str,3,length(str)-2);
      //  showmessage(FileName);
        FormWebBrowser.URLs.Text:=FileName;
        FormWebBrowser.WindowState:=wsMaximized;
        FormWebBrowser.Show;
        FormWebBrowser.WebBrowser1.SetFocus;

        FormWebBrowser.FindAddress;


      end;

    '2':    //html文件
      begin
        FileName:=copy(str,3,length(str)-2);
        //showmessage(FileName);
        FormWebBrowser.URLs.Text:=FileName;
        FormWebBrowser.WindowState:=wsMaximized;
        FormWebBrowser.Show;
        FormWebBrowser.WebBrowser1.SetFocus;
        FormWebBrowser.FindAddress;

      end;

    '3':    //.pas文件
      begin
        FileName:=copy(str,3,length(str)-2);
        if MenuHtmlParser.Checked then
        begin
          try
            Parser:=TPas2html.Create;
            Parser.SetSrcFileName(FileName);
            Parser.SetDesFileName(AppPath+'pashtm.htm');

            ProgressBar1.Visible:=true;
            screen.Cursor:=crHourGlass;

            Parser.Convert(ProgressBar1);
            screen.Cursor:=crDefault;
            ProgressBar1.Visible:=false;

            FormWebBrowser.URLs.Text:=AppPath+'pashtm.htm';;
            FormWebBrowser.WindowState:=wsMaximized;
            FormWebBrowser.Show;
            FormWebBrowser.WebBrowser1.SetFocus;
            FormWebBrowser.FindAddress;
          finally
            Parser.Free;
          end;
        end
        else if MenuXmlParser.Checked then
        begin
          try
            Parser:=TPas2xml.Create;
            Parser.SetSrcFileName(FileName);
            Parser.SetDesFileName(AppPath+'pasxml.xml');

            ProgressBar1.Visible:=true;
            screen.Cursor:=crHourGlass;

            Parser.Convert(ProgressBar1);
            screen.Cursor:=crDefault;
            ProgressBar1.Visible:=false;

            FormWebBrowser.URLs.Text:=AppPath+'pasxml.xml';;
            FormWebBrowser.WindowState:=wsMaximized;
            FormWebBrowser.Show;
            FormWebBrowser.WebBrowser1.SetFocus;
            FormWebBrowser.FindAddress;
          finally
            Parser.Free;
          end;
        end;

      //  showmessage(FileName);
        {
        try
          Parser:=TPas2Htm.Create;
          Parser.SetFileName(FileName);
          Parser.AddHtmlHead;
          ProgressBar1.Visible:=true;
          ProgressBar1.Position:=0;
          screen.Cursor:=crHourGlass;
          Parser.Convert;
          ProgressBar1.Visible:=false;
          screen.Cursor:=crDefault;

          FormWebBrowser.URLs.Text:=AppPath+'pashtm.htm';;
          FormWebBrowser.WindowState:=wsMaximized;
          FormWebBrowser.Show;
          FormWebBrowser.WebBrowser1.SetFocus;
          FormWebBrowser.FindAddress;

        finally
          Parser.Free;
        end;     }
      end;
    '4','5':
      begin
        FileName:=copy(str,3,length(str)-2);
        FormExtractIco.ExtractAndShowIco(FileName,ProgressBar1);
        FormExtractIco.Show;
      end;
    '6':
      begin
        if not IsRefreshImageFinshi then exit;
        FileName:=copy(str,3,length(str)-2);

        try
          if IsRequrePassWord(FileName) then
          begin
            FormPassword.EditPassword.Text:='';
            FormPassword.ShowModal;
            if FormPassword.IsCancel then
              exit;

            //FormPassword.EditPassword.SetFocus;

            if not IsCorrectPassWord(FileName,FormPassword.EditPassword.Text) then
            begin
              showmessage('密码错误!');
              exit;
            end;

          end;
        except
          MessageDlg('该文件可能已经被损坏!',mtError,[mbOk],0);
          exit;

        end;
           //FormPassword.Password EditPassword
        //FormPassword.

        IsReadStructureStorageFileMode:=true;

        AddThumbFromStructureStorageFileToImageListAndListView(FileName,ImageList1,ListView1);

        //showmessage('this is a page file!');

      end;


  end;//end case


end;

procedure TFormBrowse.ShellTreeView1Change2(dir:string);

 // dir:string;
begin
  if not IsRefreshImageFinshi then exit;
//  dir:=ShellTreeView1.Path;

  edit1.Text:=dir;

  if not (DirectoryExists(dir)) then exit;

  //如果是c:\ d:\之类则转换为c: d:
  if dir[length(dir)]='\' then
    delete(dir,length(dir),1);

  ImageFileList.ChangeDir(dir);

  StatusBar1.Panels[0].Text:='当前文件夹共有图片:'+inttostr(ImageFileList.GetFileCount)+'张';
  //StatusBar1.Panels[1]
  //showmessage(inttostr(ImageFileList.GetFileCount));

  screen.Cursor:=crHourGlass;

  //self.SetFocus;
  self.Enabled:=false;
  RefreshImage;


  self.Enabled:=true;
  screen.Cursor:=crDefault;

end;



procedure TFormBrowse.Button1Click(Sender: TObject);
begin
//  SpeedButtonFolderTree.Down:=true;
end;

procedure TFormBrowse.FormResize(Sender: TObject);
begin
  edit1.Left:=ToolButton4.Left+ToolButton4.Width;
  edit1.Width:=ToolBar1.Width-ToolButton4.Width*4-3;

end;

procedure TFormBrowse.ToolButtonFoldeTreeClick(Sender: TObject);
begin
  MenuFolderTreeClick(nil);
//
end;

procedure TFormBrowse.ToolButtonFileAreaClick(Sender: TObject);
begin
  MenuFileAreaClick(nil);
//
end;

procedure TFormBrowse.ToolButtonPreAreaClick(Sender: TObject);
begin
  MenuPreviewAreaClick(nil);
end;

procedure TFormBrowse.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if key=VK_RETURN then
    ListView1DblClick(nil);

end;

procedure TFormBrowse.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
  ImageID:integer;
  i:integer;
  str:string;
begin

  case Tag of
    tgImage:
    begin
      ImageID:= StrToInt(TagParams.Values['ImageID']);
      if  ImageID<=(ImageFileList.GetFileCount-1-CurCreateHtmlPageCount*36) then
      begin
       // showmessage(inttostr(ImageID));
       ImageFileList.SetIndex(CurCreateHtmlPageCount*36+ImageID);
      // ReplaceText:='<a href="file:///'+ CreateHTMLAlbumDir+'/large/'+ImageFileList.GetCurFileName+'">'+#13#10+
       ReplaceText:='<a href="large/'+ImageFileList.GetCurFileName+'">'+#13#10+

      // '<IMG border="0" alt="'+ImageFileList.GetCurFileName+'" src="'+'file:///'+ CreateHTMLAlbumDir+'/small/'+inttostr(CurCreateHtmlPageCount*36+ImageID)+'.bmp" width="80" height="80"></a>';
       '<IMG border="0" alt="'+ImageFileList.GetCurFileName+'" src="small/'+inttostr(CurCreateHtmlPageCount*36+ImageID)+'.bmp" width="80" height="80"></a>';

      end
      else
         ReplaceText:='';
    end

  end; //end case

  if TagString='LinkPage' then
  begin
    if CurCreateHtmlPageCount=0 then
      str:=#13#10+'<p align="center"><span lang="zh-cn">[前一页]</span>'+#13#10
    else
      str:=#13#10+'<p align="center"><span lang="zh-cn"><a href="page'+inttostr(CurCreateHtmlPageCount-1)+'.html">[前一页]</a></span>'+#13#10;

    for i:=0 to CurCreateHtmlPageCount-1 do
      str:=str+'<a href="'+'page'+inttostr(i)+'.html"><u>'+inttostr(i)+'</u></a>'+#13#10;
    str:=str+'<b> '+inttostr(CurCreateHtmlPageCount)+'</b>'+#13#10;

    for i:=CurCreateHtmlPageCount+1 to (ImageFileList.GetFileCount div 36) do
      str:=str+'<a href="'+'page'+inttostr(i)+'.html"><u>'+inttostr(i)+'</u></a>'+#13#10;

    if CurCreateHtmlPageCount=ImageFileList.GetFileCount div 36 then
      str:=str+'<span lang="zh-cn">[下一页]</span></p>'+#13#10
    else
      if (CurCreateHtmlPageCount+1)<=(ImageFileList.GetFileCount div 36) then

    str:=str+'<span lang="zh-cn"> <a href="page'+inttostr(CurCreateHtmlPageCount+1)+'.html">[下一页]</a></span></p>'+#13#10;

    ReplaceText:=str;
  //  showmessage('PageLink');
  end;

end;

procedure TFormBrowse.MenuCreateHTMLAlbumClick(Sender: TObject);
var
  i:integer;
  OldIndex:integer;
  bmp:Tbitmap;
  pSrcFile,pDestFile:pchar;
  FullFileName,FileName:string;
  SaveHTML:Tstrings;

begin
  if (not FileExists(AppPath+'templet.htm')) then
  begin
    MessageDlg('文件templet.htm不存在,无法完成此操作!',mtError,[mbYes],0);
    exit;
  end;


  if SelectDirectory( CreateHTMLAlbumDir,[sdAllowCreate, sdPerformCreate, sdPrompt],0) then
  begin
    PageProducer1.HTMLFile:=AppPath+'templet.htm';
    if  CreateHTMLAlbumDir[length( CreateHTMLAlbumDir)]<>'\' then
      CreateHTMLAlbumDir:= CreateHTMLAlbumDir+'\';

    OldIndex:=ImageFileList.GetIndex;
    CurCreateHtmlPageCount:=0;
    bmp:=Tbitmap.Create;
    bmp.Height:=ImageList1.Height;
    bmp.Width:=ImageList1.Width;
    bmp.PixelFormat:=pf24bit;

    ProgressBar1.Visible:=true;
    ProgressBar1.Max:=ImageFileList.GetFileCount-1;
    for i:=0 to ImageFileList.GetFileCount-1 do
    begin
      ImageList1.Draw(bmp.Canvas,0,0,i,true);
      mkdir( CreateHTMLAlbumDir+'small');
      bmp.SaveToFile( CreateHTMLAlbumDir+'small\'+inttostr(i)+'.bmp');
      ImageFileList.SetIndex(i);
      FileName:=ImageFileList.GetCurFileName;
      FullFileName:=ImageFileList.GetCurFullFileName;
      pSrcFile:=Pchar(FullFileName);
      mkdir( CreateHTMLAlbumDir+'large');

      FileName:= CreateHTMLAlbumDir+'large\'+FileName;
      pDestFile:=Pchar(FileName);

      //CopyFileEx()
      CopyFile(pSrcFile,pDestFile,true);
      ProgressBar1.Position:=i;
    end;

    SaveHTML:=TstringList.Create;
    for i:=0 to (ImageFileList.GetFileCount div 36) do
    begin
      CurCreateHtmlPageCount:=i;
      SaveHTML.Text:=PageProducer1.Content;
      SaveHTML.SaveToFile(CreateHTMLAlbumDir+'page'+inttostr(CurCreateHtmlPageCount)+'.html');
    end;
    bmp.Free;
    SaveHTML.Free;
    ImageFileList.SetIndex(OldIndex);
    ProgressBar1.Visible:=false;
    if MessageDlg('已经成功生成Html相册,是否现在打开?',mtConfirmation	,[mbYes,mbNo],0)=mrYes then
      ShellExecute(handle,'open',nil,pchar(CreateHTMLAlbumDir+'page0.html'),nil,sw_shownormal)

   
    else
     exit;
  end; // if SelectDirectory ..........
end;

procedure TFormBrowse.MenuPlugInsClick(Sender: TObject);
begin
  if IsReadStructureStorageFileMode then
  begin
    MenuCreateHTMLAlbum.Enabled:=false;
    MenuImageEditor.Enabled:=false;
    exit;
  end;
  
  MenuCreateHTMLAlbum.Enabled:=(ImageFileList.GetFileCount>0);
  MenuImageEditor.Enabled:=(listview1.SelCount>0);

 //
end;

procedure TFormBrowse.MenuImageEditorClick(Sender: TObject);
var
  FileName:string;
  i:integer;
  bmp:Tbitmap;
begin

  if (not FileExists(AppPath+'imageeditor.exe')) then
  begin
    MessageDlg('文件imageeditor.exe不存在!不能完成此操作!',mtError,[mbYes],0);
    exit;
  end;

  FileName:=ImageFileList.GetCurFullFileName;

  bmp:=nil;
  if LowerCase(ExtractFileExt(FileName))='.bmp' then
  begin
    bmp:=Tbitmap.Create;
    bmp.LoadFromFile(FileName);
    if bmp.PixelFormat<>pf24bit then
    begin
      MessageDlg('此图片文件不是24位真彩色,不能完成此操作!',mtError,[mbYes],0);
      bmp.Free;
      exit;
    end;
    bmp.Free;
  end;


  for i:=1 to length(FileName) do
    if FileName[i]=#32 then FileName[i]:='?';  //把空格转换为“?”

  ShellExecute(handle,'open',pchar(AppPath+'imageeditor.exe'),pchar(FileName),nil,sw_shownormal);
end;

procedure TFormBrowse.MenuReturnViewModeClick(Sender: TObject);
begin
  ListView1DblClick(nil);
//
end;

procedure TFormBrowse.File1Click(Sender: TObject);
begin
  MenuReturnViewMode.Enabled:=(listview1.SelCount>0);
//
end;

procedure TFormBrowse.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (not IsRefreshImageFinshi) then exit;

  if key=vk_return then
  begin
    if DirectoryExists(edit1.Text) then
      ShellTreeView1Change2(edit1.Text)
    else
    begin
      MessageDlg('您输入的目录不存在!',mtError,[mbYes],0);
      exit;
    end;
  end;
end;

procedure TFormBrowse.ToolButton4Click(Sender: TObject);
begin
  FormFlash.Show;
end;



procedure TFormBrowse.MenuHtmlParserClick(Sender: TObject);
begin
  MenuHtmlParser.Checked:=not MenuHtmlParser.Checked;
  MenuXmlParser.Checked:=not MenuHtmlParser.Checked;


end;

procedure TFormBrowse.MenuXmlParserClick(Sender: TObject);
begin
  MenuXmlParser.Checked:=not MenuXmlParser.Checked;
  MenuHtmlParser.Checked:=not MenuXmlParser.Checked;
end;

end.

⌨️ 快捷键说明

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