快速切换TImage造成画面停顿问题 ( 积分: 100 )

程序目标：快速浏览照片
图像来自210*280大小的JPG文件(大小从几K到10多K)，全部放在一个目录下，数目大约有几千张
故障现象：对于较多的照片或较大的照片则会出现画面停止响应的现象(IDE中运行却一切正常)
请大家指教！

主要代码如下：
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.DoubleBuffered:=true; //加上可以防止画面闪烁
end;

procedure TForm1.Button3Click(Sender: TObject);
var
sr: TSearchRec;
FileAttrs: Integer;
Picture:TPicture;
bitmap:Tbitmap;
filename,srcname:string;
JPEGImage: TJPEGImage;
begin
memo1.Clear ;
label9.Caption:='当前照片:';
FileAttrs:=faAnyFile ;
if FindFirst(label1.Caption+'*.*', FileAttrs, sr) = 0 then
begin
repeat
filename:=sr.Name;
if not ((filename='.') or (filename='..') or (filename='Thumbs.db')) then
begin
srcname:=label1.Caption+filename;//完整文件名
Picture:=TPicture.Create;
bitmap:=Tbitmap.Create;
JPEGImage:=TJPEGImage.Create;
try
try
label9.Caption:='当前照片:'+filename;
//加载图形
Picture.LoadFromFile(srcname);
image1.AutoSize:=true;
image1.Stretch:=true;
image1.Picture.Bitmap.Assign(Picture.Graphic);
form1.Refresh;
except
memo1.Lines.Add(filename+'处理失败，可能原因：原文件不是图形文件');
end;
finally
Picture.Free;
bitmap.Free;
JPEGImage.Free;
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
Application.MessageBox(PChar('照片浏览完毕！'),'信息',MB_OK);
end;

代码写得这么烂，不停顿才怪

自己搞定了，加一句
application.ProcessMessages;

2楼的真没意思，就算我的程序烂，你也可以具体点，以供人家学习，说风凉话有什么用！

学习态度不端正，你加一句ProcessMessages代码就优化了？

这帮大师级的富翁的建议，不能不听，虽然说话臭点，但话里句句都会促使你成长。你是一朵花，当然需要化肥来促使你健康成长。

I love this to help a Big rich manes

