Announcement

**Edwin Knoppert** · 9 Oct 2011, 04:45 PM

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

**Larry Charlton** · 9 Oct 2011, 04:57 PM

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.

**Larry Charlton** · 9 Oct 2011, 06:14 PM

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.

**Larry Charlton** · 9 Oct 2011, 07:06 PM

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.

**Larry Charlton** · 9 Oct 2011, 09:40 PM

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
' [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=48254&highlight=Image[/URL]
' 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

**Edwin Knoppert** · 10 Oct 2011, 01:14 AM

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)

**Larry Charlton** · 10 Oct 2011, 07:45 AM

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+.

**Larry Charlton** · 15 Oct 2011, 10:45 AM

Replaced the stretchy border with an animated border. Added some rotating text. Link is in post 6.

**Edwin Knoppert** · 15 Oct 2011, 11:09 AM

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

**Larry Charlton** · 15 Oct 2011, 11:44 AM

Thanks. I think I understand and possibly got it in the right place.

**Larry Charlton** · 15 Oct 2011, 12:07 PM

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 )
 
[B]   Call GdipTranslateWorldTransform( pGraphics, -w/2, -h/2, %MatrixOrderAppend )[/B]
    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

**Larry Charlton** · 16 Oct 2011, 09:11 AM

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.

Announcement

Loading image formats

Loading image formats

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment