高人看看代码,解决问题人民币1000元酬谢,不够可以加.(50分)

我这个程序是一个图片播放程序,主程序调用tmpictext控件.我列出了相关的语句.主程序开始播放后每隔5秒中调用getbitmap,把生成的showedpic用于显示.我这段代码在大多数计算机运行没问题,但是在个别新的电脑上运行会出问题.共有两台,一台是联想电脑,运行30分钟后会死机.试了好几次.另一台是dell电脑款式很新,运行20多分钟退出.我的程序曾经出现过内存不足,无法处理此命令的提示,然后退出的情况.但已经解决.下面的destory没有列出,因为在播放时不进行creat,destory.望高人指点,哪里出了问题.问题解决人民币伺候.嫌少可以加,说到做到.

unit UPicText;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Element, StdCtrls, ExtCtrls,ComCtrls, Jpeg, strutils,
ShockwaveFlashObjects_TLB,activex, GIFCtrl, Animate;

type
TMPicText = class(TELement)
private
FBgColor: TColor;
FBgStyle: integer;
FBgPicFileName: string;
FBgPicture: Graphics.TBitmap;
FEffection: integer;
FShowedPic: Graphics.TBitmap;
FOriginalPic: TGraphic;
implementation

constructor TMPicText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBgColor := clBlack;
FBgStyle := 0;
FEffection := 1;
FShowedPic := Graphics.TBitmap.Create;
FGifDelay := 0;
FBgPicture := Graphics.TBitmap.Create;
end;

procedure TMPicText.GetBackGround;
var
bmp1,bmp: Graphics.TBitmap;
begin
bmp1 := Graphics.TBitmap.Create;
if FBgPicture=nil then
FBgPicture := Graphics.TBitmap.Create
else
FBgPicture.Assign(nil);
FBgPicture.Width := Width;
FBgPicture.Height := Height;
FBgPicture.Canvas.Brush.Color := FBgColor;
FBgPicture.Canvas.FillRect(Rect(0,0,Width,Height));
end;

function TMPicText.GetBitmap: Graphics.TBitmap;
var
bmp: Graphics.TBitmap;
begin
Result := nil;
ReadPicText;
bmp := Graphics.TBitmap.Create;
try
bmp.PixelFormat := pf16bit;
bmp.Assign(FOriginalPic);
GetBackGround;
FShowedPic.Assign(nil);
FShowedPic.Assign(FBgPicture);
SetBackGroundPictureMode(FEffection,bmp,Graphics.TBitmap(FShowedPic),Width,Height);
finally
bmp.Free;
end;
FBgPicture.Assign(nil);
FOriginalPic.Assign(nil);
result := FShowedPic;
end;


procedure TMPicText.ReadPicText;
var
bmp: Graphics.TBitmap;
jpg: TJpegImage;
I: integer;
begin
if FFileName <> '' then
begin
if FOriginalPic=nil then
FOriginalPic := Graphics.TBitmap.Create;
if FileExists(FFileName) then
FOriginalPic.LoadFromFile(FFileName);
end;
end;

procedure SetBackGroundPictureMode(iMode: integer;srcBmp,descBmp: TBitmap;Width,Height: integer);
var
x,y,w,h,iw,ih: integer;
sx,sy,sw,sh: integer;
rate: double;
tmpRect: TRect;
begin
case iMode of
1://拉伸
begin
x := 0;
y := 0;
w := descBmp.Width;
h := descBmp.Height;
descBmp.Canvas.Lock;
descBmp.Canvas.StretchDraw(Rect(x,y,x+w,y+h),srcBmp);
descBmp.Canvas.UnLock;
end;
end;

// 说老实话你的代码真是错误百出的，
unit UPicText;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Element, StdCtrls, ExtCtrls,ComCtrls, Jpeg, strutils,
ShockwaveFlashObjects_TLB,activex, GIFCtrl, Animate;

type
TMPicText = class(TELement)
private
FBgColor: TColor;
FBgStyle: integer;
FBgPicFileName: string;
FBgPicture: Graphics.TBitmap;
FEffection: integer;
FShowedPic: Graphics.TBitmap;
FOriginalPic: TGraphic;
implementation

constructor TMPicText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBgColor := clBlack;
FBgStyle := 0;
FEffection := 1;
FShowedPic := Graphics.TBitmap.Create; //既然这里分配了，以后就不用分配了三
FGifDelay := 0;
FBgPicture := Graphics.TBitmap.Create; //既然这里分配了，以后就不用分配了三

end;

procedure TMPicText.GetBackGround;
var
bmp1,bmp: Graphics.TBitmap;
begin
bmp1 := Graphics.TBitmap.Create; ///这一句有什么用哈，多余的，而且占内存,分配了，又不释放
if FBgPicture=nil then //这个FBgPicture不是分配了吗，如果要判断一般用if not Assigned(FBgPicture) then
FBgPicture := Graphics.TBitmap.Create
else
FBgPicture.Assign(nil); //这个是释放吗,释放用FBgPicture.Free就行了三
FBgPicture.Width := Width;
FBgPicture.Height := Height;
FBgPicture.Canvas.Brush.Color := FBgColor;
FBgPicture.Canvas.FillRect(Rect(0,0,Width,Height));

//既然分配了要释放三bmp1.Free
end;

