Search Tools Links Login

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

About this post

Posted: 2019-09-16
By: IlanioCastro
Viewed: 193 times

Categories

Visual Basic 6

Attachments

No attachments for this post

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.