分享
 
 
 

用Delphi实现缩略图查看

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

本来想投个杂志什么的,现在想来也没那个必要了。

用Delphi实现缩略图查看

作者:姜亮

缩略图英文也叫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。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有