GFTilePicture/GFTilePicture.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4335
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   ScaleHeight     =   4335
   ScaleWidth      =   5655
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton Command2
      Caption         =   "Check Borders"
      Height          =   375
      Left            =   1320
      TabIndex        =   3
      Top             =   3840
      Width           =   2055
   End
   Begin VB.CommandButton Command1
      Caption         =   "Tile Picture!"
      Height          =   375
      Left            =   3480
      TabIndex        =   2
      Top             =   3840
      Width           =   2055
   End
   Begin VB.PictureBox Picture2
      Height          =   2400
      Left            =   60
      Picture         =   "GFTilePicture.frx":0000
      ScaleHeight     =   2340
      ScaleWidth      =   4920
      TabIndex        =   1
      Top             =   480
      Width           =   4980
   End
   Begin VB.PictureBox Picture1
      Height          =   360
      Left            =   60
      ScaleHeight     =   300
      ScaleWidth      =   480
      TabIndex        =   0
      Top             =   60
      Width           =   540
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2004 by Louis. Use to display a picture tiled. www.louis‑coder.com.
'GFTilePicture
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 Sub GFTilePicture(ByRef TileSourcePicture As PictureBox, ByRef TileTargetPicture As PictureBox)
    'on error resume next 'source and target picture must not be equal
    Dim TileSourcePictureScaleModeUnchanged As Integer
    Dim TileTargetPictureScaleModeUnchanged As Integer
    Dim TileXSizeCurrent As Long
    Dim TileYSizeCurrent As Long
    Dim TileXSizeTotal As Long
    Dim TileYSizeTotal As Long
    'preset
    TileSourcePictureScaleModeUnchanged = TileSourcePicture.ScaleMode
    TileSourcePicture.ScaleMode = vbPixels 'important
    TileTargetPictureScaleModeUnchanged = TileTargetPicture.ScaleMode
    TileTargetPicture.ScaleMode = vbPixels 'important
    'verify
    If (TileSourcePicture.ScaleWidth = 0) Or (TileSourcePicture.ScaleHeight = 0) Then 'verify
        Exit Sub
    End If
    'begin
    Do
        TileYSizeCurrent = TileSourcePicture.ScaleHeight
        If (TileYSizeTotal + TileYSizeCurrent) > TileTargetPicture.ScaleHeight Then
            TileYSizeCurrent = TileTargetPicture.ScaleHeight ‑ TileYSizeTotal
        End If
        TileXSizeTotal = 0 'reset
        Do
            TileXSizeCurrent = TileSourcePicture.ScaleWidth
            If (TileXSizeTotal + TileXSizeCurrent) > TileTargetPicture.ScaleWidth Then
                TileXSizeCurrent = TileTargetPicture.ScaleWidth ‑ TileXSizeTotal
            End If
            Call BitBlt(TileTargetPicture.hDC, TileXSizeTotal, TileYSizeTotal, TileXSizeCurrent, TileYSizeCurrent, TileSourcePicture.hDC, 0, 0, vbSrcCopy)
            TileXSizeTotal = TileXSizeTotal + TileXSizeCurrent
            If Not (TileXSizeTotal < TileTargetPicture.ScaleWidth) Then Exit Do
        Loop
        TileYSizeTotal = TileYSizeTotal + TileYSizeCurrent
        If Not (TileYSizeTotal < TileTargetPicture.ScaleHeight) Then Exit Do
    Loop
    'reset
    TileSourcePicture.ScaleMode = TileSourcePictureScaleModeUnchanged
    TileTargetPicture.ScaleMode = TileTargetPictureScaleModeUnchanged
End Sub

Private Sub Command1_Click()
    'on error resume next
    Call GFTilePicture(Picture1, Picture2)
End Sub

Private Sub Command2_Click()
    'on error resume next
    Picture1.Width = Picture1.Width + (3 * Screen.TwipsPerPixelX)
    Picture1.Height = Picture1.Height + (3 * Screen.TwipsPerPixelY)
End Sub


[END OF FILE]