function TMPicText.GetBitmap: Graphics.TBitmap;
var
bmp: Graphics.TBitmap;
begin
Result := nil;
ReadPicText;
bmp := Graphics.TBitmap.Create;
try
bmp.PixelFormat := pf16bit;
bmp.Assign(FOriginalPic);
GetBackGround;
FShowedPic.Assign(nil); //你不是要释放吧，是不是要清空哟,清空只要把宽、高设为0就行了，FShowedPic.Width :=0; FShowedPic.Height :=0;,要释放用FShowedPic.Free
FShowedPic.Assign(FBgPicture);
SetBackGroundPictureMode(FEffection,bmp,Graphics.TBitmap(FShowedPic),Width,Height);
finally
bmp.Free;
end;
FBgPicture.Assign(nil); //要释放FBgPicture.Free
FOriginalPic.Assign(nil); //要释放FOriginalPic.Free

result := FShowedPic;
end;


procedure TMPicText.ReadPicText;
var
bmp: Graphics.TBitmap;
jpg: TJpegImage;
I: integer;
begin
if FFileName <> '' then
begin
if FOriginalPic=nil then //if not Assigned(ForiginalPic) then
FOriginalPic := Graphics.TBitmap.Create; //
if FileExists(FFileName) then
FOriginalPic.LoadFromFile(FFileName);
end;
end;

procedure SetBackGroundPictureMode(iMode: integer;srcBmp,descBmp: TBitmap;Width,Height: integer);
var
x,y,w,h,iw,ih: integer;
sx,sy,sw,sh: integer;
rate: double;
tmpRect: TRect;
begin
case iMode of
1://拉伸
begin
x := 0;
y := 0;
w := descBmp.Width;
h := descBmp.Height;
descBmp.Canvas.Lock;
descBmp.Canvas.StretchDraw(Rect(x,y,x+w,y+h),srcBmp);
descBmp.Canvas.UnLock;
end;
end;

问题很简单，
（1）前面两个应该可以不在Create里面创建，在各个函数里面创建（如果别的函数不用的话）
（2）保证每个释放均用try。。。finally确保释放。
还有，以后加点注释嘛，我们看着也方便，嘿嘿

谢谢上面两位高手,我写发言的时候,有点疏漏.哪个在GetBackGround里面的bmp1是我在贴的时候忘了删除,上面的代码我是编辑过的,基本上都是常规播放时要用到的,bmp1没释放的问题,是我发贴时的疏漏.原代码有bmp1.free.
我想问:lqcros,我利用assign(nil)是为了清零而不是释放.free.在播放的时候我的本意是当这个位图参数不再需要时就给他assign(nil),清零.需要利用时再符值给他,而创建只有开始的一次.你是不是觉的assign(nil)清零效果没有Width :=0; .Height :=0效果好?还是assign(nil)清零有问题?
其中在getbackground函数里面&quot;if FBgPicture=nil then&quot;这句的确有点多余,因为在create里面已经创建.
在readpictext里面 if FOriginalPic=nil then 这句判断应该有,因为他第一次运行时还没被创建.我想问,你觉的这里用if not Assigned(ForiginalPic) then会更合适?
谢谢你的意见,我会修改后去现场测试.

我想问pjwork:你的意思是FBgPicture,FShowedPic也是动态创建好?但事实上FShowedPic在开始播放时就要创建,创建后不再释放,效果和静态创建一样啊,倒是FBgPicture可以动态创建动态释放.那我还要查一下主程序,看看有没有对他进行调用.是不是觉的静态创建很占用内存?

还没解决吗？

搞不定找我：qq:79627128

静态创建也不会占用很多内存的（毕竟现在内存比较大）
反而是动态创建，会影响程序性能

这两台机器不在身边，在客户那里，要节后才能去测试。这个问题把我搞惨了，真的是昼思夜想啊。我已经记下了lqcros的意见，希望论坛其他高手也能发现其他问题。

不是说出现过内存不足的问题吗，所以我打算节约内存啊，万一他内存就是不够呢，呵呵
还有，你在调试状态下运行，看看出错提示吧。

if FOriginalPic=nil then 和if not Assigned(ForiginalPic) then
逻辑是完全一样的.这个就看个人习惯了.
//FBgPicture.Assign(nil); //要释放FBgPicture.Free
这个我想Free是不太合适的.

如需帮助请联系 zjan521 at gmail

tojwork 我的软件是提供给用户的一个标准软件工具,在大多数电脑上没问题,就是有两台有问题,我上面已经提到过.要到用户那里调试,很不方便.
to:zjan521,rwlin好的.

你用检查代码的工具查一查三，看有没得内存泄漏三

你检查一下，在那些出问题的机器上，5秒钟是否能完成你的一次调用？
最好在开始调用getbitmap的时候，先禁止定时器，调用结束后在启用定时器
另外，使用一个内存检测软件，检测一下你的程序在运行的时候，内存的消耗是否持续在增长

内存问题,我一直在关注,没什么问题,5秒钟能够完成调用,出问题的两台电脑都是最新款的电脑.cpu速度很高.
在主程序里面,我是这样处理的(原代码太多,大意如此):
//5秒的定时器事件处理,picshow的控件(3.01版本),该不会是picshow控件有问题吧,他是多线程处理.
begin
if fpicshow.busy then exit; //判断如果正在执行则退出.
FPicShow.Picture.Assign(nil); //清空
TMPicText(FContainer.ElementList.Objects[FCurBusyElement]).GetBitmap;//图片处理
FPicShow.Picture.Assign(TMPicText(FContainer.ElementList.Objects [FCurBusyElement]).FShowedBmp);//调用图片
Randomize;
FPicShow.Style := Random(150);
FPicShow.Step := TMPicText(FContainer.ElementList.Objects[FCurBusyElement]).Speed;
FPicShow.Execute;//控件执行.
end;

有可能是PicShow的问题，你最好是测试一下哪个东东，

picshow我已经换成了４．０３版本的，重新编译了一下，就等着找机会去用户那里测试了．我比较了一下，两个版本在多线程处理上不一样（exec）．