線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:5459
推到 Plurk!
推到 Facebook!

用Delphi實現縮略圖查看 類似ACDSee方式

 
jackkcg
站務副站長


發表:891
回覆:1050
積分:848
註冊:2002-03-23

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-03-01 13:21:13 IP:61.64.xxx.xxx 未訂閱
此為轉貼資料 http://www.csdn.net/ 用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的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的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。 ********************************************************* 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind to make knowledge together! 希望能大家敞開心胸,將知識寶庫結合一起
------
**********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好

Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind
cmf
尊榮會員


發表:84
回覆:918
積分:1032
註冊:2002-06-26

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-03-01 13:38:43 IP:61.218.xxx.xxx 未訂閱
J SIR:    轉成 BCB 程式  kevintam 就可以用了    僅供參考,歡迎繼續發言
------
︿︿
kagaya
中階會員


發表:74
回覆:175
積分:59
註冊:2002-12-28

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-03-14 10:42:54 IP:61.219.xxx.xxx 未訂閱
kevintam 是什麼程式?能否請大大提示?謝謝
------
KUSO 無處不在
landa8888
一般會員


發表:1
回覆:2
積分:0
註冊:2003-12-17

發送簡訊給我
#4 引用回覆 回覆 發表時間:2003-12-20 10:19:14 IP:61.141.xxx.xxx 未訂閱
你好,看到你的缩略图的例子,其中有一个过程叫: //設置圖示間距,也即縮略圖間距 //ListView_SetIconSpacing(listview1.handle,90,120); 请问能不能也把ListView_SetIconSpacing的过程也列出来。
kaola
一般會員


發表:3
回覆:3
積分:1
註冊:2005-03-03

發送簡訊給我
#5 引用回覆 回覆 發表時間:2005-03-04 16:27:28 IP:220.160.xxx.xxx 未訂閱
landa8888: ListView_SetIconSpacing是单元commctrl中的方法; 只需uses commctrl即可 zdz
------
zdz
miyada
一般會員


發表:6
回覆:7
積分:2
註冊:2008-11-02

發送簡訊給我
#6 引用回覆 回覆 發表時間:2008-12-21 09:18:39 IP:203.70.xxx.xxx 訂閱
  不知道有沒有前輩們可以翻成BCB語法呢
謝謝


===================引 用 kagaya 文 章===================
kevintam 是什麼程式?能否請大大提示?謝謝
------
大家心地都很好 一起來學習吧
macchen
初階會員


發表:66
回覆:102
積分:33
註冊:2006-07-07

發送簡訊給我
#7 引用回覆 回覆 發表時間:2009-06-29 14:07:55 IP:219.87.xxx.xxx 訂閱
請問有人有辦法解決下面的問題嗎?謝謝。

===================引 用 jackkcg 文 章===================
恕刪
四.總結 利用delphi提供的ListView和ImageList控制項我們基本實現了ACDSee的縮略圖功能。但與ACDSee比起來 我們的程式還差的很遠,尤其是當某個目錄下的圖片文件較多時,速度會變得很慢。這方面還希望得到其他朋友的指點。
恕刪
------
DELPHI初學者
系統時間:2017-10-18 15:33:48
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!