Delphi的TBitmap控件是否有问题？

Question

在一个工作线程里，调用几次 TBitmap.SaveToFile(或者SaveToFile)，就会产生异常：
EOutOfResouces

Answer 1

你有没有代码贴出来？如果只是你贴出的那句，SaveToFile应该是由实例调用的吧。

Answer 2

procedure TTestThread.Execute;
var
  arrBitmap:array[0..5] of TBitmap;
  i: Integer;
begin
  for i:=0 to 5 do
  begin
    arrBitmap[i]:=Tbitmap.Create;
    try
      arrBitmap[i].Width:=400;
      arrBitmap[i].Height:=300;
      arrBitmap[i].Canvas.LineTo(400,300);
      arrBitmap[i].SaveToFile('F:\Test'+IntToStr(i)+'.bmp');
    finally
      arrBitmap[i].Free;
    end;
  end;
end;
这个线程调用了5次SaveToFile，Delphi2005 + WinXP 没出现问题。

Answer 3

我将一个EMF转换成BMP，有时我要将80多张的EMF转换成BMP。但是有时就会出现在Image1.Picture.Bitmap.SaveToFile(m_BmpDestFile);出错。我跟了一下就是在
TGraphic.SaveToStream(Stream);处出错EOutOfResouces。不知是为什么。并且这种错误是随即发生的。不是每次都出现。搞不懂了！！！下面是我的代码段！！function TPrintControl.EMF2BMP(FileDir: String): Boolean;
var
  SearchRes : TSearchRec;
  nFound, i : Integer;
  reg       : TRegistry;
  m_DestDir:String;
  DivNum,ModNum:integer;
  EmfPath:string;
  m_BmpDestFile,m_Dest:String;
  Curr:Integer;
  NewFont,OldFont:HFont;
  {****定义加载的image****}
  Image1,Image2: TImage;
begin
  Image1:=TImage.Create(nil);
  Image2:=TImage.Create(nil);
  reg:=TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  if reg.OpenKey(PMON_KEY,TRUE) then
  begin
    BmpNum:=reg.ReadInteger('BmpNum');
    reg.CloseKey;
  end;
  reg.Free;
  Curr:=0;
    nFound := FindFirst(FileDir+'\*.emf', faAnyFile, SearchRes);
    while nFound = 0 do
    begin
      EmfPath:='';
      try
        EmfPath:=FileDir+'\'+SearchRes.Name;
        Image2.Picture.Metafile.LoadFromFile(EmfPath);
        Image1.Picture.Assign(nil);
        case BmpNum of
        1: Image1.Picture.Bitmap.PixelFormat:=pf1bit;
        4: Image1.Picture.Bitmap.PixelFormat:=pf4bit;
        16:Image1.Picture.Bitmap.PixelFormat:=pf16bit;
        24:Image1.Picture.Bitmap.PixelFormat:=pf24bit;
        32:Image1.Picture.Bitmap.PixelFormat:=pf32bit;
        end;
        Image1.Picture.Bitmap.Width:=Image2.Picture.Metafile.Width;
        Image1.Picture.Bitmap.Height:=Image2.Picture.Metafile.Height;
        //如果EMF文件有错
        if (Image1.Picture.Bitmap.Width=0) or (Image1.Picture.Bitmap.Height=0) then
        begin
          nFound := FindNext(SearchRes);
          continue;
        end;
        Image1.Picture.Bitmap.Canvas.Draw(0,0,Image2.Picture.Metafile);
        m_BmpDestFile:=ChangeFileExt(EmfPath,'.bmp');
        if FileExists(m_BmpDestFile) then
        begin
          DeleteFile(m_BmpDestFile);
        end;
        try
          Image1.Picture.Bitmap.SaveToFile(m_BmpDestFile);
        except
          if FileExists(m_BmpDestFile) then
          begin
            DeleteFile(m_BmpDestFile);
          end;
        end;
        m_BmpDestFile:='';
      except
      end;
      nFound := FindNext(SearchRes);
    FindClose(SearchRes);
  end;
  FreeAndNIl(Image1);
  FreeAndNIl(Image2);
  Result:=true;
end;本来我用TBITMAP.FREE来释放我定义的BMP对象，可是当转换80次的时候就会出现内存根本释放不掉的现象。在任务管理器中会看到内存狂涨。然后就是死机。不得已我使用了TImage对象。

Answer 4

alexanda2000(Delphi2005，好用 ^_^) 。
你的代码有没有看你的内存的增长？

Answer 5

我手头上没有emf文件，测试不了。

Answer 6

那你使用了5次的Tbitmap对象，内存没有增加吗？

Answer 7

奇怪了，可能是我的图片太大的原因（转换城BMP每张7.8MB），内存增长很快！
谢谢您了！

Answer 8

我仔细的跟踪了一下，你说的的确不会出现内存的泄漏可是你有没有测试过savetofile出错的时候的情况呢。我的跟踪结果是这样的！
Tbitmap.SaveToFile函数是调用的TGraphic.SaveToFile(const Filename: string);
在TGraphic中代码是这样写的：
procedure TGraphic.SaveToFile(const Filename: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(Filename, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;在这个代码中如果说SaveToStream(Stream)出错,在我的程序中就会有Out of System Resources 错误。出现了这个错误以后，内存就会泄漏。即便是使用了Stream.Free;或者是Tbitmap.Free还是FreeAndNIL（TBitmap）这部分泄漏的内存都没有办法释放（在任务管理其中显示）。这是怎么回事，搞不动了！

Answer 9

这句似乎没什么用，而且可能导致删除的同时创建一个新文件，去掉试试。        if FileExists(m_BmpDestFile) then
        begin
          DeleteFile(m_BmpDestFile);
        end;

Answer 10

觉得你的过程写得太长了，建议拆分成几个短的过程
另外，FindClose(SearchRes);
如果我没看错的话，这句放在While里面了
是不是应该放到外面？

Answer 11

我根据你的代码写了一个简化的EMF2BMP的过程，去掉了注册表操作、BMP格式设定，不检查文件是否已存在。用了400个emf文件测试，转换后的BMP也达到几十M，程序运行结束后没发现内存增长。试验了一下中途出现异常的情况，内存也得到释放了。我测试的代码如下：function TForm1.EMF2BMP(Des, Src: String): Boolean;
//参数分别代表目的目录和源目录，目录以'\'结束。
var
  Found:Integer;
  F:TSearchRec;
  b:TBitmap;
  e:TMetafile;
begin
  Result:=False;
  if not (DirectoryExists(Des) and DirectoryExists(Src)) then
    Exit;
  b:=TBitmap.Create;
  try
    e:=TMetafile.Create;
    try
      Found:=FindFirst(Src+'*.emf',faAnyFile,F);
      while Found=0 do
      begin
        e.LoadFromFile(Src+F.Name);
        b.Width:=e.Width;
        b.Height:=e.Height;
        b.Canvas.Draw(0,0,e);
        b.SaveToFile(Des+ChangeFileExt(F.Name,'.bmp'));
        Found:=FindNext(F);
      end;
    finally
      e.Free;
      FindClose(F);
    end;
  finally
    b.Free;
  end;
  Result:=True;
end;

Answer 12

问题找到了，TBITMAP在线程中使用的时候就是有问题！我的问题已经改好了。呵呵！！
明天结帐！