Binaryworld - Tile image in MDI Background. ... [ VB -> Forms & Controls ]

This code Requires MDIForm and 1 Picturebox.
Set Picture property of picturebox. This picture will be used for MDI Background

Click here to copy the following block

Option Explicit

' Mdibackg sample by Matt Hart - vbhelp@matthart.com
' http://matthart.com
'
' This sample shows how to tile or center a background on
' an MDI form. It is a bit trickier than on a standard
' form since an MDI doesn't have the PaintPicture method
' or an hDC to paint images onto.
'
' A memory DC (hMemDC) is used to store the original picture
' that will be centered or tiled. The MDI Form itself has
' two invisible controls - picHolder and Picture1. picHolder
' is on the MDI form and Picture1 is on the picHolder control.
' This is needed because an MDI uses the Align property, forcing
' any control directly on the MDI to match the width of the MDI.
'
' Note also that I first load the picture into the Picture1 control.
' This is because the StdPicture object doesn't "inherit" the proper
' width and height of its bitmap, but Picture1 can automatically size
' itself to the bitmap. You can go the long way of using API calls
' to determine the bitmap dimensions, but using Picture1 and its
' AutoSize property is easier.
'
' The drawing is done in the Resize event. I draw from the memory DC
' to the Picture1 control. Note that Picture1 is sized to match the
' client area of the MDI form, and its background color is set to
' match that of the MDI. Once the image is drawn onto the MDI,
' I set the Picture property of the MDI to the drawn image.

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 lDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal lDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal lDC As Long, ByVal hObject As Long) As Long

Const TILE_IMAGE = 1  '''if 1 then tile image in backgnd ,if 0 then full one piece image

Dim pic As StdPicture, hMemDC As Long, pHeight As Long, pWidth As Long

Public Sub InitMDIBackground()
  On Error Resume Next

  MDIForm1.Picture1.Visible = False
  MDIForm1.Picture1.AutoRedraw = True
  MDIForm1.Picture1.AutoSize = True
  ' I placed this picture directly into the Picture1 object
  'Picture1.Picture = LoadPicture("c:\winnt\internet explorer wallpaper.bmp")

  pHeight = MDIForm1.Picture1.Height
  pWidth = MDIForm1.Picture1.Width

  Set pic = MDIForm1.Picture1.Picture
  Set MDIForm1.Picture1.Picture = Nothing
  MDIForm1.Picture1.AutoSize = False

  hMemDC = CreateCompatibleDC(MDIForm1.Picture1.hDC)
  SelectObject hMemDC, pic.Handle
End Sub

Public Sub DrawBackground()
On Error GoTo errHandler
  If MDIForm1.WindowState <> vbMinimized Then
    Dim X As Long, Y As Long

    'MDIForm1.Picture1.BackColor = MDIForm1.BackColor
    If TILE_IMAGE = 1 Then

      MDIForm1.Picture1.Move 0, 0, MDIForm1.ScaleWidth, MDIForm1.ScaleHeight
      '''''''''''''for tiled''''''''
      For X = 0 To MDIForm1.ScaleWidth Step pWidth
        For Y = 0 To MDIForm1.ScaleHeight Step pHeight
          BitBlt MDIForm1.Picture1.hDC, X \ Screen.TwipsPerPixelX, Y \ Screen.TwipsPerPixelX, pWidth \ Screen.TwipsPerPixelX, pHeight \ Screen.TwipsPerPixelY, hMemDC, 0, 0, vbSrcCopy
        Next
      Next
    Else

      X = (MDIForm1.ScaleWidth - pWidth) \ 2: X = X \ Screen.TwipsPerPixelX
      Y = (MDIForm1.ScaleHeight - pHeight) \ 2: Y = Y \ Screen.TwipsPerPixelY

      MDIForm1.Picture1.Height = MDIForm1.Height
      MDIForm1.Picture1.Width = MDIForm1.Width

      BitBlt MDIForm1.Picture1.hDC, X, Y, pWidth \ Screen.TwipsPerPixelX, pHeight \ Screen.TwipsPerPixelY, hMemDC, 0, 0, vbSrcCopy

    End If

    Set MDIForm1.Picture = MDIForm1.Picture1.Image
  End If

  Set pic = Nothing
  DeleteDC hMemDC
errHandler:
End Sub

'******************************************************************************************************
Private Sub MDIForm_Load()
Picture1.Visible = True
InitMDIBackground
End Sub

Private Sub MDIForm_Resize()
DrawBackground
End Sub