TCanvas 的问题(100分)

wfzha123@yiwu.com.cn

我也试过这样的问题，我怀疑是内存的问题，当然是内存应用了

我写了一个简单的测试程序，用这个程序就可以暴露 Delphi 的Bug：
程序定义了两个单元，一个主界面，放两个按钮，另外一个是线程单元；
主界面单元的程序如下：
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,UnitTest;
type
TfrmMain = class(TForm)
btnStart: TButton;
Button1: TButton;
procedure btnStartClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
test : TTest;
implementation
{$R *.dfm}
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
if test = nil then
test := TTest.Create(False);
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
FreeAndNil(test);
end;
end.

线程单元的程序如下：
unit UnitTest;
interface
uses
Classes,Graphics,SysUtils;
type
TTest = class(TThread)
private
FCurrentBitmap : TBitmap;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy;override;
end;

implementation
constructor TTest.Create(CreateSuspended: Boolean);
begin
FCurrentBitmap := TBitmap.Create;
FCurrentBitmap.LoadFromFile('c:/test.bmp');

Inherited;
end;
destructor TTest.Destroy;
begin
inherited;
FreeAndNil(FCurrentBitmap);
end;
procedure TTest.Execute;
var
number : integer;
begin
number := 0;
while not Terminated do
begin
FCurrentBitmap.Canvas.TextOut(0,0,IntToStr(number));
FCurrentBitmap.SaveToFile('c:/ret.bmp');
Inc(number);
sleep(10);
end;
end;
end.

测试办法：
1. 用Delphi5 或 Delphi6 编译都可以；
2. 在C盘根目录下放一个 test.bmp 文件；
3. 单击“start Test”按钮，工作线程开始不断反复产生从 c:/ret.bmp 文件；

Delphi Bug 的表现：
1.以上程序运行一段时间后，就报告奇怪的异常：“当文件存在时，不能创建该文件”
2.如果创建 ret.bmp 文件之前，调用 DeleteFile 函数删除这个文件，运行一段时间后，就会报告奇怪的异常：“Out of system resource”
3.大家测试时，一定要有耐心，这个一段时间，一般是3分钟左右，也可能得等1个小时！

试了15分钟，没问题啊，明天再说吧
另外，把sleep的时间调大试试，如果不出了，就不是bug，你的sleep的时间太短了，不能说明问题。

sleep 时间设置短一些，为什么就不能说明问题了？
我这里面加一个Sleep，只不过是为了降低 CPU 的资源占用，以便在测试的同时，可以干别的事情。

大家在测试这个程序的时候，一定要有耐心，最好是，将这个程序启动开始测试后，让它一直运行。

你原来的问题改为
InsertBmp:=TBitmap.Create;
try
InsertBmp.Width := FCurrentBitmap.Width;
InsertBmp.Height := FCurrentBitmap.Height;
InsertBmp.Canvas.Draw(0,0,FCurrentBitmap);
InsertBmp.PixelFormat := tempBMP.PixelFormat;
InsertBmp.SaveToStream(..)；
finally
InsertBmp.Free;
end;
应该就可以了,我在别的情况下也发现类似的问题

或者
InsertBmp.PixelFormat := tempBMP.PixelFormat;
InsertBmp.Width:=0;(或 InsertBmp.Height:=0
InsertBmp.Width := FCurrentBitmap.Width;
InsertBmp.Height := FCurrentBitmap.Height;
InsertBmp.Canvas.Draw(0,0,FCurrentBitmap);
InsertBmp.SaveToStream(..)；
我也奇怪为什么要如此

To: 'pengyt
对于你的第一种写法，我的原程序就是这样的，一个字不差。依然存在这样的问题；
对于你的第二种写法，我需要作一个试验验证，不过这种做法，还是不能从根本上解决Delphi的这个Bug，例如，我上载的第二程序，如何解决这个问题？
其实，我感觉，这两个问题是由同一个 Bug 引起的。

to andin
sleep太短了，就是没有bug也有可能出错的。就算是资源管理器，他的目录列表如果
你改变了选择的对象还要sleep(50)呢，你反复读些同一个文件，才sleep(10),其实
我觉得sleep(10)与不写sleep没什么区别。
如果sleep设长了就不出错的话，一定是system的问题，不信，把代码用vc在写一遍试试

To:wfzha
我建议你不要在 Sleep 时间长短上去找愿意，不要去替 Delphi 辩护，原因很简单：
1. 无法解释；
2. 如果在主程序，执行这一段代码，即使在死循环里执行（根本就不Sleep)，不会出现任何异常，可是将这段程序放到工作线程里，就出现了奇怪的异常。

