Solved

Load resource bmp to memory

Posted on 2001-06-18
7
316 Views
Last Modified: 2011-09-20
i need to know how to load a resource bmp id 101 into memory with a dc so i can use bitblt and also how to free the memory on unload
0
Comment
Question by:smiffe
7 Comments
 
LVL 15

Expert Comment

by:ameba
ID: 6204432
Last 10 Grades Given: C A A C C A A A C A  
0
 
LVL 5

Expert Comment

by:gbaren
ID: 6204549
Not to mention an open question from December.

Community Support says that you should always assign an A grade. If you need clarification of the answer, ask.
0
 
LVL 6

Accepted Solution

by:
sharmon earned 100 total points
ID: 6204838
I threw this together for you, do not accept my comment as an answer unless you feel it is an "A" answer.  If not, then ask more questions etc....add your own error handling as you desire.

Regards,
Shannon


For this example you will need one form, one resource file with at least one bitmap with an id of 101 and the following code.  Be sure to set the forms scalemode to pixels and turn autodraw on for this example.

'Copy the following code in Form1
Option Explicit

Private Const SRCCOPY = &HCC0020

Private Declare Function BitBlt Lib "gdi32" _
  (ByVal hDestDC As Long, ByVal x As Long, _
  ByVal y As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long, ByVal hSrcDC As Long, _
  ByVal xSrc As Long, ByVal ySrc As Long, _
  ByVal dwRop As Long) As Long

Private Sub Form_Load()
  Dim objBmp As New CLSBitmap
  Set objBmp.Image = LoadResPicture(101, vbResBitmap)
 
  With objBmp
    BitBlt Me.hDC, 0, 0, .bmWidth, .bmHeight, .hDC, 0, 0, SRCCOPY
  End With
 
  Set objBmp = Nothing
End Sub


'--------------------------------------------------
'Create a new class module named CLSBitmap and copy the following code into it.


Option Explicit

Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Declare Function CreateCompatibleBitmap Lib _
  "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long) As Long

Private Declare Function CreateCompatibleDC Lib _
  "gdi32" (ByVal hDC As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _
  (ByVal hDC As Long) As Long
 
Private Declare Function DeleteObject Lib "gdi32" _
  (ByVal hObject As Long) As Long
 
Private Declare Function GetObject Lib "gdi32" Alias _
  "GetObjectA" (ByVal hObject As Long, _
  ByVal nCount As Long, lpObject As Any) As Long
 
Private Declare Function SelectObject Lib "gdi32" _
  (ByVal hDC As Long, ByVal hObject As Long) As Long

Private mImage As StdPicture
Private mDC As Long
Private mbmType As Long
Private mbmWidth As Long
Private mbmHeight As Long
Private mbmWidthBytes As Long
Private mbmPlanes As Long
Private mbmBitsPixel As Integer
Private mbmBits As Long

Private Sub Class_Terminate()
  If mDC <> 0 Then DeleteDC mDC
  Set mImage = Nothing
End Sub

Public Property Get Image() As StdPicture
  Set Image = mImage
End Property

Public Property Set Image(ByVal NewPicture As StdPicture)
  ClearImage
  Set mImage = NewPicture
  GetImageDC
End Property

Public Property Get hDC() As Long
  hDC = mDC
End Property

Public Property Get bmType() As Long
  bmType = mbmType
End Property

Public Property Get bmWidth() As Long
  bmWidth = mbmWidth
End Property

Public Property Get bmHeight() As Long
  bmHeight = mbmHeight
End Property

Public Property Get bmWidthBytes() As Long
  bmWidthBytes = mbmWidthBytes
End Property

Public Property Get bmPlanes() As Long
  bmPlanes = mbmPlanes
End Property

Public Property Get bmBitsPixel() As Integer
  bmBitsPixel = mbmBitsPixel
End Property

Public Property Get bmBits() As Long
  bmBits = mbmBits
End Property

Private Sub GetImageDC()
  Dim BMP As BITMAP
  Dim lngBMP As Long
 
  mDC = CreateCompatibleDC(0&)
  GetObject mImage, Len(BMP), BMP
  lngBMP = SelectObject(mDC, mImage)

  mbmType = BMP.bmType
  mbmWidth = BMP.bmWidth
  mbmHeight = BMP.bmHeight
  mbmWidthBytes = BMP.bmWidthBytes
  mbmPlanes = BMP.bmPlanes
  mbmBitsPixel = BMP.bmBitsPixel
  mbmBits = BMP.bmBits

  DeleteObject lngBMP
End Sub

Public Sub ClearImage()
  If mDC <> 0 Then DeleteDC mDC
  Set mImage = Nothing
  mbmType = 0
  mbmWidth = 0
  mbmHeight = 0
  mbmWidthBytes = 0
  mbmPlanes = 0
  mbmBitsPixel = 0
  mbmBits = 0
End Sub
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:smiffe
ID: 6204883
thanks for the input sharmon but this seems to be distorting the image can't i do this in a function and get rid of the class

Public sub loadBmptoMem()

what variables would i have to pass
0
 
LVL 6

Expert Comment

by:sharmon
ID: 6204930
There is no way it can distort the image.  Unless you are bitblt'ing it incorrectly.  You can convert it into just a Module if you want, but it's the same thing.  The class just makes sure that when it's destroyed the memory being used by the dc and the image is cleared.  Plus the class will allow you to open multiple bitmaps if needed by just declaring a new instance of it.  I would leave it as a class but feel free to convert it, I guess it's up to you.
0
 

Author Comment

by:smiffe
ID: 6205775
never mind i figured it out it had to do with the height and width.  here's what i ended up with for my module


Option Explicit

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal Hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal Hdc As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal Hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal Hdc As Long, ByVal _
    hObject As Long) As Long

Dim MemHdc() As Long
Dim numDCs As Long

Public Function CreateMemHdc(screenHdc As Long, resID As Long) As Long
    ReDim Preserve MemHdc(numDCs) As Long
    Dim bitmapHdc As Long
       
    MemHdc(numDCs) = CreateCompatibleDC(screenHdc)
    If MemHdc(numDCs) Then
        bitmapHdc = CreateCompatibleBitmap(screenHdc, 0, 0)
        If bitmapHdc Then
            SelectObject MemHdc(numDCs), LoadResPicture(resID, vbResBitmap)
            CreateMemHdc = MemHdc(numDCs)
        End If
    End If
   
    DeleteObject bitmapHdc
    numDCs = numDCs + 1
End Function

Public Sub DestroyMemHdcs()
    Dim i As Integer
    For i = 0 To numDCs - 1
        DeleteDC MemHdc(i)
    Next i
End Sub

it seems to work and i don't think it leaks memory.
thanks for the help sharmon.

0
 
LVL 6

Expert Comment

by:sharmon
ID: 6206536
Glad I could help.  Take care...
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now