Tile a Picture on a Form Background
To create a form with tiled picture use the code below.
In this code the picture is loaded in a picture box (invisible) and is copied over the form many time as necessary to cover it. So you can use pictures on all formats supported by picture box.
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
'Each line below (started by "Private" word) have to be pasted as a single line
Private Declare Function BitBlt Lib "gdi32.dll" (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.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Create a Form with a PictureBox (named Picture1)
Private Sub Form_Load()
'Hide Picture1 and define its properties
Picture1.Visible = False
Picture1.AutoRedraw = False
Picture1.AutoSize = True
'Define form properties to be equivalent
Form1.AutoRedraw = False
End Sub
Private Sub Form_Paint()
'Define necessary variables
Dim Success As Long 'Result of API calls
Dim bmp As BITMAP 'BMP copied from Picture1
Dim srcDC As Long 'Source hDC
Dim hSrcPrevBmp As Long 'Destination hDC
Dim srcBmp As Long
Dim hSrcBmp As Long
Dim y As Long
Dim x As Long
'Loads picture - it can be any supported format of picture box control
Picture1.Picture = LoadPicture("c:\windows\winlogo.gif")
srcBmp = Picture1.Picture
Success = GetObject(srcBmp, Len(bmp), bmp)
srcDC = CreateCompatibleDC(Form1.hdc)
hSrcBmp = SelectObject(srcDC, srcBmp)
'Copy source Bitmap over form many times are necessary to cover its area
For y = 0 To Form1.ScaleHeight Step bmp.bmHeight
For x = 0 To Form1.ScaleWidth Step bmp.bmWidth
'The follow line have to be in a single line
Success = BitBlt(Form1.hdc, x, y, bmp.bmWidth, bmp.bmHeight, srcDC, 0, 0, &HCC0020)
Next x
Next y
'Delete used objetcs and DC
Success = DeleteObject(hSrcBmp)
Success = DeleteDC(srcDC)
End Sub
Special Instructions
This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.