unitformbrowse.pas

图象处理的一些相关内容 不是很难的,实现简单,希望对大家有帮助

unit UnitFormBrowse;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, ShellCtrls, ExtCtrls, Menus, jpeg,
  ImgList,commctrl, ToolWin,StrUtils, HTTPApp, HTTPProd,shellapi,FileCtrl;


type
  TFormBrowse = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    ScrollBox1: TScrollBox;
    ShellTreeView1: TShellTreeView;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    ImageList1: TImageList;
    N1: TMenuItem;
    MenuFolderTree: TMenuItem;
    MenuPreviewArea: TMenuItem;
    Image1: TImage;
    ToolBar1: TToolBar;
    Panel2: TPanel;
    ListView1: TListView;
    ListView2: TListView;
    Splitter3: TSplitter;
    ImageList2: TImageList;
    ImageList3: TImageList;
    MenuFileArea: TMenuItem;
    ToolButtonFoldeTree: TToolButton;
    ToolButtonFileArea: TToolButton;
    ToolButtonPreArea: TToolButton;
    ToolButton4: TToolButton;
    Edit1: TEdit;
    PageProducer1: TPageProducer;
    MenuPlugIns: TMenuItem;
    MenuCreateHTMLAlbum: TMenuItem;
    MenuImageEditor: TMenuItem;
    MenuReturnViewMode: TMenuItem;
    N2: TMenuItem;
    MenuHtmlParser: TMenuItem;
    MenuXmlParser: TMenuItem;
    procedure ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListView1Resize(Sender: TObject);
    procedure MenuFolderTreeClick(Sender: TObject);
    procedure MenuPreviewAreaClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure About1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure ShellTreeView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView2DblClick(Sender: TObject);
    procedure MenuFileAreaClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ToolButtonFoldeTreeClick(Sender: TObject);
    procedure ToolButtonFileAreaClick(Sender: TObject);
    procedure ToolButtonPreAreaClick(Sender: TObject);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure MenuCreateHTMLAlbumClick(Sender: TObject);
    procedure MenuPlugInsClick(Sender: TObject);
    procedure MenuImageEditorClick(Sender: TObject);
    procedure MenuReturnViewModeClick(Sender: TObject);
    procedure File1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ToolButton4Click(Sender: TObject);
    procedure MenuHtmlParserClick(Sender: TObject);
    procedure MenuXmlParserClick(Sender: TObject);
  private
    OriginalBmp,ThumbBmp:Tbitmap;
    PreViewBmp:Tbitmap;
    ThumbJpg:TJpegImage;
    PreViewJpg:TJpegImage;
    IsRefreshImageFinshi:boolean;

    CurCreateHtmlPageCount:integer;
    CreateHTMLAlbumDir:string;
    { Private declarations }
  public
    IsReadStructureStorageFileMode:boolean;

    ProgressBar1:TProgressBar;
    procedure RefreshImage;
    procedure ShowPreImageFit(const ImageFileName:string);
    procedure ShellTreeView1Change2(dir:string);
    //procedure AddThumbFromStructureStorageFileToImageListAndListView(AStructureStorageFileName:string;
      //AImageList:TImageList;AListView:TListView);

    { Public declarations }
  end;

type
  TImageFileList=class
  private
    FStrListFile:TStringList;
    FIndex:integer;
    { Private declarations }
  public
    //添加一个文件
    procedure Add(FullFileName:string);

    //清空文件列表
    procedure Clear;

    //删除一个文件
    procedure Delete(Index:integer);

    //当目录改变时，调用此过程会把该目录下所有图片文件
    //添加到文件列表中
    procedure ChangeDir(dir:string);

    //返回文件数目
    function GetFileCount:integer;

    //设置索引
    procedure SetIndex(AIndex:integer);

    //返回文件索引
    function GetIndex:integer;

    //返回当前完整文件名
    function GetCurFullFileName:string;

    //返回当前文件名
    function GetCurFileName:string;

    //返回下一个文件的文件名
    function GetNextFileName:string;

    //返回上一个文件的文件名
    function GetPreFileName:string;

    procedure CopyStrListFile(SrcFileNameList:TStringList);

    constructor Create;
    destructor Destroy; override;
    { Public declarations }
  end;

  procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
  function  IsJpgFile(const FileName:string):boolean;

  //procedure ShowLargeImageFromStructureStorageFile(AStructureStorageFileName,
    //ALargeImageFileName: string; AImage: TImage);

  const
  RaisedPanel=1;
  LoweredPanel=2;

var
  FormBrowse: TFormBrowse;
  ImageFileList:TImageFileList;
  OtherFileList:TStringList;
  AppPath:string;
  SSPJpeg:TJpegImage;

implementation

