VB - Load a section of a bitmap file into a PictureBox (TileEngine use)

This code will copy a specified rectangle from a bitmap file and place it in the picturebox you specify.

NOTE: The Picturebox must be a control array with AUTOREDRAW set to TRUE, but you can change the code in order to make them not a control array.

VB Code:

Public 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
    Public Const SRCCOPY = &HCC0020
 
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
 
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Public 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
    Public Const IMAGE_BITMAP = 0
    Public Const LR_LOADFROMFILE = &H10
 
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
 
 
Public Function LoadGraphics(ByVal FileName As String, ByVal PosX As Long, ByVal PosY As Long, ByVal Width As Long, ByVal Height As Long, ControlName As Object)
  On Error GoTo ErrHandler     'Cheap error handling that message boxes the errors.
  
  Dim DC As Long   'Hold the device context of the image
  Dim Image As Long   'Holds the loaded image
  Dim NewTile As Integer   'The control # to use
  
  NewTile = ControlName.Count   'Get the count of present pictureboxes
  Load ControlName(NewTile)   'Load one more Picturebox in the control array
  'ControlName(NewTile).Visible = True   'Make the PB visible (TESTING PURPOSES)
  'ControlName(NewTile).Move ControlName(NewTile - 1).Left + (Width * Screen.TwipsPerPixelX), ControlName(NewTile - 1).Top + (Height * Screen.TwipsPerPixelY), Width * Screen.TwipsPerPixelX, Height * Screen.TwipsPerPixelY  'Move the picturebox (TESTING PURPOSES)
  
  'FileName = App.Path & "\Maps\" & FileName   'Use this line if you only want graphics to be within the app's directory
  
  DC = CreateCompatibleDC(ControlName(NewTile).hdc)   'Create a Device Contect compatible with the PictureBox
  
  Image = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)   'Load the entire image file
  
  Call SelectObject(DC, Image)   'Assign the image to the device context
 
  Call BitBlt(ControlName(NewTile).hdc, 0, 0, Width, Height, DC, PosX, PosY, SRCCOPY)  'Copy the specified section of the bitmap into the picturebox
  
  'Clean up our tracks
  DeleteDC DC
  DeleteObject Image
  
  Exit Function  'Exit function without launching the error handler
    
ErrHandler:
  MsgBox Err.Number & Err.Description
End Function

If you don't like my code, I can fix it up for you. All that I know is that I composed it all by myself after hours of searching the net for some help but couldn't find any. BUt thanx to all those who tried to help me.

I have an error that says sub or function not defined...
while calling

DC = CreateCompatibleDC(ControlName(NewTile).hDC)
in the loadGraphic function you posted...


I'm trying to do this in VB 6.0

Any ideas?

Thanks,
Marc:confused:

Woops...i'm an idiot sometimes. I'm really sorry for posting bad code but I'll try and fix it!

I forgot the declares section! Here it is now!

VB Code:

Public 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
    Public Const SRCCOPY = &HCC0020
 
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
 
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Public 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
    Public Const IMAGE_BITMAP = 0
    Public Const LR_LOADFROMFILE = &H10
 
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Place that code in the same module as the function.

I did an awful lot of work with device contexts a while back, and one thing I noticed is that creating a device context does not always work properly.
So what I did, was use a Do Loop, and loop until a correct device context handle was returned.

Normally, if it failed to create a DC, then the next time it tries it would succeed.

Yeah u're right man. I had different code that always errored cuz the DC wasn't created. But for some reason, this code has worked 100% of the time :S. weird eh?