Motif répétitif dans un picturebox à partir d'une seule image

Commenter

Contenu du snippet

Permet de remplir un PictureBox avec plusieur fois la même image qui servira de motif de remplissage

La methode consiste à charger une image dans le picturebox, puis appeler la fonction beTile pour repeter limage dans toute la zone daffichage du picturebox

Le code est optimisé pour ignorer laffichage de la premiere image de base, et pour ne pas tenter de repeter quand cest inutile (hauteur et/ou largeur finale plus petit que limage du motif)

Source / Exemple : 


Option Explicit

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetPixel Lib "gdi32" ( _
                 ByVal hdc As Long, _
                 ByVal x As Long, _
                 ByVal y As Long, _
                 ByVal crColor As Long) As Long

Rem repete l'image dans tout le controle
Rem il faut que l'image soit deja chargée et donner ses dimensions en argument
Public Function beTile(ByRef picSkin As PictureBox, imageWidth As Long, imageHeight As Long) As Long
    Dim hdc As Long
    Dim picWidth As Long
    Dim picHeight As Long
    Dim x As Long, y As Long
    Dim PixelColor As Long

    'Propriétés de la picture box
    picSkin.AutoRedraw = True
    picSkin.ScaleMode = 3
    hdc = picSkin.hdc
    picWidth = picSkin.ScaleWidth
    picHeight = picSkin.ScaleHeight
    
    'Remplissage de la premiere ligne en ignorant la premiere image
    If (picWidth > imageWidth) Then
        For x = imageWidth To picWidth - 1
            For y = 0 To imageHeight - 1
                PixelColor = GetPixel(hdc, x Mod imageWidth, y)
                SetPixel hdc, x, y, PixelColor
            Next
        Next
    End If
    
    'Remplissage des lignes suivantes
    If (picHeight > imageHeight) Then
        For y = imageHeight To picHeight - 1
            For x = 0 To picWidth - 1
                PixelColor = GetPixel(hdc, x, y Mod imageHeight)
                SetPixel hdc, x, y, PixelColor
            Next
        Next
    End If

    beTile = True
End Function

'EXEMPLE:

'On charge limage
ymsgrBackground.Picture = LoadPicture("background.bmp")
'On recupere ses dimensions
'NE PAS OUBLIER DE METTRE L'ATTRIBUT AUTOSIZE A VOTRE PICTUREBOX
ymsgrBackground.ScaleMode = 3
bgHeight = ymsgrBackground.ScaleHeight
bgWidth = ymsgrBackground.ScaleWidth
'Dimensions finales du PictureBox
ymsgrBackground.Height = 6585
ymsgrBackground.Width = 4440
'Et hop on repete limage dans tous le picturebox
beTile ymsgrBackground, bgWidth, bgHeight

Conclusion :


Ce source a été conçu pour Yskin, module du projet commun YahooPlus du Labo :

http://www.vbfrance.com/projetcommun.aspx?ID=238

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_olid)