uses UnitFormView,  UnitFormWebBrowser,UnitParser,UnitPas2Xml,UnitPas2Html,UnitFormFlash,
  UnitFormExtractIco,UnitStructureStorageFile, UnitFormPassWord;
{$R *.dfm}
var
  Parser:TParser;

//在canvas上画一个Panel
procedure DrawPanel(canvas:TCanvas;Left,Top,Width,Height:integer;PanelType:integer);
var
  Right,Bottom:integer;
  LeftTopColor,RightBottomColor:TColor;
begin
  //凸起的panel
  if PanelType=RaisedPanel  then
  begin
    LeftTopColor:=clwhite;
    RightBottomColor:=clgray;
  end
  else //凹下去的panel
  begin

    LeftTopColor:=clgray;
    RightBottomColor:=clwhite;
  end;
      Right:=Left+width;
      Bottom:=Top+Height;

      Canvas.Pen.Width:=1;
      Canvas.Pen.Color:=LeftTopColor;

      Canvas.MoveTo(Right,Top);
      Canvas.lineTo(Left,Top);

      Canvas.LineTo(Left,bottom);

      Canvas.Pen.Color:=RightBottomColor;

      Canvas.lineTo(Right,Bottom);
      Canvas.lineTo(Right,Top);
end;

//转换jpg到bmp
procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
begin
  try
    AJpg.LoadFromFile(JpgFileName);
    Abmp.Assign(AJpg);
  finally
  end;
end;

//仅从扩展名上来判断是否是jpg格式的文件
function  IsJpgFile(const FileName:string):boolean;
begin
  result:=(LowerCase( ExtractFileExt(FileName))='.jpg') or (LowerCase( ExtractFileExt(FileName))='.jpeg');
end;

{ TImageFileList }

procedure TImageFileList.Add(FullFileName: string);
begin
  FStrListFile.Add(FullFileName);
end;

procedure TImageFileList.ChangeDir(dir: string);
var
  SearchRec : TSearchRec;
  Attr : integer;
  Found : integer;
  ExtFileName:string;
  temstr:string;

begin
  clear;
  OtherFileList.Clear;
  temstr:=dir+'\*.*';
  Attr := faAnyFile;
  Found := FindFirst(temstr, Attr, SearchRec);
  while Found = 0 do
  begin
