用Delphi實現縮略圖查看 類似ACDSee方式 |
|
|
|
jackkcg
站務副站長  發表：891 回覆：1050 積分：848 註冊：2002-03-23 發送簡訊給我 |
此為轉貼資料 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的表單抓下來，然後在畫圖軟體裏放大８倍後觀察，你就什?都明白了．其實，一個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。 *********************************************************
哈哈&兵燹
最會的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 發送簡訊給我 |
|
|
kagaya
中階會員  發表：74 回覆：175 積分：59 註冊：2002-12-28 發送簡訊給我 |
|
|
landa8888
一般會員  發表：1 回覆：2 積分：0 註冊：2003-12-17 發送簡訊給我 |
|
|
kaola
一般會員  發表：3 回覆：3 積分：1 註冊：2005-03-03 發送簡訊給我 |
|
|
miyada
一般會員 發表：6 回覆：7 積分：2 註冊：2008-11-02 發送簡訊給我 |
|
|
macchen
初階會員  發表：66 回覆：102 積分：33 註冊：2006-07-07 發送簡訊給我 |
發表時間：2003-03-01 13:21:13
IP:61.64.xxx.xxx 未訂閱
系統時間：2024-12-04 1:41:41
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |