Small test program essentially a reformat of the image load routines from Gary Beene's gbImageLab. Wanted to get it working with SDK, incorporate it in a class and see what would happen with transparencies. Full source, images, and exe are here.
Edit: Updated to include loading images from resources. Big thanks to José Roca for the IStream, GdipLoadImageFromStream, and CreateStreamOnHGlobal definitions. The transparent images are now comming from resources while the other formats are comming from files.
Edit: Fixed a bug, removed releasing the IStream (Thanks Edwin), reorganized the code to handle releasing in the event of a failure better.

LoadImage.inc
TestGraphic.bas
Edit: Updated to include loading images from resources. Big thanks to José Roca for the IStream, GdipLoadImageFromStream, and CreateStreamOnHGlobal definitions. The transparent images are now comming from resources while the other formats are comming from files.
Edit: Fixed a bug, removed releasing the IStream (Thanks Edwin), reorganized the code to handle releasing in the event of a failure better.

LoadImage.inc
Code:
' The entire basis of this code is from Gary Beene ' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=48254&highlight=Image[/URL] ' Minor tweaks to switch to SDK and classes ' Supports: bmp, gif, jpg, png, tif, emf #Include Once "win32api.inc" '#Include Once "ole2.inc" '#Include Once "gdiplus.inc" '#Include Once "gdiplusflat.inc" Type GdiplusStartupInput Dword GdiplusVersion As Dword DebugEventCallback As Dword SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Type GdiplusStartupOutput Dword NotificationHook As Dword NotificationUnhook As Dword End Type Interface IStream Guid$("{0000000C-0000-0000-C000-000000000046}") Inherit IUnknown Method Read ( ByVal pv As Dword, ByVal cb As Dword, ByRef pcbRead As Dword ) As Long Method Write ( ByVal pv As Dword, ByVal cb As Dword, ByRef pcbWritten As Dword) As Long Method Seek ( ByVal dlibMove As Quad, ByVal dwOrigin As Dword, ByRef plibNewPosition As Quad) As Long Method SetSize ( ByVal libNewSize As Quad ) As Long Method CopyTo ( ByVal pstm As IStream, ByVal cb As Quad, ByRef pcbRead As Quad, ByRef pcbWritten As Quad) As Long Method Commit ( ByVal grfCommitFlags As Dword ) As Long Method Revert () As Long Method LockRegion ( ByVal libOffset As Quad, ByVal cb As Quad, ByVal dwLockType As Dword) As Long Method UnlockRegion ( ByVal libOffset As Quad, ByVal cb As Quad, ByVal dwLockType As Dword ) As Long Method Stat ( ByRef pstatstg As STATSTG, ByVal grfStatFlag As Dword ) As Long Method Clone ( ByRef ppstm As IStream ) As Long End Interface Declare Function GdiplusStartup Lib "gdiplus.dll" Alias "GdiplusStartup" (ByRef token As Dword, ByRef Input As GdiplusStartupInput, ByRef Output As GdiplusStartupOutput) As Long Declare Sub GdiplusShutdown Lib "gdiplus.dll" Alias "GdiplusShutdown" (ByVal token As Dword) Declare Function GdipGetImageWidth Lib "GDIPLUS.DLL" Alias "GdipGetImageWidth" (ByVal Image As Dword, ByRef Width As Dword) As Long Declare Function GdipGetImageHeight Lib "GDIPLUS.DLL" Alias "GdipGetImageHeight" (ByVal Image As Dword, ByRef height As Dword) As Long Declare Function GdipCreateFromHDC Lib "gdiplus.dll" Alias "GdipCreateFromHDC" (ByVal hdc As Dword, ByRef graphics As Dword) As Long Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" Alias "GdipLoadImageFromFile" (ByVal filename As Dword, ByRef Image As Dword) As Long Declare Function GdipDrawImage Lib "gdiplus.dll" Alias "GdipDrawImage"(ByVal graphics As Dword, ByVal Image As Dword, ByVal x As Single, ByVal y As Single) As Long ' GpStatus Declare Function GdipDisposeImage Lib "gdiplus.dll" Alias "GdipDisposeImage" (ByVal Image As Dword) As Long Declare Function GdipDeleteGraphics Lib "gdiplus.dll" Alias "GdipDeleteGraphics" (ByVal graphics As Dword) As Long Declare Function GdipDrawImageRectI Lib "gdiplus.dll" Alias "GdipDrawImageRectI" (ByVal hGraphics???, ByVal nImage???, ByVal x&,ByVal y&, ByVal nWidth&, ByVal nHeight&) As Long Declare Function GdipLoadImageFromStream Lib "gdiplus.dll" Alias "GdipLoadImageFromStream" ( ByVal stream As IStream, ByRef Image As Dword ) As Long Declare Function CreateStreamOnHGlobal Lib "ole32.dll" Alias "CreateStreamOnHGlobal" ( ByVal hGlobal As Dword, ByVal fDeleteOnRelease As Long, ByRef ppstm As IStream ) As Long ' HRESULT Declare Function EmptyWorkingSet Import "psapi.dll" Alias "EmptyWorkingSet" ( ByVal hProcess As Dword ) As Long Global gdiPInit As Long Global gdiPtoken As Dword Sub AquireGdiPlus() Local StartupInput As GdiplusStartupInput If gdiPInit = 0 Then StartupInput.GdiplusVersion = 1 Call GdiplusStartup(gdiPtoken, StartupInput, ByVal %NULL) End If Incr gdiPInit End Sub Sub ReleaseGdiPlus() If gdiPInit>0 Then Decr gdiPInit If gdiPInit=0 Then Call GdiplusShutdown( gdiPtoken ) ' Shutdown GDI+ End If End If End Sub Function NewBitmap( ByVal w As Long, ByVal h As Long, ByVal bg As Dword ) Common Export As iBitmap Local obj As iBitmap obj = Class "cBitmap" obj.New( w, h, bg ) Function = obj End Function Function NewBitmapFromFile( filename As WString, bg As Dword ) Common Export As iBitmap Local obj As iBitmap obj = Class "cBitmap" obj.NewFromFile( filename, bg ) Function = obj End Function Function NewBitmapFromResource( resource As WStringZ, ByVal pType As Dword, ByVal bgClr As Dword ) Common Export As iBitmap Local obj As iBitmap obj = Class "cBitmap" obj.NewFromResource( resource, pType, bgClr ) Function = obj End Function Class cBitmap Guid$("{e84f7e44-a682-454c-a9c2-8d0d74034bab}") Common Instance width_ As Long Instance height_ As Long Instance hBmp As Dword Class Method Create() End Method Class Method Destroy() If hBmp Then DeleteObject( hBmp ) End Method Interface iBitmap Guid$("{191e05ff-5fa9-44a1-b301-30deb3126e3d}") Inherit IUnknown Property Get Handle() As Dword Property = hBmp End Property Property Get Width() As Long Property = width_ End Property Property Set Width( ByVal value As Long ) width_ = value End Property Property Get Height() As Long Property = height_ End Property Property Set Height( ByVal value As Long ) height_ = value End Property Method New( ByVal w As Long, ByVal h As Long, ByVal bgColor As Dword ) Local hdc As Dword Local mhdc As Dword If hBmp Then DeleteObject( hBmp ) hBmp = 0 End If hdc = GetDC( ByVal %NULL ): ' Desktop DC mhdc = CreateCompatibleDC( hdc ) hBmp = CreateCompatibleBitmap( hdc, w, h ) width_ = w height_ = h Me.Clear( bgColor ) DeleteDC( mhdc ) ReleaseDC( ByVal %NULL, hdc ) End Method Method AddFromFile( filename As WString, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long) Local pGraphics As Dword Local pImage As Dword Local mhdc As Dword Local hdc As Dword Local strFileName As WString Local token As Dword Local imgW As Long Local imgH As Long Local filenamez As WStringZ Ptr filenamez = StrPtr( filename ) Call AquireGdiPlus() Call GdipLoadImageFromFile( fileNamez, pImage) 'pImage - image object Local pImg As Dword hdc = GetDC( ByVal %NULL ): ' Desktop DC mhdc = CreateCompatibleDC( hdc ) pImg = SelectObject( mhdc, hBmp ) Call GdipCreateFromHDC( mhdc, pGraphics ) 'pGraphics - graphic object Call GdipDrawImageRectI( pGraphics, pImage, l, t, w, h ) 'draw on graphic object - hBMP now contains image from file If pImage Then Call GdipDisposeImage(pImage) 'delete image object If pGraphics Then Call GdipDeleteGraphics(pGraphics) 'delete graphic object Call ReleaseGdiPlus() ReleaseDC( ByVal %NULL, hdc ) SelectObject( mhdc, pImg ) DeleteDC( mhdc ) End Method Method NewFromFile( filename As WString, ByVal bg As Dword) Local pGraphics As Dword Local pImage As Dword Local mhdc As Dword Local hdc As Dword Local token As Dword Local hBMP As Dword Local filenamez As WStringZ Ptr filenamez = StrPtr( filename ) Call AquireGdiPlus() Call GdipLoadImageFromFile( filenamez, pImage) 'pImage - image object Call GdipGetImageWidth( pImage, width_ ) Call GdipGetImageHeight( pImage, height_ ) If hBmp Then DeleteObject( hBmp ): hBmp = 0 Me.New( width_, height_, bg ) Me.AddFromFile( filename, 0, 0, width_, height_ ) Call ReleaseGdiPlus() End Method Method AddFromResource( resource As WStringZ, ByVal pType As Dword, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long ) Local hResource As Dword Local hInst As Dword Local pImage As Dword Local hdc As Dword Local mhdc As Dword Local pImg As Dword Local pRes As Dword Local hBuf As Dword Local pBuf As Byte Ptr Local pStream As IStream Local pGraphics As Dword Local imageSize As Dword hInst = GetModuleHandle( ByVal 0 ) Call AquireGdiPlus() hResource = FindResource( hInst, resource, ByVal pType) If IsFalse hResource Then Exit Method imageSize = SizeofResource( hInst, hResource) If IsFalse imageSize Then Exit Method pRes = LockResource( LoadResource( hInst, hResource ) ) If IsFalse pRes Then Exit Method hBuf = GlobalAlloc( %GMEM_MOVEABLE, imageSize ) If hBuf Then pBuf = GlobalLock(hBuf) If pBuf Then Memory Copy pRes, pBuf, imageSize If CreateStreamOnHGlobal( hBuf, %FALSE, pStream ) = %S_Ok Then GdipLoadImageFromStream( pStream, pImage ) hdc = GetDC( ByVal %NULL ): ' Desktop DC mhdc = CreateCompatibleDC( hdc ) pImg = SelectObject( mhdc, hBmp ) If GdipCreateFromHDC( mhdc, pGraphics ) = %S_Ok Then 'pGraphics - graphic object GdipDrawImageRectI( pGraphics, pImage, l, t, w, h ) 'draw on graphic object - hBMP now contains image from file End If SelectObject( mhdc, pImg ) DeleteDC( mhdc ) ReleaseDC( ByVal %NULL, hdc ) If pImage Then Call GdipDisposeImage(pImage) 'delete image object If pGraphics Then Call GdipDeleteGraphics(pGraphics) 'delete graphic object 'pStream.Release() 'skipping per Edwin's advice End If GlobalUnlock(hBuf) End If GlobalFree(hBuf) End If Call ReleaseGdiPlus() End Method Method NewFromResource( resource As WStringZ, ByVal pType As Dword, ByVal bgClr As Dword ) Local hResource As Dword Local hInst As Dword Local pImage As Dword Local hdc As Dword Local mhdc As Dword Local pImg As Dword Local pRes As Byte Ptr Local hBuf As Dword Local pBuf As Byte Ptr Local pStream As IStream Local pGraphics As Dword hInst = GetModuleHandle( ByVal 0 ) Call AquireGdiPlus() hResource = FindResource( hInst, resource, ByVal pType) If IsFalse hResource Then Exit Method Local imageSize As Dword imageSize = SizeofResource( hInst, hResource) If IsFalse imageSize Then Exit Method pRes = LockResource( LoadResource( %NULL, hResource ) ) If IsFalse pRes Then Exit Method hBuf = GlobalAlloc( %GMEM_MOVEABLE, imageSize ) If hBuf Then pBuf = GlobalLock( hBuf ) If pBuf Then Memory Copy pRes, pBuf, imageSize If CreateStreamOnHGlobal( hBuf, %FALSE, pStream ) = %S_Ok Then Call GdipLoadImageFromStream( pStream, pImage ) Call GdipGetImageWidth( pImage, width_ ) Call GdipGetImageHeight( pImage, height_ ) Me.New( width_, height_, bgClr ) hdc = GetDC( ByVal %NULL ): ' Desktop DC mhdc = CreateCompatibleDC( hdc ) pImg = SelectObject( mhdc, hBmp ) If GdipCreateFromHDC( mhdc, pGraphics ) = %S_Ok Then 'pGraphics - graphic object Call GdipDrawImageRectI( pGraphics, pImage, 0, 0, width_, height_ ) 'draw on graphic object - hBMP now contains image from file End If SelectObject( mhdc, pImg ) DeleteDC( mhdc ) ReleaseDC( ByVal %NULL, hdc ) If pImage Then Call GdipDisposeImage(pImage) 'delete image object If pGraphics Then Call GdipDeleteGraphics(pGraphics) 'delete graphic object 'pStream.Release() 'skipping per Edwin's advice End If GlobalUnlock( hBuf ) End If GlobalFree( hBuf ) End If Call ReleaseGdiPlus() End Method Method Clear( ByVal bgClr As Dword ) Local hdc As Dword Local mhdc As Dword Local pImg As Dword Local br As Dword Local rc As RECT If IsFalse hBmp Then Exit Method hdc = GetDC( ByVal %NULL ): ' Desktop DC mhdc = CreateCompatibleDC( hdc ) pImg = SelectObject( mhdc, hBmp ) br = CreateSolidBrush( bgClr ) Call SetRect( rc, 0, 0, width_, height_ ) FillRect( mhdc, rc, br ) DeleteObject( br ) SelectObject( mhdc, pImg ) DeleteDC( mhdc ) ReleaseDC( ByVal %NULL, hdc ) End Method End Interface End Class
Code:
#Compile Exe "TestGraphic.exe" #Dim All #Compiler PBWin 10 #Register All #Resource Manifest, 1, "theme.xml" %UNICODE =1 #Include Once "win32api.inc" #Include Once "LoadImage.inc" %IMG_PAWS = 1 %IMG_LOGO = 2 %IMG_GER_BMP = 3 #Resource RcData, 1, "paws.png" #Resource RcData, 2, "logo3.png" #Resource RcData, 3, "Gershwin.bmp" $TESTGRAPHIC_CLASS = "lcTestGraphic" Global img() As iBitmap Function PBMain () As Long Local hTestGraphic As Dword Local i As Long Local im As iBitmap ' for i=0 to 100000 ' im = NewBitmapFromResource( ByVal MAKEINTRESOURCE(%IMG_PAWS), %RT_RCDATA, RGB(254,218,165) ) ' im = Nothing ' EmptyWorkingSet( GetCurrentProcess() ) ' Next Dim img(4) img(0) = NewBitmap( 384, 128, RGB(254,218,165) ) For i=0 To 256 Step 128 img(0).AddFromResource( ByVal MAKEINTRESOURCE(%IMG_PAWS), %RT_RCDATA, i, 0, 128, 128 ) Next img(0).AddFromResource( ByVal MAKEINTRESOURCE(%IMG_LOGO), %RT_RCDATA, 0, 0, 384, 128 ) img(1) = NewBitmapFromResource( ByVal MAKEINTRESOURCE(%IMG_GER_BMP), %RT_RCDATA, RGB(255,255,255) ) img(2) = NewBitmapFromFile( "Gershwin.gif", RGB(255,255,255) ) img(3) = NewBitmapFromFile( "Gershwin.jpg", RGB(255,255,255) ) img(4) = NewBitmapFromFile( "Gershwin.tif", RGB(255,255,255) ) hTestGraphic = TestGraphic_CreateWindow() ShowWindow( hTestGraphic, %SW_ShowNormal ) UpdateWindow( hTestGraphic ) Call TestGraphic_Run( hTestGraphic ) End Function Function TestGraphic_WndProc( ByVal hTestGraphic As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long Function = 0 Select Case As Const wMsg Case %WM_EraseBkgnd: Exit Function Case %WM_Destroy: PostQuitMessage( 0 ): Exit Function Case %WM_Paint: TestGraphic_OnPaint( hTestGraphic ): Exit Function End Select Function = DefWindowProc( hTestGraphic, wMsg, wParam, lParam ) End Function Sub TestGraphic_OnPaint( ByVal hTestGraphic As Dword ) Local rc As RECT Local br As Dword Local hdc As Long Local hImg As Long Local mhdc As Long Local ps As PAINTSTRUCT hdc = BeginPaint( hTestGraphic, ps ) GetClientRect( hTestGraphic, rc ) hImg = CreateCompatibleBitmap(hdc, rc.right, rc.bottom) mhdc = CreateCompatibleDC(hdc) SelectObject( mhdc, hImg ) br = CreateSolidBrush( GetSysColor( %COLOR_WINDOW ) ) FillRect( mhdc, rc, br ): ' Erase the area DeleteObject( br ) ' Draw other stuff Local hdc2 As Dword Local pImg As Dword hdc2 = CreateCompatibleDC(mhdc) pImg = SelectObject( hdc2, img(0).Handle ) Local i As Long For i=0 To 4 SelectObject( hdc2, img(i).Handle ) BitBlt( mhdc, 0, 128*i, img(i).Width, img(i).Height, hdc2, 0, 0, %SRCCOPY ) Next SelectObject( hdc2, pImg ) DeleteDC( hdc2 ) GetClientRect( hTestGraphic, rc ) Call BitBlt( hdc, 0,0,rc.right,rc.bottom, mhdc, 0, 0, %SRCCOPY ) DeleteDc( mhdc ) DeleteObject( hImg ) EndPaint( hTestGraphic, ps ) End Sub Sub TestGraphic_RegisterClasses() Local wc As WNDCLASSEX Local className As WStringZ*20 Static gInit As Long If gInit Then Exit Sub: ' Already registered gInit = -1 If GetClassInfoEx(%NULL, $TESTGRAPHIC_CLASS, wc) Then Exit Sub: ' Already registered (another app) ' Register class for Overlapped window className = $TESTGRAPHIC_CLASS wc.cbsize = SizeOf(wc) wc.style = %CS_HREDRAW Or %CS_VREDRAW wc.lpfnWndProc = CodePtr( TestGraphic_WndProc ) wc.cbClsExtra = 0 wc.cbWndExtra = 0: ' No window data wc.hInstance = GetModuleHandle( ByVal 0 ) wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION ) wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW) wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE wc.lpszMenuName = 0 wc.lpszClassName = VarPtr(className) If RegisterClassEx( wc )=0 Then MsgBox "RegisterClass for TestGraphic failed" End End If End Sub Function TestGraphic_CreateWindow() Common As Dword Local hTestGraphic As Dword Call TestGraphic_RegisterClasses() hTestGraphic = CreateWindowEx( 0, $TESTGRAPHIC_CLASS, "Test Graphics", %WS_OverlappedWindow Or %WS_ClipChildren, %CW_USEDEFAULT, %CW_USEDEFAULT, 512, 740, %NULL, %NULL, GetModuleHandle( ByVal 0 ), ByVal 0 ) Function = hTestGraphic End Function Global hawnd As Dword Sub SetAppActiveWindow( ByVal hWnd As Dword ) hawnd = hWnd End Sub Function TestGraphic_Run(ByVal hTestGraphic As Long) As Long Local msg As tagMSG Do While GetMessage( msg, %NULL, 0, 0 )>0 If hawnd=0 Or IsDialogMessage( hawnd, msg ) = 0 Then TranslateMessage( msg ) DispatchMessage( msg ) End If Loop End Function
Comment