用Delphi实现缩略图查看

  • 来源: 互联网 作者: rocket   2008-03-20/14:05
  • 缩略图英文也叫Thumbnails,是现在的看图软件必备的基本功能之一,像ACDSee,豪杰大眼睛等图片浏览软件都提供了此功能.其实利用Delphi6.0提供的ListView和ImageList控件就可以很方便地实现该功能.下面我们就一步一步打造一个属于自己的ACDSee.

        一.编程思路

        ListView能够以四种不同的方式显示数据,其中当以vsIcon方式显示数据时,其图标来自于largeIcon属性指定的ImageList控件.因此,只要我们把图片缩放后动态加载到ImageList控件中,就能够以缩略图方式在ListView中显示了.需要注意的是,加载到ImageList中的图片大小尺寸必须相等;而且,为了避免图片缩放后变形,我们应该尽可能保证图片的长宽比例保持不变.我一直用"缩放"一词,这是因为对于大图片我们要缩小它,而对于小图片我们则要放大它.ACDSee就是这样做的.最后还有一个小小的问题,我们如何实现ACDSee中那些具有立体感的类似于panel的边框呢?你也许会说动态生成panel控件!这实在不是个好主意.因为那将占用大量的系统资源.我感觉 ACDSee的那些panel不是真正的panel,而是被画上去的,所以我们要自己画panel.你也许会想自己画panel很麻烦吧,开始我也这样想,但当我把这个问题搞定后,发现它简直就是一块小蛋糕.^-^随便把一个有panel的窗体抓下来,然后在画图软件里放大8倍后观察,你就什么都明白了.其实,一个panel就是由四条线段组成的(如图一所示)。所有的问题都解决了,那就赶快动手吧!

    (图一)

        二.设计界面

        新建一工程,执行以下步骤:

        1。在窗体上添加一个ScrollBox1控件,设置其Align属性为alLeft。

        2。在窗体上添加一个Splitter1控件,设置其width为3,Align属性为alLeft。

        3。在窗体上添加一个ListView1控件,设置其Align属性为alClient,color属性为clBtnFace。

        4。在ScrollBox1里添加一个ShellTreeView1控件(该控件在Samples页面上),设置其Align属性为alTop。

        5。在ScrollBox1里添加一个Splitter2控件,设置其Height为3,Align属性为alTop。

        6。在ScrollBox1里添加一个panel1控件,设置其Align属性为alClient。

        7。在panel1上添加一个Image1控件。

        完成后的界面请参考图二。

       

    图二

        三. 编写代码

        界面做好了,下面就该写代码了。

        1。单元的接口部分主要代码如下:

    unit Unit1;

    interface

    uses
     ...jpeg...

    type
      TForm1 = class(TForm)
       ......

      private
        ProgressBar1:TProgressBar;
        OriginalBmp,ThumbBmp:Tbitmap;
        PreViewBmp:Tbitmap;
        ThumbJpg:TJpegImage;
        PreViewJpg:TJpegImage;
        IsRefreshImageFinished:boolean;
        { Private declarations }
      public
        procedure RefreshImage;
        procedure ShowPreImageFit(const ImageFileName:string);
        { Public declarations }
      end;

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

        //清空文件列表
        procedure Clear;

        //当目录改变时,调用此过程会把该目录下所有图片文件
        //添加到文件列表中
        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;

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

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

      const
      RaisedPanel=1;
      LoweredPanel=2;

    var
      Form1: TForm1;
      ImageFileList:TImageFileList;
    implementation
      .....

      2.  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;
      temstr:=dir+´\*.*´;
      Attr := faAnyFile;
      Found := FindFirst(temstr, Attr, SearchRec);
      while Found = 0 do
      begin
        ExtFileName:=LowerCase(ExtractFileExt(SearchRec.Name));
        if (ExtFileName=´.bmp´) or (ExtFileName=´.jpg´) or ((ExtFileName=´.jpeg´)) then
          Add(dir+´\´+SearchRec.Name);

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

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

    constructor TImageFileList.Create;
    begin
      FStrListFile:=TStringList.Create;
      Findex:=-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;

      3. 过程JpgToBmp及函数IsJpgFile的代码如下所示:

    //转换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;

    4.  我们在窗体的OnCreate和OnDestroy事件处理句柄里添加如下代码:


    procedure TForm1.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;

      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;

      IsRefreshImageFinished:=true;
    end;

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

    5. 在ShellTreeView1的OnChange事件里添加下面代码:

    procedure TForm1.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
    var
      dir:string;
    begin
      //如果上次的RefreshImage过程还没有结束,就退出
      if not IsRefreshImageFinished 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);

      screen.Cursor:=crHourGlass;

      self.Enabled:=false;
      RefreshImage;
      self.Enabled:=true;
      screen.Cursor:=crDefault;
    end;

    6. 其中过程RefreshImage的代码如下:
    //此过程把ImageFileList中记录的图片文件缩放后加载到ImageList1中,并在
    //ListView1中显示
    procedure TForm1.RefreshImage;
    var
      i:integer;
      ImageFileName:string;
      ThumbBmpLeft:integer;
      ThumbBmpTop:integer;
      ThumbBmpHeight:integer;
      ThumbBmpWidth:integer;
    begin
      IsRefreshImageFinished:=false;
      listview1.Clear;
      imagelist1.Clear;

      screen.Cursor:=crHourGlass;
      ProgressBar1.Max:=ImageFileList.GetFileCount;
      ProgressBar1.Visible:=true;
      listview1.Items.BeginUpdate;
      try
        for i:=0 to ImageFileList.GetFileCount-1 do
        begin

          ImageFileList.SetIndex(i);
          ImageFileName:=ImageFileList.GetCurFullFileName;
          if IsJpgFile(ImageFileName) then
            jpgtobmp(ImageFileList.GetCurFullFileName,ThumbJpg,OriginalBmp)
          else
            OriginalBmp.LoadFromFile(ImageFileList.GetCurFullFileName);

          if OriginalBmp.Height>=OriginalBmp.Width then
          begin

            ThumbBmpWidth:=64*OriginalBmp.Width div OriginalBmp.Height;
            ThumbBmpLeft:=(64-ThumbBmpWidth ) div 2;

            ThumbBmp.Canvas.Brush.Color :=clBtnFace;
            ThumbBmp.Canvas.FillRect(ThumbBmp.Canvas.ClipRect);

            DrawPanel(ThumbBmp.Canvas,0,0,79,79,RaisedPanel);
            DrawPanel(ThumbBmp.Canvas,7+ThumbBmpLeft,7,ThumbBmpWidth+1,64,LoweredPanel);
            ThumbBmp.Canvas.StretchDraw(Rect(8+ThumbBmpLeft,8,8+ThumbBmpLeft+ThumbBmpWidth,71),OriginalBmp);

            imagelist1.Add(ThumbBmp,nil);
          end
          else
          begin
            ThumbBmpHeight:=64*OriginalBmp.Height div OriginalBmp.Width;
            ThumbBmpTop:=(64-ThumbBmpHeight ) div 2;

            ThumbBmp.Canvas.Brush.Color :=clBtnFace;
            ThumbBmp.Canvas.FillRect(ThumbBmp.Canvas.ClipRect);

            DrawPanel(ThumbBmp.Canvas,0,0,79,79,RaisedPanel);
            DrawPanel(ThumbBmp.Canvas,7,7+ThumbBmpTop,64,ThumbBmpHeight+1,LoweredPanel);
            ThumbBmp.Canvas.StretchDraw(Rect(8,8+ThumbBmpTop,71,8+ThumbBmpTop+ThumbBmpHeight),OriginalBmp);
            imagelist1.Add(ThumbBmp,nil);
          end;

          with ListView1.Items.Add  do
          begin
            ImageIndex:=imagelist1.Count-1;
            caption:=ImageFileList.GetCurFileName;
          end;
          ProgressBar1.Position:=i;
          application.ProcessMessages;
        end;
      finally
        listview1.Items.EndUpdate;
        ProgressBar1.Visible:=false;
      end;
      screen.Cursor:= crDefault;
      IsRefreshImageFinished:=true;

    end;

    7.过程DrawPanel的代码如下:

    //在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;
     8.接下来我们在ListView1的OnSelectItem事件里添加代码:

    procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    begin
      //当ShellTreeView1目录改变时 会激发此事件,
      if listview1.SelCount=0 then exit;

      //当窗体释放时也会激发此事件
      //ImageFileList.GetFileCount=0 后再 ImageFileList.SetIndex(item.Index);
      //会引起异常
      if ImageFileList.GetFileCount=0 then  exit;

      ImageFileList.SetIndex(item.Index);
      ShowPreImageFit(ImageFileList.GetCurFullFileName);
    end;

    9.其中过程ShowImageFit的代码比较罗嗦,如下所示:

    //image1在Panel1中居中显示图片文件ImageFileName

    procedure TForm1.ShowPreImageFit(const ImageFileName: string);
    begin
      Image1.Visible:=false;
      if IsJpgFile(ImageFileName) then
      begin
        JpgToBmp(ImageFileName,PreViewJpg,PreViewBmp);
        Image1.Picture.Bitmap:=PreViewBmp;
      end
      else
      Image1.Picture.LoadFromFile(ImageFileName);

      if (Image1.Picture.Bitmap.Height<=Panel1.Height) and (image1.Picture.Bitmap.Width<=Panel1.Width) then
      begin
        Image1.AutoSize:=true;
        Image1.Stretch:=true;
        Image1.Left:=(Panel1.Width-image1.Width) div 2;
        Image1.Top:=(Panel1.Height-image1.Height) div 2;
      end
      else if Panel1.Height>=Panel1.Width then
      begin
        Image1.AutoSize:=false;
        Image1.Stretch:=true;
        if image1.Picture.Bitmap.Height>=image1.Picture.Bitmap.Width then
        begin
          image1.Height:=Panel1.Width;
          Image1.Width:=Image1.Height*Image1.Picture.Bitmap.Width div Image1.Picture.Bitmap.Height;
          Image1.Top:=(Panel1.Height-Image1.Height) div 2;
          Image1.Left:=(Panel1.Width-Image1.Width) div 2;
        end
        else
        begin
          Image1.Width:=Panel1.Width;
          Image1.Height:=Image1.Width*Image1.Picture.Bitmap.Height div Image1.Picture.Bitmap.Width;
          Image1.Top:=(Panel1.Height-Image1.Height) div 2;
          Image1.Left:=(Panel1.Width-Image1.Width) div 2;
        end;
      end
      else
      begin
        Image1.AutoSize:=false;
        Image1.Stretch:=true;
        if Image1.Picture.Bitmap.Height>=Image1.Picture.Bitmap.Width then
        begin
          Image1.Height:=Panel1.Height;
          Image1.Width:=Image1.Height*Image1.Picture.Bitmap.Width div Image1.Picture.Bitmap.Height;
          Image1.Top:=(Panel1.Height-Image1.Height) div 2;
          Image1.Left:=(Panel1.Width-Image1.Width) div 2;
        end
        else
        begin
          Image1.Width:=Panel1.Height;
          Image1.Height:=Image1.Width*Image1.Picture.Bitmap.Height div Image1.Picture.Bitmap.Width;
          Image1.Top:=(Panel1.Height-Image1.Height) div 2;
          Image1.Left:=(Panel1.Width-Image1.Width) div 2;
        end
      end;
      Image1.Visible:=true;
    end;

      由于整个程序的代码比较长,上面仅列出了部分重要的代码。编译运行后的界面如图三所示。

     

    (图三)

      四.总结

        利用delphi提供的ListView和ImageList控件我们基本实现了ACDSee的缩略图功能。但与ACDSee比起来我们的程序还差的很远,尤其是当某个目录下的图片文件较多时,速度会变得很慢。这方面还希望得到其他朋友的指点。源程序在delphi6.0和win98SE环境下编译通过,参考软件ACDSee3.0。


    评论 {{userinfo.comments}}

    {{money}}

    {{question.question}}

    A {{question.A}}
    B {{question.B}}
    C {{question.C}}
    D {{question.D}}
    提交

    驱动号 更多