• Home
 · 
• Games
 · 
• Load bitmaps straight into memory

Load bitmaps straight into memory

Do you have a game with too many pictureboxes for your graphics. Want to make your game really proffessional by loading them straight into RAM. Even returns all the properties of your bitmap. Can be used with 3 liones of code. This is to be used with bitblt. Not compatible with Windows NT due to the loadfromfile constant being restricted or something.

Inputs
Use it like this: Private sub sub Form_Load() Me.show Dim lngDC as long Dim bmpProperties as BITMAP lngDC = GenerateDC(C:\Bitmap.Bmp,bmpProperties) Msgbox BmpProperties.bmwidth me.scalemode = vbpixels Bitblt me.hdc,0,0,me.scalewidth,me.scaleheight,lngDC,0,0,vbsrccopy deletegenerateddc lngdc end sub

Assumes
You place the code in a module.

Returns
Puts a bitmap in memory and returns its properties and a DC to it. Then when you are finished just delete the dc using the provided sub.

Side Effects
Remember to delete the DC or you might start losing some resources. Dont attempt to use on Windows NT.

API Declarations
Various. See code

Rate Load bitmaps straight into memory

• 1
• 2
• 3
• 4
• 5

(4(4 Vote))

Option Explicit

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 GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Const IMAGE_BITMAP As Long = 0
Private Const LR_LOADFROMFILE As Long = &H10
Private Const LR_CREATEDIBSECTION As Long = &H2000

Public 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

Public Function GenerateDC(ByVal FileName As String, BitmapProperties As BITMAP) As Long
Dim DC As Long
Dim hBitmap As Long
DC = CreateCompatibleDC(0)
If DC < 1 Then
  GenerateDC = 0
  Exit Function
End If
hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
If hBitmap = 0 Then
  DeleteDC DC
  GenerateDC = 0
  Exit Function
End If
GetObjectAPI hBitmap, Len(BitmapProperties), BitmapProperties
SelectObject DC, hBitmap
GenerateDC = DC
DeleteObject hBitmap
End Function

Public Function DeleteGeneratedDC(DC As Long) As Long
If DC > 0 Then
  DeleteGeneratedDC = DeleteDC(DC)
Else
  DeleteGeneratedDC = 0
End If
End Function
'Gimme somefeedback and votes please. Thats the only time I'm gonna ask