Come creare uno Sfondo per un Form con una Texture

1° Metodo:

In un Form inserire una PictureBox contenente una Texture nella proprietà picture.

Inserire questo codice:

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

Public Sub Tile(MyForm As Form, PicDest As Object, PictureSorgente As Control)
Dim X As Integer, Y As Integer
Dim RetValue As Long
MyForm.ScaleMode = 3
For X = 0 To Int(PicDest.ScaleWidth / PictureSorgente.ScaleWidth)
    For Y = 0 To Int(MyForm.ScaleHeight / PictureSorgente.ScaleHeight)
        RetValue = BitBlt(PicDest.hDC, X * PictureSorgente.ScaleWidth, Y * PictureSorgente.ScaleHeight, PictureSorgente.ScaleWidth, PictureSorgente.ScaleHeight, PictureSorgente.hDC, 0, 0, &HCC0020)
    Next
Next
End Sub

Private Sub Form_Load()
Tile Me, Me, Picture1
End Sub

Settare le proprietà del Form e della PictureBox in questo modo:

Form1.AutoRedraw=True
Picture1.Autoredraw=True
Picture1.ScaleMode=3 - Pixel
Picture1.Visible=False

Testato su: Windows 98, Windows Me, Windows 2000 Professional

2° Metodo:

In un modulo inserire:

Option Explicit

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
Declare Function SelectObject Lib "Gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function CreateCompatibleDC Lib "Gdi32.dll" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "Gdi32.dll" (ByVal hObject As Long) As Long
Declare Function DeleteDC Lib "Gdi32.dll" (ByVal hdc As Long) As Long

Public Sub RiempiFormConSfondo(frm As Form, sTilePicture As String)
Dim hTileDC As Long
Dim hBitmap As Long, hBitmapOld As Long
Dim Pic As IPicture
Dim X As Integer, Y As Integer
Dim MaxX As Integer, MaxY As Integer
Dim TileWidth As Single, TileHeight As Single

On Error GoTo GestErr

Set Pic = LoadPicture(sTilePicture)
TileWidth = frm.ScaleX(Pic.Width, vbHimetric, vbPixels)
TileHeight = frm.ScaleY(Pic.Height, vbHimetric, vbPixels)
If TileWidth = 0 Or TileHeight = 0 Then Exit Sub
hBitmap = Pic.Handle
hTileDC = CreateCompatibleDC(frm.hdc)
hBitmapOld = SelectObject(hTileDC, hBitmap)
MaxX = frm.ScaleX(frm.Width + Pic.Width, vbTwips, vbPixels)
MaxY = frm.ScaleX(frm.Height + Pic.Height, vbTwips, vbPixels)
For Y = 0 To MaxY Step TileHeight
    For X = 0 To MaxX Step TileWidth
Call BitBlt(frm.hdc, X, Y, TileWidth, TileHeight, hTileDC, 0, 0, vbSrcCopy)
    Next X
Next Y
Call SelectObject(hTileDC, hBitmapOld)
Call DeleteObject(hBitmap)
Call DeleteDC(hTileDC)
Exit Sub

GestErr:
If Err = 53 Then
    Set Pic = Nothing
End If
End Sub

Public Sub SfondoForm(frm As Form, Sfondo As String)
'Disegna lo sfondo.
RiempiFormConSfondo frm, Sfondo
With frm
    If .Picture <> 0 Then .PaintPicture .Picture, 0, 0
End With
End Sub

Inserire la Texture nella cartella dell'applicazione e rinominarla Sfondo.jpg.
Richiamare la Routine di riempimento, dall'evento Paint del Form:

Private Sub Form_Paint()
'Disegna lo sfondo
SfondoForm Me, App.Path & "\Sfondo.jpg"
End Sub

Testato su: Windows 98, Windows Me, Windows 2000 Professional