//  SearchRec.Attr
    ExtFileName:=LowerCase(ExtractFileExt(SearchRec.Name));
    if (ExtFileName='.bmp') or (ExtFileName='.jpg') or ((ExtFileName='.jpeg')) then
      Add(dir+'\'+SearchRec.Name)
    else if  SearchRec.Attr=faDirectory then
    begin
      if  not ( (SearchRec.Name[length(SearchRec.Name)]='.') and (SearchRec.Name[length(SearchRec.Name)-1]<>'.' ) ) then
      OtherFileList.Add('0#'+dir+'\'+SearchRec.Name)

    end
      else if (ExtFileName='.txt') then
        OtherFileList.Add('1#'+dir+'\'+SearchRec.Name)
        else if (ExtFileName='.htm') or (ExtFileName='.html') then
          OtherFileList.Add('2#'+dir+'\'+SearchRec.Name)
          else if (ExtFileName='.pas') then
            OtherFileList.Add('3#'+dir+'\'+SearchRec.Name)
            else if (ExtFileName='.exe') then
              OtherFileList.Add('4#'+dir+'\'+SearchRec.Name)
              else if (ExtFileName='.dll') then
                OtherFileList.Add('5#'+dir+'\'+SearchRec.Name)
                else if (ExtFileName='.ssp') then
                  OtherFileList.Add('6#'+dir+'\'+SearchRec.Name);



    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TImageFileList.Clear;
begin
  FStrListFile.Clear;
  Findex:=-1;
end;

procedure TImageFileList.CopyStrListFile(SrcFileNameList:TStringList);
begin
  FStrListFile.Assign(SrcFileNameList);
end;

constructor TImageFileList.Create;
begin
  FStrListFile:=TStringList.Create;
  Findex:=-1;
end;

procedure TImageFileList.Delete(Index: integer);
begin
  FStrListFile.Delete(Index);
  SetIndex(Index-1);
//
end;

destructor TImageFileList.Destroy;
begin
  FStrListFile.Free;
  inherited;
end;

function TImageFileList.GetCurFileName: string;
begin
  result:=ExtractFileName(FStrListFile.Strings[Findex]);
end;

function TImageFileList.GetCurFullFileName: string;
begin
  result:=FStrListFile.Strings[Findex];
end;

function TImageFileList.GetFileCount: integer;
begin
  result:=FStrListFile.Count;
end;

function TImageFileList.GetIndex: integer;
begin
  result:=FIndex;
end;

function TImageFileList.GetNextFileName: string;
begin
  if Findex=FStrListFile.Count-1 then
    Findex:=0
  else
    inc(Findex);

  result:=FStrListFile.Strings[Findex];
end;
function TImageFileList.GetPreFileName: string;
begin
  if Findex=0 then
    Findex:=FStrListFile.Count-1
  else
    dec(Findex);

  result:=FStrListFile.Strings[Findex];
end;

procedure TImageFileList.SetIndex(AIndex: integer);
begin
  FIndex:=AIndex;
end;


procedure TFormBrowse.FormCreate(Sender: TObject);
begin
  //设置图标间距，也即缩略图间距
  ListView_SetIconSpacing(listview1.handle,90,120);

  OriginalBmp:=Tbitmap.Create;
  ThumbJpg:=TJpegImage.Create;

  PreViewBmp:=Tbitmap.Create;
  PreViewJpg:=TJpegImage.Create;

  ThumbBmp:=TBitmap.Create;
  //缩略图的边框为：80*80，显示图片大小为：64*64
  ThumbBmp.Height:=80;
  ThumbBmp.Width:=80;
  ThumbBmp.PixelFormat:=pf24bit;
  imagelist1.Height:=80;
  imagelist1.Width:=80;
  listview1.LargeImages:=imagelist1;
  listview1.ViewStyle:=vsicon;

  ImageFileList:=TImageFileList.Create;
  ImageFileList.Clear;

  OtherFileList:=TStringList.Create;


  ProgressBar1:=TProgressBar.Create(self);
  ProgressBar1.Parent:=StatusBar1;
  ProgressBar1.Visible:=false;
  ProgressBar1.Width:=200;
  ProgressBar1.Height:=StatusBar1.Height-4;
  ProgressBar1.Left:=StatusBar1.Width-ProgressBar1.Width;

  ProgressBar1.Top:=2;

  IsRefreshImageFinshi:=true;

  IsReadStructureStorageFileMode:=false;

  edit1.Text:=ShellTreeView1.Path;

  AppPath:=ExtractFilepath(Application.Exename);
  //showmessage(apppath);

  CreateHTMLAlbumDir:='c:\';

  SSPJpeg:=TJpegImage.Create;

end;

procedure TFormBrowse.FormDestroy(Sender: TObject);
begin
  OriginalBmp.Free;
  ThumbBmp.Free;
  ImageFileList.Free;
  ThumbJpg.Free;
  PreViewBmp.Free;
  PreViewJpg.Free;
  ProgressBar1.Free;
  OtherFileList.Free;
  SSPJpeg.Free;
end;

procedure TFormBrowse.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  ShellTreeView1Change2(ShellTreeView1.path) ;

end;

procedure TFormBrowse.ListView1Resize(Sender: TObject);
begin
  //重新排列图标
  listview1.Arrange(arAlignleft);
end;

procedure TFormBrowse.MenuFolderTreeClick(Sender: TObject);
begin
  MenuFolderTree.Checked:=not MenuFolderTree.Checked;
  if MenuFolderTree.Checked then
    ScrollBox1.Visible:=true;

  if MenuFolderTree.Checked and  panel1.Visible then
    ShellTreeView1.Height:=ScrollBox1.Height*273 div 486-3;

  if MenuFolderTree.Checked and  (not panel1.Visible) then
    ShellTreeView1.Height:=ScrollBox1.Height-7;


  ShellTreeView1.Visible:=MenuFolderTree.Checked;
  ToolButtonFoldeTree.Down:=MenuFolderTree.Checked;

  if (not panel1.Visible) and (not ShellTreeView1.Visible) then
  ScrollBox1.Visible:=false;
  self.Refresh;

end;

procedure TFormBrowse.MenuPreviewAreaClick(Sender: TObject);
begin
  MenuPreviewArea.Checked:=not MenuPreviewArea.Checked;
  if MenuPreviewArea.Checked then
     ScrollBox1.Visible:=true;


 if (MenuPreviewArea.Checked) and  (ShellTreeView1.Visible) then
    ShellTreeView1.Height:=ScrollBox1.Height*273 div 486-3;



  panel1.Visible:=MenuPreviewArea.Checked;

  ToolButtonPreArea.Down:=MenuPreviewArea.Checked;


  if (not panel1.Visible) and  (ShellTreeView1.Visible) then
  ShellTreeView1.Height:=ScrollBox1.Height-7;




  if (not panel1.Visible) and (not ShellTreeView1.Visible) then
  ScrollBox1.Visible:=false;
  self.Refresh;

end;


procedure TFormBrowse.MenuFileAreaClick(Sender: TObject);
begin
  MenuFileArea.Checked:=not MenuFileArea.Checked;
  ListView2.Visible:=MenuFileArea.Checked;
  ToolButtonFileArea.Down:=MenuFileArea.Checked;
  if ListView2.Visible then
  Splitter3.Top:=ListView2.Top-Splitter3.Height;