Here is a easy to use and understand way to tile a bitmap graphic on a VB4-32bit or VB5 form. This example will help you understand how the BitBlt API call work.
BitBlt API definitions
lFrmHwnd - window handle of the form
iCol - pixel column
iRow - pixel row
iPicWidth - width of picture control
iPicHeight - height of picture control
lPicHwnd - window handle of the picture control
0, 0 - X and Y coordinates to start in upper left corner of the form
SRCCOPY - Copies the picture control rectangle directly to the form rectangle.
Declare
Public Const SRCCOPY = &HCC0020
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
Create a form and name it frmTileBmp. Add a Command button and name it cmdSwitch. Add a Picture control and name it picTile. Be sure to insert a BMP into this picture box.
Paste the rest of this code into the declarations section of the Form.
Declare the following in the General section of your Form:
Private lMaxHeight As Long ' Maximum height of the form
Private lMaxWidth As Long ' Maximum width of the form
Private iPicHeight As Integer ' Maximum height of the picture box
Private iPicWidth As Integer ' Maximum width of the picture box
Private Complete As Boolean ' Completely cover the form
Private LeftSide As Boolean ' Tile down left side of form
Private AcrossTop As Boolean ' Tile across top of form
Code
Private Sub cmdSwitch_Click()
' ----------------------------------------------------------
' Define local variable. First time thru VB initializes
' to zero.
' ----------------------------------------------------------
Static iCnt As Integer
' ----------------------------------------------------------
' Toggle between the way the form is painted
' ----------------------------------------------------------
If iCnt = 0 Then
cmdSwitch.Caption = "To tile down left side only, click here"
Complete = True
AcrossTop = False
LeftSide = False
ElseIf iCnt = 1 Then
cmdSwitch.Caption = "To tile across top of form, click here"
Complete = False
AcrossTop = False
LeftSide = True
ElseIf iCnt = 2 Then
cmdSwitch.Caption = "To tile across complete form, click here"
Complete = False
AcrossTop = True
LeftSide = False
End If
' ----------------------------------------------------------
' Increment the counter. Reset when we reach 3.
' ----------------------------------------------------------
iCnt = iCnt + 1
If iCnt = 3 Then iCnt = 0
' ----------------------------------------------------------
' By refreshing the form the Form_Paint event will be
' activated.
' ----------------------------------------------------------
frmTileBmp.Refresh
End Sub
Private Sub Form_Load()
' ----------------------------------------------------------
' Set the properties for the picture box
' Use the picture control properties window
' to set the following:
' .AutoRedraw = True ' Turn on the Redraw mode
' .Appearance = 0 ' Flat
' .BorderStyle = 0 ' No borders
' .ScaleMode = 3 ' Pixel mode
' ----------------------------------------------------------
With picTile
.AutoSize = True ' Autosize the box to the BMP
iPicWidth = .ScaleWidth ' Width of picture box
iPicHeight = .ScaleHeight ' Height of picture box
.Visible = False ' Start off invisible
End With
' ----------------------------------------------------------
' Set the toggle and update the caption on the command
' button.
' ----------------------------------------------------------
Complete = False
AcrossTop = False
LeftSide = False
cmdSwitch_Click
' ----------------------------------------------------------
' used for color when testing the tiling down the left side
' ----------------------------------------------------------
With frmTileBmp
.BackColor = &HFFFFC0 ' Light blue
.Show vbModeless
.Refresh
End With
End Sub
Private Sub Form_Paint()
' ----------------------------------------------------------
' This event is executed whenever the the form is Refreshed
' moved, or Resized.
'
' BitBlt API definitions (Understandable terminology)
'
' lFrmHwnd - window handle of the form
' iCol - pixel column
' iRow - pixel row
' iPicWidth - width of picture control
' iPicHeight - height of picture control
' lPicHwnd - window handle of the picture control
' 0, 0 - X and Y coordinates to start in upper
' left corner of the form
' SRCCOPY - Copies the picture control rectangle
' directly to the form rectangle.
' ----------------------------------------------------------
' ----------------------------------------------------------
' Define local variables
' ----------------------------------------------------------
Dim lPicHwnd As Long ' picture box handle
Dim lFrmHwnd As Long ' form handle
Dim iCol As Integer ' Column on the form
Dim iRow As Integer ' Row on the form
Dim lRet As Long ' Return value from API call
' ----------------------------------------------------------
' Initialize the variables
' ----------------------------------------------------------
lPicHwnd = picTile.hDC
lFrmHwnd = hDC
' ----------------------------------------------------------
' Paint the screen. To paint just down the left side of the
' form, place a comment mark in front of "For iCol" and the
' corresponding "Next". Do not comment out the BitBlt call.
' in this demo, we use a switch.
' ----------------------------------------------------------
If Complete Then
For iRow = 0 To lMaxHeight Step iPicHeight
' paint each column in a row before going to the
' next row.
For iCol = 0 To lMaxWidth Step iPicWidth
' Returns non-zero if successful
lRet = BitBlt(lFrmHwnd, iCol, iRow, iPicWidth, iPicHeight, lPicHwnd, 0, 0, SRCCOPY)
Next
Next
ElseIf LeftSide Then
For iRow = 0 To lMaxHeight Step iPicHeight
' Returns non-zero if successful
lRet = BitBlt(lFrmHwnd, iCol, iRow, iPicWidth, iPicHeight, lPicHwnd, 0, 0, SRCCOPY)
Next
ElseIf AcrossTop Then
For iCol = 0 To lMaxWidth Step iPicWidth
' Returns non-zero if successful
lRet = BitBlt(lFrmHwnd, iCol, iRow, iPicWidth, iPicHeight, lPicHwnd, 0, 0, SRCCOPY)
Next
End If
End Sub
Private Sub Form_Resize()
' ----------------------------------------------------------
' If the form is resized, get the new measurements
' ----------------------------------------------------------
lMaxHeight = Height Screen.TwipsPerPixelY
lMaxWidth = Width Screen.TwipsPerPixelX
End Sub
Private Sub Form_Unload(Cancel As Integer)
' ----------------------------------------------------------
' unload the form competely and free up memory
' ----------------------------------------------------------
' Deactivates the form
Unload frmTileBmp
' Free memory by removing the form object from memory
Set frmTileBmp = Nothing
' empties all variables in memory and terminates application
End
End Sub
|