什么JB大师，就跟那装B，我的程序再烂你如果指出哪里烂都好，哪怕你说得不对都行，未必然JB大师写的程序就不停顿，BS丫的，去死吧！[xx(]
PS:楼上的E文不行啊，复数都搞错了

我爱PASCAL 兄是一位非常热心的富翁，也是我敬重的论坛成员之一，他并没有说错，为什么就不能追问一句“烂”在哪里呀。

我觉得非常奇怪，代码烂就烂了，以后努力写得不烂不就行了，一定要这样么？

我一直怀着对大富翁感恩心情来论坛，看到这种情况我是非常痛心的，真的不希望这样。

言归正传罢，lps 说程序的目标是要求“快速浏览照片”，确实，按照上面的代码是不够的，
应该考虑预取技术。下面分几个部分描述：

预取，就是在显示当前图片的同时预读下一副图片。因此需要设计一个预读线程：

TCacheThread = class(TThread)
private
FCacheList : TStringList;
tmpBitmap : TBitmap;
tmpJPEG : TJPEGImage;
ShamMem : TShamMemoryStream;
protected
procedure Execute; override;
public
FCacheSize : PInteger;
sFileName : String;
bActive : Boolean;
constructor Create(CacheList : TStringList; pCacheSize : PInteger);
end;

这个线程的实现代码如下：

constructor TCacheThread.Create(CacheList : TStringList; pCacheSize : PInteger);
begin
bActive := False;
inherited Create(True);
FreeOnTerminate := True;
sFileName := '';
FCacheList := CacheList;
FCacheSize := pCacheSize;
tmpBitmap := TBitmap.Create;
tmpJPEG := TJPEGImage.Create;
ShamMem := TShamMemoryStream.Create;
end;

procedure TCacheThread.Execute;
var
db: Windows.BITMAP;
pBuf : PByte;
bInCache : Boolean;
iIndex, iHeight, SizeBytes: Integer;
begin
while not Terminated do
begin
if bActive then
begin
bInCache := False;
iIndex := 0;
if FCacheList.Count > 0 then
bInCache := FCacheList.Find(AnsiUpperCase(sFileName),iIndex);

if not (bInCache) then
begin

try
tmpJPEG.LoadFromFile(sFileName);
except
tmpJPEG.Height:=0;
tmpJPEG.Width :=0;
end;

if not ((tmpJPEG.Height = 0) or (tmpJPEG.Width = 0)) then
begin

with tmpBitmap do
begin
Width:=tmpJPEG.Width;
Height:=tmpJPEG.Height;
Canvas.Draw(0,0,tmpJPEG);
PixelFormat := pf24bit;
iHeight:= Height;
GetObject(Handle,sizeof(db),@db);
end;

SizeBytes:=(db.bmWidthBytes * iHeight) + 54;
pBuf := AllocMem(SizeBytes);
with ShamMem do
begin
ShamMemory := pBuf;
SetSize(SizeBytes);
Position := 0;
tmpBitmap.SaveToStream(ShamMem);
FCacheList.AddObject(AnsiUpperCase(sFileName),TObject(pBuf));
ShamMemory := nil;
Position := 0;
end;
if FCacheSize^ < MaxCacheSize then
Inc(FCacheSize^,SizeBytes)
else
begin
FreeMem(PByte(FCacheList.Objects[0]));
FCacheList.Delete(0);
end;
end;

end;
bActive := False;
Suspend;
end;
end;

tmpBitmap.Free;
tmpJPEG.Free;
ShamMem.Free;
end;

注意这个线程中使用了一个伪数据流 —— TShamMemoryStream ，之所以考虑用一个伪数据
流的目的是不想在代码里重复产生已经存在的数据。所以我对 TMemoryStream 进行了改造：

type
TShamMemoryStream = class(TMemoryStream)
private
FShamMemory: Pointer;
protected
function Realloc(var NewCapacity: Longint): Pointer; override;
public
property ShamMemory: Pointer read FShamMemory write FShamMemory;
end;

改造后的这个类只有一个方法需要实现，但却是伪造的关键：

function TShamMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
begin
Result := FShamMemory;
end;

这是在做什么？这就是把原来的内存数据流这个类扩展成了 Memory 可读，并且不再真的有
自己的数据流内存块了。以后，任何内存分配函数获得的内存指针，就可以用它来包装成数
据流了。

有了这个预读线程，我就可以实现真正的“快速浏览”，下面是部分实现代码：

一、一次性读取文件所在目录下的全部文件形成文件列表
二、加载的同时检查缓存中是否已经存在
三、不存在的话，只好由主线程强读一次，存在的话，主线程是不去读文件的，直接读缓存

procedure TForm1.Open1Click(Sender: TObject);
begin
with OpenDialog1 do
if Execute then
begin
LoadFile(FileName);
InitialDir := ExtractFilePath(FileName);
CreateFileList;
end;
end;

procedure TForm1.LoadFile(FileName : string);
begin
if '.JPG' = UpperCase(ExtractFileExt(FileName)) then
begin
LoadJPG(FileName);
ClientWidth := Image.Picture.Bitmap.Width;
ClientHeight := Image.Picture.Bitmap.Height + ToolBar.Height + StatusBar.Height;
Image.Repaint;
end;
end;

procedure TForm1.CreateFileList;
var
S : String;
begin
FileList.Clear;
S := OpenDialog1.InitialDir;

// 搜索全部 JPG 文件
if FindFirst(S+'/*.jpg',faAnyFile,SearchRec) = 0 then
begin
FileList.Add(S+'/'+SearchRec.Name);
while (FindNext(SearchRec) = 0) do
FileList.Add(S+'/'+SearchRec.Name);
FindClose(SearchRec);
end;

Index := FileList.IndexOf(sFileName);
if Index > 0 then
btnPrev.Enabled := True; // 上一个图片按钮可以使用
if Index < FileList.Count-1 then
btnNext.Enabled := True; // 下一个图片按钮可以使用

if Index < FileList.Count-1 then
begin
// 启用图片预加载技术
BackProcess.sFileName := FileList.Strings[Index + 1];
BackProcess.bActive := True;
BackProcess.Resume;
end;
end;

上面描述了文件列表的获取和文件对话框的处理，经过上述处理，我已经获得了全部文件名
了，下面就要使用预取技术配合操作了：

procedure TForm1.LoadJPG(FileName : string);
var
db: Windows.BITMAP;
pBuf : PByte;
bInCache : Boolean;
bi:TBitmapFileHeader;
iHeight, iIndex, SizeBytes : Integer;
begin
sFileName := FileName;
Caption := sMainCaption + ' ('+ FileName +')';
bInCache := False;
iIndex := 0;
if CacheList.Count > 0 then
bInCache := CacheList.Find(AnsiUpperCase(FileName),iIndex);

if bInCache then
with ShamMem do
begin
ShamMemory := PByte(CacheList.Objects[iIndex]);
Position := 0;
SetSize(MaxPreSize);
Read(bi,Sizeof(bi));
SetSize(bi.bfSize);
Position := 0;
try
Image.Picture.Bitmap.LoadFromStream(ShamMem);
Position := 0;
ShamMemory := nil;
except
Position := 0;
ShamMemory := nil;
end;

end
else
begin

try
tmpJPEG.LoadFromFile(sFileName);
except
tmpJPEG.Height:=0;
tmpJPEG.Width :=0;
end;

if not ((tmpJPEG.Height = 0) or (tmpJPEG.Width = 0)) then
begin

with Image.Picture.Bitmap do
begin
Width:=tmpJPEG.Width;
Height:=tmpJPEG.Height;
Canvas.Draw(0,0,tmpJPEG);
PixelFormat := pf24bit;
iHeight:= Height;
GetObject(Handle,sizeof(db),@db);
end;

SizeBytes:=(db.bmWidthBytes * iHeight) + 54;
pBuf := AllocMem(SizeBytes);
with ShamMem do
begin
ShamMemory := pBuf;
SetSize(SizeBytes);
Position := 0;
Image.Picture.Bitmap.SaveToStream(ShamMem);
CacheList.AddObject(AnsiUpperCase(sFileName),TObject(pBuf));
Position := 0;
ShamMemory := nil;
end;
if iCacheSize < MaxCacheSize then
Inc(iCacheSize,SizeBytes)
else
begin
FreeMem(PByte(CacheList.Objects[0]));
CacheList.Delete(0);
end;
end;

end;
end;

上面配合操作的结果确实可以看到 Image 加载的时候会检查缓存，但这个缓存是什么时机
生成的呢？看了下面的代码就明了了：

procedure TForm1.btnNextClick(Sender: TObject);
var
S : String;
begin
btnPrev.Enabled := True;
Inc(Index);
if Index >= FileList.Count-1 then
btnNext.Enabled := False;

S := FileList.Strings[Index];
if S <> '' then
LoadFile(S);
if (Index < FileList.Count-1) and (not BackProcess.bActive) then
begin
BackProcess.sFileName := FileList.Strings[Index+1];
BackProcess.bActive := True;
BackProcess.Resume;
end;
end;

procedure TForm1.btnPrevClick(Sender: TObject);
var
S : String;
begin
btnNext.Enabled := True;
Dec(Index);
if Index <= 0 then
btnPrev.Enabled := False;

S := FileList.Strings[Index];
if S <> '' then
LoadFile(S);
if (Index > 0) and (not BackProcess.bActive) then
begin
BackProcess.sFileName := FileList.Strings[Index-1];
BackProcess.bActive := True;
BackProcess.Resume;
end;
end;

这个二个方法无非是“下一个”和“上一个”按钮的代码，我相信你有能力改成你希望的样
子，比如，使用定时器进行类似幻灯显示的效果等等，而且，理论上也不需要开启双缓冲技
术，这一点，我已经通过实践证明了的。

其他还有一些与预取技术无关的用于美化的代码我就不贴了，如果真的对这种技术感兴趣，
这些代码就已经可以帮助你实现自己的目标了。最后还有二个常量需要考量：

const
MaxPreSize = 4194304;
MaxCacheSize = MaxPreSize * 10;

为什么设计成这么古怪的数值？其实，这是考虑了数码照相机的图片的缘故，理由留给你自己考虑吧。

小雨哥在下是佩服得紧，不仅是技术，也有为人，本人水平虽然烂，但是总有权知道哪里烂吧？

事实上我说的快速只是说不故意停顿以便看清楚的意思，类似电视上的手机号码抽奖，就是一个滚动显示，并不是要追求显示速度，就这样的速度已经快得看不清了！小雨哥的代码虽好，却不适合我。

其实最大的问题我自己已经找到了，那就是在耗时太多的循环中无法处理消息！并不是来不及读写磁盘。

Call ProcessMessages to permit the application to process messages that are currently in the message queue. ProcessMessages cycles the Windows message loop until it is empty, and then returns control to the application.

Note: Neglecting message processing affects only the application calling ProcessMessages, not other applications. In lengthy operations, calling ProcessMessages periodically allows the application to respond to paint and other messages.

楼主：
还是火气小点为好！
“我爱PASCAL”这位兄弟是不是大师，我不知道，也没有人给他封。但是，我知道他帮助过很多人，就像“小雨哥”，说得好，我们是怀着感恩的心情，经常来大富翁的。因为，我们是在这里成长起来的。
图片快速浏览我也做过，我用的不是你这样的技术。没有感觉慢的现象。
我用的是数据流，感觉很快！

另外，谢谢你对我的E文提示，这多好！
干吗发那么大的火。
I love this to help a Big rich man 这个可能就对了
再过2年，在上大富翁 。恐怕你也会如此之说的。

多人接受答案了。