VB GdipLoadImageFromStream 内存问题

wszjljx

Public Sub ByteDrawImage(ImageData() As Byte, ByVal DeviceHandle As Long, Optional ByVal Left As Long = 0, Optional ByVal Top As Long = 0, Optional ByVal Width As Long = 0, Optional ByVal Height As Long = 0)

On Error Resume Next

Dim GdiValue As Long
Dim DrawWidth As Long
Dim DrawHeight As Long
Dim ImageValue As Long
Dim StreamValue As Long
Dim GdiDeviceHandle As Long
Dim GdiObject As GdiplusStartupInput

If DeviceHandle = 0 Then Exit Sub

DrawWidth = Width
DrawHeight = Height

GdiObject.GdiplusVersion = 1

Call GdiplusStartup(GdiValue, GdiObject)
Call GdipCreateFromHDC(DeviceHandle, GdiDeviceHandle)
Call CreateStreamOnHGlobal(ImageData(0), 0, StreamValue)
Call GdipLoadImageFromStream(StreamValue, ImageValue)

If DrawWidth <= 0 Then Call GdipGetImageWidth(ImageValue, DrawWidth)
If DrawHeight <= 0 Then Call GdipGetImageHeight(ImageValue, DrawHeight)

Call GdipDrawImageRect(GdiDeviceHandle, ImageValue, Left, Top, DrawWidth, DrawHeight)

Call GdipDisposeImage(ImageValue)
Call GdipDeleteGraphics(GdiDeviceHandle)
Call GdiplusShutdown(GdiValue)

End Sub

利用此代码直接将字节数组图片绘制在窗体上 但是每绘制一次使用的内存就会增大 不清楚该如何释放
经检查 导致内存增加不释放的时CreateStreamOnHGlobal该API函数
求教如何释放此函数创建的流对象...

wszjljx

API函数及类型定义:


Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As Long, ByRef image As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)

Private Enum GpStatus
  Ok = 0
  GenericError = 1
  InvalidParameter = 2
  OutOfMemory = 3
  ObjectBusy = 4
  InsufficientBuffer = 5
  NotImplemented = 6
  Win32Error = 7
  WrongState = 8
  Aborted = 9
  FileNotFound = 10
  ValueOverflow = 11
  AccessDenied = 12
  UnknownImageFormat = 13
  FontFamilyNotFound = 14
  FontStyleNotFound = 15
  NotTrueTypeFont = 16
  UnsupportedGdiplusVersion = 17
  GdiplusNotInitialized = 18
  PropertyNotFound = 19
  PropertyNotSupported = 20
End Enum

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

马大哈

1. 　　函数原型： 　　WINOLEAPI CreateStreamOnHGlobal(
   
2. 　　HGLOBAL hGlobal, // Memory handle for the stream object
   
3. 　　BOOL fDeleteOnRelease, // Whether to free memory when the object is released
   
4. 　　LPSTREAM *ppstm // Address of output variable that receives the IStream interface pointer 　　);

复制代码

看起来StreamValue这个参数是个指针,并且指向的是一个接口,如果这个接口被实现了,那就是一个对象.

用closehandle关闭这个句柄试试吧.

wszjljx

closehandle的话VB直接弹出内存不能为READ

那个问题我已经解决了 API的第二个参数为1就行...
又有了新的问题... Call GdiplusStartup(GdiValue, GdiObject)这行 也会每运行一次内存使用多4KB...

wszjljx

问题已解决 ... 不要绘制一次就初始化一次GDI+库 再销毁一次
先初始化GDI+库 就可以画图了 不用销毁
程序Unload时再销毁就行... 内存使用终于不再彪了...

马大哈

汗,哈哈.

内存泄漏啊内存泄漏!{:soso_e113:}

wszjljx

现在完美的解决方案模块我发一份 内存基本不产生问题
主要是GdiplusStartup初始化的GDI+库GdiplusShutdown不能完全释放掉
所以不要每次绘图加载一次卸载一次 只要第一次绘图时加载 在程序退出的时候卸载就好...

模块下载地址:http://www.m5home.com/bbs/thread-5952-1-1.html

Tesla.Angela

楼主的精华已经达到两篇，现在把你的用户组改为核心会员！

msdtx

7 楼提供的模块也有问题，Steam 不能定义为 object 类型，在IDE 中调试会崩溃。应该是Iunknown 类型。这个模块帮了我不少忙啊。

wszjljx

的确在IDE环境有时候会崩溃 那是因为你在程序退出时没有调用DestroyGDI来卸载GDI+库 如果正常卸载掉了 不会有问题的