关于缩略图的问题 ( 积分: 50 )

  • 主题发起人 主题发起人 墨剑
  • 开始时间 开始时间

墨剑

Unregistered / Unconfirmed
GUEST, unregistred user!
唉,我一向是做数据库的,没想现在被这个问题难道了。
怎样生成一张图片(jpg,bmp,gif等)的缩略图(96×96的bmp)?
 
唉,我一向是做数据库的,没想现在被这个问题难道了。
怎样生成一张图片(jpg,bmp,gif等)的缩略图(96×96的bmp)?
 
看看有帮助吗
Thumbnail Browser Example by Boern Ischo
A very simple example on how to create a thumbnail image browser.
There's a lot of stuff to do to use this for a serious program, but
I thought beginners might be interested in this. You're welcome to
send my any questions or comments on this to bjoern@ischo.de

Public Domain. Feel free to use this code in any way you like.



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, FileCtrl, StdCtrls,jpeg;

type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
ScrollBox1: TScrollBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type tbi_thumb=class(tcustomcontrol)
fmypic : tjpegimage;
private
procedure getpic(value:tjpegimage);
public
procedure paint; override;
constructor create(aowner:tcomponent); override;
destructor destroy; override;
published
property pic:tjpegimage write getpic;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

var buffer_jpeg:tjpegimage;

//a simple class for thumbnails...

constructor tbi_thumb.create(aowner:tcomponent);
begin
inherited;
fmypic:=tjpegimage.create;
end;

destructor tbi_thumb.destroy;
begin
inherited;
fmypic.free;
end;

procedure tbi_thumb.getpic(value:tjpegimage);
begin
fmypic.scale:=jshalf;
fmypic.assign(value);
fmypic.dibneeded;
end;

procedure tbi_thumb.paint;
var arect : trect;
ratio : single;
begin
arect:=clientrect;
canvas.stretchdraw(arect,fmypic);
frame3d(canvas,arect,clblack,clwhite,2);
end;

//*<----------------------------------------------------


procedure TForm1.FormCreate(Sender: TObject);
begin
buffer_jpeg:=tjpegimage.create;
buffer_jpeg.Performance:=jpbestspeed;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
buffer_jpeg.free;
while scrollbox1.ComponentCount>0 do
scrollbox1.components[0].free;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
var i,x,y : integer;
anewthumb : tbi_thumb;
foundlist : tstringlist;
sr : TSearchRec;

begin
foundlist:=tstringlist.create;

try

//look for jpg files
if FindFirst(directorylistbox1.Directory+'/*.jpg', faAnyFile, sr) = 0 then
begin
foundlist.add(sr.name);
while FindNext(sr) = 0 do
foundlist.add(sr.name);
FindClose(sr);
end;

x:=0;
y:=0;

//create the thumbnails
for i:=0 to FoundList.count-1 do
begin
anewthumb:=tbi_thumb.create(self);
buffer_jpeg.loadfromfile(foundlist);
with anewthumb do begin
pic:=buffer_jpeg;
parent:=scrollbox1;
left:=x;
top:=y;
width:=120;
height:=90;
visible:=true;
inc(x,122);
if x>244 then
begin x:=0; inc(y,92); end;
application.processmessages;
end;
end;

finally foundlist.free;
end;

end;

end.
 
这个明显只能用于jpg图片嘛,我需要的还有bmp,gif.等等其他格式
 
自由界面和报表的完美解决方案!
http://www.anylib.com
 
还是不能回答我的问题
 
我是这样做的,用IMAGEGIF控件,然后自己用bmp的strechdraw,一切都搞定了
 
安裝IMAGES控件就搞定了。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部