Announcement

Collapse
No announcement yet.

Loading image formats

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Loading image formats

    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
    Code:
    ' The entire basis of this code is from Gary Beene
    ' http://www.powerbasic.com/support/pb...ighlight=Image
    ' 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
    TestGraphic.bas
    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
    Last edited by Larry Charlton; 9 Oct 2011, 07:10 PM. Reason: Was deleting wrong bitmap in paint.
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

  • #2
    You release the stream object manually, is that ok?
    I don't think so(?)
    hellobasic

    Comment


    • #3
      Originally posted by Edwin Knoppert View Post
      You release the stream object manually, is that ok?
      I don't think so(?)
      Bit new to GDI+ (minutes old really), I thought since I had set the fDeleteOnRelease to false in CreateStreamOnHGlobal, I should be releasing it. Any hints appreciated, I'll see what I can find otherwise.
      LarryC
      Website
      Sometimes life's a dream, sometimes it's a scream

      Comment


      • #4
        Well I did find one bug in the Paint code, I was releasing the wrong bitmap. Testing constantly loading images from resources, if I don't release, the program consumes ever increasing quantities of memory. If I release, it's still consuming memory but at a greatly reduced rate. It feels like since PB didn't create the IStream, I probabbly need to release it.

        I believe I have another memory leak I need to find as well. If anyone has references to docs or whatever that might help my poor understanding, it would be much appreciated.
        LarryC
        Website
        Sometimes life's a dream, sometimes it's a scream

        Comment


        • #5
          Well I threw in EmptyWorkingSet and the program doesn't appear to be leaking memory whether I release or not. Since I have no clue what's happening under the covers, I'll lean on Edwin's advice and stop releasing the stream.
          LarryC
          Website
          Sometimes life's a dream, sometimes it's a scream

          Comment


          • #6
            Version 2

            Decided to create a GDI Plus class. It can load from file, image, or a color.

            The images can be drawn on a DC, create a bitmap, or draw in an existing bitmap.

            I'm liking this better than the last version, you can download the working project from here.

            Edit: Comments, added slow fade in for tests, added a border with transparent center to test stretching and larger graphics, centered images.

            GDIPlusImage.inc
            Code:
            ' The entire basis of image loading from files is from Gary Beene
            ' http://www.powerbasic.com/support/pb...ighlight=Image
            ' Minor tweaks to switch to SDK and classes
            ' Several header definitions from José Roca
            ' Removed IStream.Release per Edwin's advice
            ' Supports: bmp, gif, jpg, png, tif, emf
             
            #Include Once "win32api.inc"
             
            Type argbData
              b As Byte
              g As Byte
              r As Byte
              a As Byte
            End Type
            Union argbOver
              value As Dword
              argb As argbData
            End Union
             
            Type ColorMatrix Dword
               m (4, 4) As Single
            End Type
             
            Function ARGB( ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte ) Common Export As Dword
              Local v As argbOver
              v.argb.a = a
              v.argb.r = r
              v.argb.g = g
              v.argb.b = b
              Function = v.value
            End Function
             
            Type GdiplusStartupInput Dword
               GdiplusVersion           As Dword
               DebugEventCallback       As Dword
               SuppressBackgroundThread As Long
               SuppressExternalCodecs   As Long
            End Type
             
            %PixelFormat32bppARGB      = 2498570
            %ImageLockModeWrite        = &H0002???
            %ImageLockModeRead         = &H0001???
            %ColorAdjustTypeDefault    = 0
            %ColorMatrixFlagsDefault   = 0
            %UnitPixel                 = 2
            %FillModeAlternate = 0
            %FillModeWinding   = 1
             
            Type GdiplusStartupOutput Dword
               NotificationHook   As Dword
               NotificationUnhook As Dword
            End Type
             
            Type BitmapData Dword
               Width       As Dword   ' UINT
               Height      As Dword   ' UINT
               Stride      As Long    ' INT
               PixelFormat As Long    ' PixelFormat
               Scan0       As Dword   ' VOID*
               Reserved    As Dword   ' UINT_PTR
            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 GdipCreateBitmapFromGraphics Lib "gdiplus.dll" Alias "GdipCreateBitmapFromGraphics" ( ByVal Width As Long, ByVal height As Long, ByVal target As Dword, ByRef Bitmap 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              Lib "psapi.dll"   Alias "EmptyWorkingSet" ( ByVal hProcess As Dword ) As Long
            Declare Function GdipCreateSolidFill          Lib "gdiplus.dll" Alias "GdipCreateSolidFill" ( ByVal Color As Dword, ByRef brush As Dword ) As Long
            Declare Function GdipFillRectangleI           Lib "gdiplus.dll" Alias "GdipFillRectangleI" ( ByVal graphics As Dword, ByVal GpBrush As Dword, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal height As Long ) As Long
            Declare Function GdipDeleteBrush              Lib "gdiplus.dll" Alias "GdipDeleteBrush" ( ByVal brush As Dword ) As Long
            Declare Function GdipGetImageGraphicsContext  Lib "gdiplus.dll" Alias "GdipGetImageGraphicsContext" ( ByVal Image As Dword, ByRef graphics As Dword ) As Long
            Declare Function GdipBitmapLockBits           Lib "gdiplus.dll" Alias "GdipBitmapLockBits" ( ByVal Bitmap As Dword, ByRef rect As RECT, ByVal flags As Dword, ByVal format As Long, ByRef lockedBitmapData As BitmapData ) As Long
            Declare Function GdipBitmapUnlockBits         Lib "gdiplus.dll" Alias "GdipBitmapUnlockBits" ( ByVal Bitmap As Dword, ByRef lockedBitmapData As BitmapData ) As Long
            Declare Function GdipCreateImageAttributes    Lib "gdiplus.dll" Alias "GdipCreateImageAttributes" ( ByRef imageattr As Dword ) As Long
            Declare Function GdipDrawImageRectRectI       Lib "gdiplus.dll" Alias "GdipDrawImageRectRectI" ( ByVal graphics As Dword, ByVal Image As Dword, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, _
                                            ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Dword, _
                                            ByVal callback As Dword, ByVal callbackData As Dword ) As Long
            Declare Function GdipSetImageAttributesColorMatrix Lib "gdiplus.dll" Alias "GdipSetImageAttributesColorMatrix" ( ByVal imageattr As Dword, ByVal Type As Long, _
                                            ByVal enableFlag As Long, colorMatrix As ColorMatrix, grayMatrix As ColorMatrix, ByVal flags As Long ) As Long
            Declare Function GdipDisposeImageAttributes   Lib "gdiplus.dll" Alias "GdipDisposeImageAttributes" ( ByVal imageattr As Long ) As Long
            Declare Function GdipCreatePath Lib "gdiplus.dll" Alias "GdipCreatePath" ( ByVal brushMode As Long, ByRef Path 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 NewGDIPlusImage(ByVal w As Long, ByVal h As Long, ByVal bgClr As Dword ) Common Export As iGDIPlusImage
              Local obj As iGDIPlusImage
              obj = Class "cGDIPlusImage"
              obj.New( w, h, bgClr )
              Function = obj
            End Function
             
            Function NewGDIPlusImageFromFile( filename As WString ) Common Export As iGDIPlusImage
              Local obj As iGDIPlusImage
              obj = Class "cGDIPlusImage"
              obj.FromFile( filename )
              Function = obj
            End Function
             
            Function NewGDIPlusImageFromResource( resource As WStringZ, ByVal pType As Dword ) Common Export As iGDIPlusImage
              Local obj As iGDIPlusImage
              obj = Class "cGDIPlusImage"
              obj.FromResource( resource, pType )
              Function = obj
            End Function
             
            Class cGDIPlusImage Guid$("{2c2592d0-e9e4-41e4-aa7b-3f38a6514fe4}") Common
              Instance pImage As Dword
              Instance width_ As Long
              Instance height_ As Long
              Instance alpha_ As Long
             
              Class Method Create()
                Call AquireGdiPlus()
                alpha_ = 255
              End Method
              Class Method Destroy()
                Me.FreeGDI()
                Call ReleaseGdiPlus()
              End Method
             
              Class Method FreeGDI()
                If pImage Then Call GdipDisposeImage(pImage)          ' delete image object
                pImage = 0
                width_ = 0
                height_ = 0
              End Method
             
              Class Method SetAttributes() As Dword
                Local attr As Dword
                Local cm As ColorMatrix
             
                GdipCreateImageAttributes( attr )
                cm.m(0,0) = 1
                cm.m(1,1) = 1
                cm.m(2,2) = 1
                cm.m(3,3) = CSng( alpha_ ) / 255!
                cm.m(4,4) = 1
                GdipSetImageAttributesColorMatrix( attr, %ColorAdjustTypeDefault, %TRUE, cm, ByVal 0, %ColorMatrixFlagsDefault )
                Method = attr
              End Method
              Class Method ReleaseAttributes( ByVal attr As Dword )
                GdipDisposeImageAttributes( attr )
              End Method
             
             
              Interface iGDIPlusImage Guid$("{de4452db-9941-4402-8ec2-3ff7f2c77308}")
                Inherit IUnknown
             
                Property Get Width() As Long
                  Property = width_
                End Property
                Property Get Height() As Long
                  Property = height_
                End Property
             
                Method New(ByVal w As Long, ByVal h As Long, ByVal bgColor As Dword )
                  Local pGraphics As Dword
                  Local hdc As Dword
                  Local mhdc As Dword
                  Local br As Dword
                  Local stat As Long
             
                  Me.FreeGDI()
                  hdc = GetDC( ByVal %NULL ):                               ' Desktop DC
                  mhdc = CreateCompatibleDC( hdc )
             
                  If GdipCreateFromHDC( mhdc, pGraphics ) = %S_Ok Then                  ' pGraphics - graphic object
                    stat = GdipCreateBitmapFromGraphics(w, h, pGraphics, pImage )
                  End If
                  If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                  If GdipGetImageGraphicsContext( pImage, pGraphics ) = %S_Ok Then
                    stat = GdipCreateSolidFill( bgColor, br )
                    stat = GdipFillRectangleI( pGraphics, br, 0, 0, w, h)
                    width_ = w
                    height_ = h
                    GdipDeleteBrush( br )
                  End If
                  If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                  DeleteDC( mhdc )
                  ReleaseDC( ByVal %NULL, hdc )
                End Method
             
                Method FromFile( filename As WString )
                  Me.FreeGDI()
                  Call GdipLoadImageFromFile( StrPtr(filename), pImage)            ' pImage - image object
                  Call GdipGetImageWidth( pImage, width_ )
                  Call GdipGetImageHeight( pImage, height_ )
                End Method
             
                Property Get Alpha() As Long
                  Property = alpha_
                End Property
                Property Set Alpha( ByVal value As Long )
                  alpha_ = value
                End Property
             
                Method FromResource( resource As WStringZ, ByVal pType As Dword )
                  Local hResource As Dword
                  Local hInst As Dword
                  Local pStream As IStream
                  Local pImg As Dword
                  Local pRes As Byte Ptr
                  Local hBuf As Dword
                  Local pBuf As Byte Ptr
             
                  Me.FreeGDI()
                  hInst = GetModuleHandle( ByVal 0 )
             
                  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, %TRUE, pStream ) = %S_Ok Then
                        Call GdipLoadImageFromStream( pStream, pImage )
                        Call GdipGetImageWidth( pImage, width_ )
                        Call GdipGetImageHeight( pImage, height_ )
                      End If
                      GlobalUnlock( hBuf )
                    End If
                    'GlobalFree( hBuf ):  ' Being freed when stream is released
                  End If
                End Method
             
                Method CreateBitmap( ByVal bgClr As Dword ) As Dword
                  Local hdc As Dword
                  Local mhdc As Dword
                  Local hBmp As Dword
                  Local pImg As Dword
                  Local br As Dword
                  Local rc As RECT
                  Local pGraphics As Dword
                  Local attr As Dword
             
                  If IsFalse pImage Then Exit Method
             
                  hdc = GetDC( ByVal %NULL ):                               ' Desktop DC
                  mhdc = CreateCompatibleDC( hdc )
                  hBmp = CreateCompatibleBitmap( hdc, width_, height_ )
                  pImg = SelectObject( mhdc, hBmp )
             
                  br = CreateSolidBrush( bgClr )
                  Call SetRect( rc, 0, 0, width_, height_ )
                  FillRect( mhdc, rc, br )
                  DeleteObject( br )
             
                  attr = Me.SetAttributes()
                  If GdipCreateFromHDC( mhdc, pGraphics ) = %S_Ok Then                  ' pGraphics - graphic object
                    Call GdipDrawImageRectRectI(pGraphics, pImage, 0, 0, width_, height_, 0, 0, width_, height_, %UnitPixel, attr, ByVal %NULL, ByVal %NULL )
                  End If
                  If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                  SelectObject( mhdc, pImg )
                  DeleteDC( mhdc )
                  ReleaseDC( ByVal %NULL, hdc )
                  Me.ReleaseAttributes( attr )
                  Method = hBmp:                                                        ' User must delete this bitmap!
                End Method
             
                Method AddToBitmap( ByVal hBmp As Dword, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long )
                  Local hdc As Dword
                  Local mhdc As Dword
                  Local pImg As Dword
                  Local pGraphics As Dword
                  Local attr As Dword
             
                  If IsFalse pImage Then Exit Method
             
                  hdc = GetDC( ByVal %NULL ):                               ' Desktop DC
                  mhdc = CreateCompatibleDC( hdc )
                  pImg = SelectObject( mhdc, hBmp )
             
                  attr = Me.SetAttributes()
             
                  If GdipCreateFromHDC( mhdc, pGraphics ) = %S_Ok Then                  ' pGraphics - graphic object
                    Call GdipDrawImageRectRectI(pGraphics, pImage, l, t, w, h, 0, 0, w, h, %UnitPixel, attr, ByVal %NULL, ByVal %NULL )
                  End If
                  If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                  SelectObject( mhdc, pImg )
                  DeleteDC( mhdc )
                  ReleaseDC( ByVal %NULL, hdc )
                  Me.ReleaseAttributes( attr )
                End Method
             
                Method Draw( ByVal hdc As Dword, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long )
                  Local pGraphics As Dword
                  Local attr As Dword
             
                  If IsFalse pImage Then Exit Method
                  attr = Me.SetAttributes()
             
                  If GdipCreateFromHDC( hdc, pGraphics ) = %S_Ok Then                  ' pGraphics - graphic object
                    Call GdipDrawImageRectRectI(pGraphics, pImage, l, t, w, h, 0, 0, width_, height_, %UnitPixel, attr, ByVal %NULL, ByVal %NULL )
                  End If
                  If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                  Me.ReleaseAttributes( attr )
                End Method
              End Interface
            End Class
            TestGDIPlus.bas
            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 "GDIPlusImage.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 iGDIPlusImage
             
            '===========================================================
            ' DEMO: Fade in animation
            Thread Function AlterTransparency( ByVal hWnd As Long ) As Long
              Local v As Long
              Local i As Long
              For v=0 To 255
                Sleep 20
                For i=0 To 6
                  img(i).Alpha = v
                Next
                InvalidateRect( hWnd, ByVal %NULL, 0 )
              Next
            End Function
            '===========================================================
             
            Function PBMain () As Long
              Local hTestGraphic As Dword
              Local i As Long
             
              '===========================================================
              ' DEMO: Load up some resources and image files
              Dim img(7)
              img(0) = NewGDIPlusImage( 384, 128, ARGB( 255, 254,218,165) )
              img(1) = NewGDIPlusImageFromResource( ByVal MAKEINTRESOURCE(%IMG_PAWS), %RT_RCDATA )
              img(2) = NewGDIPlusImageFromResource( ByVal MAKEINTRESOURCE(%IMG_LOGO), %RT_RCDATA )
              img(3) = NewGDIPlusImageFromResource( ByVal MAKEINTRESOURCE(%IMG_GER_BMP), %RT_RCDATA )
              img(4) = NewGDIPlusImageFromFile( "Gershwin.gif" )
              img(5) = NewGDIPlusImageFromFile( "Gershwin.jpg" )
              img(6) = NewGDIPlusImageFromFile( "Gershwin.tif" )
              img(7) = NewGDIPlusImageFromFile( "Border2.png")
              '===========================================================
             
              hTestGraphic = TestGraphic_CreateWindow()
             
              ShowWindow( hTestGraphic, %SW_ShowNormal )
              UpdateWindow( hTestGraphic )
             
              Thread Create AlterTransparency( hTestGraphic ) To i
              Thread Close i To i
              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
              Static v 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
              Local i As Long
             
              hdc = BeginPaint( hTestGraphic, ps )
              GetClientRect( hTestGraphic, rc )
             
              hImg = CreateCompatibleBitmap(hdc, rc.right, rc.bottom)
              mhdc = CreateCompatibleDC(hdc)
             
              SelectObject( mhdc, hImg )
              br = CreateSolidBrush( RGB(245,231,184) )
              FillRect( mhdc, rc, br ): ' Erase the area
              DeleteObject( br )
             
              '===========================================================
              ' DEMO: Draw those loaded images
              ' The images are inset 4 from left by 4 from top with 4 pixels between each vertically
              Local t As Long
              Local l As Long
              t = (rc.Bottom - 655) /2
              l = (rc.Right-384)/2
              img(7).Draw( mhdc, 0, 0, rc.Right, rc.Bottom )
              img(0).Draw( mhdc, l, t, img(0).Width, img(0).Height ):         ' Color block (384 x 128)
              For i=0 To 2
                img(1).Draw( mhdc, l + i*128, t, img(1).Width, img(1).Height ): ' 3 paws (128 x 128)
              Next
              img(2).Draw( mhdc, l, t, img(2).Width, img(2).Height ):         ' Overlay logo (384 x 128)
              t += 132
              For i=3 To 6
                ' 132 = 128 (height) + 4 (separation), first image will be at y = 4 + 128 + 4
                l = (rc.Right - img(i).Width)/2
                img(i).Draw( mhdc, l, t, img(i).Width, img(i).Height ): ' Other image formats
                t += 132
              Next
              '===========================================================
             
              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
             
            Function TestGraphic_Run(ByVal hTestGraphic As Long) As Long
              Local msg As tagMSG
             
              Do While GetMessage( msg, %NULL, 0, 0 )>0
                TranslateMessage( msg )
                DispatchMessage( msg )
              Loop
            End Function
            Last edited by Larry Charlton; 10 Oct 2011, 12:40 PM.
            LarryC
            Website
            Sometimes life's a dream, sometimes it's a scream

            Comment


            • #7
              You should (imo) unlock the bitmap data before using the CreateStreamOnHGlobal()

              The stream is released by PB when going out of scope or when set to nothing.
              So an extra release is not good (you removed it ok)
              hellobasic

              Comment


              • #8
                Updated to add setting the transparency. Added a fade in transparency.

                So, it's always interesting to me the differences in implementations. When I started to do this, I figured I just update the alpha values. So I dug around trying to local how to get a DIB, finally stumbled accross GdipBitmapLockBits. After a few false starts and some optimizations, I could finally set the image alpha value. Life was grand, and then... I said, hey why not throw in a fade in effect? That would be cool right? So out of the gate I get, you guessed it a lovely white background for all those hours of hard work!? I'm thinking geez I have to keep a copy of the bitmap just to add multiple transparencies? Then I remembered that earlier in the day I'd seen some goofy thing about image attributes and color matrices, but I was like, oh that would be more work to do that every time I render... Well as it turns out, it seems to perform quite well and appears to be a better way at least for GDI+.
                LarryC
                Website
                Sometimes life's a dream, sometimes it's a scream

                Comment


                • #9
                  Replaced the stretchy border with an animated border. Added some rotating text. Link is in post 6.
                  Last edited by Larry Charlton; 15 Oct 2011, 10:52 AM.
                  LarryC
                  Website
                  Sometimes life's a dream, sometimes it's a scream

                  Comment


                  • #10
                    The unlock is still at the wrong location.
                    Unlock (not free) the global mem before passing it to the gdiplus calls.
                    hellobasic

                    Comment


                    • #11
                      Thanks. I think I understand and possibly got it in the right place.
                      LarryC
                      Website
                      Sometimes life's a dream, sometimes it's a scream

                      Comment


                      • #12
                        One thing that's been puzzling me is why I have to move the world back and up to hit the center of text. It seems as though the world origin is the bottom right corner of my text. Here's the subroutine that I'm just not understanding.

                        Code:
                        Sub DrawTextRc( hdc As Dword, value As WString, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long)
                          Local pGraphics As Dword
                          Local attr As Dword
                          'TODO: Fonts need Size, Fill( Solid / LinearFill ), can do paths, transparencies, transformations, etc
                          'Probabbly needs to be in a class (or two) by itself, need simplified way of creating a font
                          'attr = SetAlphaAttributes(255)
                          If GdipCreateFromHDC( hdc, pGraphics ) = %S_Ok Then                  ' pGraphics - graphic object
                            Local rc As GpRectF
                            rc.Left = 0
                            rc.Top = 0
                            rc.Right = w
                            rc.Bottom = h
                            Local fnt As Dword
                            Local br As Dword
                            Local fntName As WString
                            Local fntFmly As Dword
                         
                            fntName = "Calibri"
                            GdipCreateFontFamilyFromName( ByVal StrPtr(fntName), ByVal %NULL, fntFmly)
                            GdipCreateFont( fntFmly, 50!, %FontStyleBold, %UnitPoint, fnt )
                            Local f As Long
                            Local x As Long
                            Local bnds As GpRectF
                            Local pFormat As Long
                         
                            Call GdipMeasureString( pGraphics, ByVal StrPtr(value), Len(value), fnt, rc, 0, bnds, f, x )
                         
                           Call GdipCreateSolidFill( ARGB(255, 0, 0, 255 ), br )
                         
                            GdipCreateStringFormat( 0, %LANG_NEUTRAL, pFormat )
                            GdipSetStringFormatAlign( pFormat, %StringAlignmentCenter )
                         
                            Call GdipSetSmoothingMode( pGraphics, %SmoothingModeHighQuality )
                            Call GdipSetTextRenderingHint( pGraphics, %TextRenderingHintAntiAliasGridFit )
                            Call GdipSetInterpolationMode( pGraphics, %TextRenderingHintAntiAliasGridFit )
                         
                           Call GdipTranslateWorldTransform( pGraphics, -w/2, -h/2, %MatrixOrderAppend )
                            Call GdipRotateWorldTransform( pGraphics, angle, %MatrixOrderAppend )
                            Call GdipTranslateWorldTransform( pGraphics, l+w/2, t+h/2, %MatrixOrderAppend )
                         
                            Call GdipDrawString( pGraphics, StrPtr(value), Len(value), fnt, bnds, pFormat, br )
                            Call GdipResetWorldTransform( pGraphics )
                         
                            GdipDeleteBrush( br )
                            GdipDeleteFont( fnt )
                          End If
                          If pGraphics Then Call GdipDeleteGraphics(pGraphics)      ' delete graphic object
                          'ReleaseAttributes( attr )
                        End Sub
                        LarryC
                        Website
                        Sometimes life's a dream, sometimes it's a scream

                        Comment


                        • #13
                          Text is now bordered with animated spin, alpha, gradient. Also added various GDI+ shapes. GDI+ while different isn't looking so daunting anymore. Now need to digest what I've discovered and think about how they fit in classes.
                          LarryC
                          Website
                          Sometimes life's a dream, sometimes it's a scream

                          Comment

                          Working...
                          X