to andin:
你上的第二个程序是指哪个?

To：pengyt
就是上面那个长一点的程序，其中没有 InsertBmp 这个对象，只有一个 FCurrentBitmap 对象，如何解决这两个异常现象呢？

procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
...
Save := 0;
MaskDC := 0;
try
[red]MaskDC := GDICheck(CreateCompatibleDC(0));[/red]
Save := SelectObject(MaskDC, FMaskHandle);
...
出错的地方就在MaskDC := GDICheck(CreateCompatibleDC(0));
procedure GDIError;
var
ErrorCode: Integer;
Buf: array [Byte] of Char;
begin
ErrorCode := GetLastError;
if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then
raise EOutOfResources.Create(Buf)
else
OutOfResources;
end;

function GDICheck(Value: Integer): Integer;
begin
if Value = 0 then GDIError;
Result := Value;
end;
就是说当创建兼容内存DC的时候，如果创建失败就会GDIError，如果错误码<>0并且不能够从系统中得到相应的错误消息，就会OutOfResources;引发大家讨论的异常
可见
1.楼主的创建新图并Draw的方法不可取，除非不得已，因为系统(特别是98)，系统的位图
资源是有限制的(每个有句柄的窗体都相关一个BMP)，如果是98，资源管理相对较差，更容易出问题
2.楼主的问题我想可能使资源泄漏，但我想应该还是代码不完善的原因
3.再次重申我的观点,任何语言工具.包括VC，其正确性都是在一定的使用条件下成立的
大家很容易在使用VC时出错认为是自己对博大精深的VC掌握不够,但是 Delphi虽然简单
但其实VCL其内部的实际思想比MFC还要先进的,复杂度可以因为先进而降低，但同样是一门博大的系统。我觉得像这样的问题首先请问楼主是否查到了我在上边所指出的错误来源和错误原因呢(当然，只是大概看了一下，如果错误原因不在此也是有可能的,但肯定是类似的地方),那么其他各位呢
Delphi可能会有错误，但其错误肯定不会到处都是
Windows还有BUG呢，这时候大家会把Windows的BUG实现当成一种经验学习,为什么到了Delphi就一定是不可饶恕的错误呢

To:zjan521
目前我正在跟踪 Graphic 单元，初步定位除了 Bug 位置，正在修改这个单元，问题的单元在 Delphi 在处理 DIB 的 Bits 时，没有考虑 Win2000 / NT 的特殊性；

另外，其实我也是 Delphi 的忠实拥护者，只不过因为这个Bug，对我的影响较大，而且这个Bug，一直延续到了 Delphi7 ，这实在难以置信；

另外一个重要的问题是，Delphi 在升级时，兼容性表现较差，尤其是在 COM、ActiveX 方面程序，移植的可能性很低，弄得我最后，还是放弃从 Delphi5 升级到 Delphi6，最后还是回到 delphi5；

另外一个严重的 Bug 就是： 由 Delphi 开发的 ActiveX 控件，在网页里调用时，偶尔会出现 DAX Error 错误，在网上一搜索，就回发现，国内外，有很多人反映出了这个问题，到现在为止（Delphi6），我还发现这个 Bug 依然存在！