VB - Tile Window (Fast Image Tiler)

[Aaron Young]

The following code demonstrates how to use various Win32 API to create a very fast and effective tiling routine.

Functionality includes being able to use an image containing multiple tiles of any dimension.

Paste the following into a Standard Module:

Option Explicit
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
 
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 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 GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc 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
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
  (ByVal hInst As Long, ByVal lpsz As String, ByVal iType As Long, ByVal cx As Long, _
   ByVal cy As Long, ByVal fOptions As Long) As Long
 
Private Const IMAGE_BITMAP = 0
Private Const LR_LOADFROMFILE = &H10
 
Private Const SRCCOPY = &HCC0020
 
Public Sub fnTileWindow( _
  ByVal lhWnd As Long, ByVal sTileFile As String, ByVal lTileNo As Long, _
  Optional ByVal lTileWidth As Long = 32, _
  Optional ByVal lTileHeight As Long = 32, _
  Optional lTilesPerRow As Long = 1)
  
  ' lhWnd         = Handle of Window to Tile
  ' sTileFile     = Location of Bitmap File to use which contains 1 or more tiles.
  ' lTileNo       = Tile No. to use, (reading tiles left to right, top to bottom.)
  ' lTileWidth    = Width of Each Tile in the Tile Bitmap
  ' lTileHeight   = Height of Each Tile in the Tile Bitmap
  ' lTilesPerRow  = No. of tiles in each row of the Bitmap
  
  Dim lDC As Long, lTileDC As Long
  Dim lDestDC As Long
  Dim lTileBmp As Long, lBmp As Long
  Dim tRECT As RECT
  Dim lSrcTileX As Long, lSrcTileY As Long
  Dim x As Long, y As Long
  Dim lTileCountX As Long, lTileCountY As Long
  Dim lDestWidth As Long, lDestHeight As Long
  
  ' Determine the X/Y Coords of the Source Tile within the Tiles Image
  lSrcTileX = ((lTileNo - 1) Mod lTilesPerRow) * lTileWidth
  lSrcTileY = ((lTileNo - 1) / lTilesPerRow) * lTileHeight
  
  ' Get the Dimensions of the Client area of the window to tile
  Call GetClientRect(lhWnd, tRECT)
  
  ' Calculate the Window's Width/Height
  lDestWidth = tRECT.Right - tRECT.Left
  lDestHeight = tRECT.Bottom - tRECT.Top
  
  ' Get the Window's DC
  lDestDC = GetDC(lhWnd)
  ' Create 2 Compatible Device Contexts', 1 for the Buffer the
  ' other for the Tiles Image
  lDC = CreateCompatibleDC(lDestDC)
  lTileDC = CreateCompatibleDC(lDestDC)
  
  ' Load the Tiles Bitmap
  lTileBmp = LoadImage(0, sTileFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
  
  ' Select the Tiles Bitmap into the Buffer DC
  Call SelectObject(lDC, lTileBmp)
  ' Create a Bitmap Compatible with the Tiles Bitmap which is as
  ' big as the target window's client area in the Buffer DC
  lBmp = CreateCompatibleBitmap(lDC, lDestWidth, lDestHeight)
  ' Select the Buffer BMP into the Buffer DC
  Call SelectObject(lDC, lBmp)
  
  ' Select the Tiles BMP into the Tiles DC
  Call SelectObject(lTileDC, lTileBmp)
  
  ' Calculate how many tiles it'll take to tile the window
  lTileCountX = lDestWidth / lTileWidth
  lTileCountY = lDestHeight / lTileHeight
 
  ' Start drawing the tiles to the Buffer DC
  For y = 0 To lTileCountY
    For x = 0 To lTileCountX
      BitBlt lDC, x * lTileWidth, y * lTileHeight, lTileWidth, lTileHeight, _
       lTileDC, lSrcTileX, lSrcTileY, SRCCOPY
    Next
  Next
  ' Copy the whole Buffer to the Destination Window in one go.
  BitBlt lDestDC, 0, 0, lDestWidth, lDestHeight, lDC, 0, 0, SRCCOPY
  
  ' Clean Up the DC's and BMP's
  Call DeleteDC(lDC)
  Call DeleteDC(lTileDC)
  Call ReleaseDC(lhWnd, lDestDC)
  Call DeleteObject(lBmp)
  Call DeleteObject(lTileBmp)
End Sub

Example Usage:

Option Explicit
 
Private Sub Command1_Click()
  Static lTileNo As Long
  
  ' Toggle Between the 2 Tiles in the Tiles BMP
  lTileNo = (lTileNo + 1) Mod 2
  ' Tile the Form with this Tile
  fnTileWindow hwnd, "C:\Tiles.bmp", lTileNo + 1
End Sub

Image for Tiles in this example attached.