Concevoir des formulaires exotiques déformés ou géométriques avec Visual Basic 6.0

Je tiens à remercier tout particulièrement toutes celles et tous ceux qui ont participé à la relecture de ce document en y incluant leurs remarques.

Pour tout renseignement complémentaire, veuillez me contacter directement (Argyronet) par MP.

Pour concevoir la forme de ce formulaire, j'utiliserai le logiciel de dessin MsPaint^® livré par défaut avec Windows.

Créez d'abord un nouveau formulaire depuis la boîte de dialogue Project/Add Form… et sélectionnez la première icône de la liste nommée Form :

Vous allez alors obtenir une fenêtre vide qui portera le nom de Form suivi d'un numéro correspondant à l'index du nombre de fenêtres que vous avez déjà créées (Exemple ici Form2).

Une fois cela fait, cliquez sur le bouton Démarrer de Windows où vous choisirez Exécutez…
Pour les adeptes des raccourcis, appuyez simultanément sur les touches …

La boîte de dialogue apparaît et vous y inscrivez le nom du programme à savoir, Mspaint…
Si vous préférez utiliser un autre logiciel graphique, il n'y a aucune difficulté du moment que vous respectez les indications qui vont suivre.
Je précise que l'usage de MsPaint permet de générer des images Bitmap simples et c'est ce qu'il y a de plus conseillé pour débuter.

Vous cliquez alors sur le bouton OK.

Le logiciel vous affiche une feuille blanche sur laquelle vous allez dessiner une forme géométrique simple.

Pour illustrer cet exercice, je vous propose de dessiner une étoile.

Dessin de l'étoile dans MsPaint

Une fois votre forme géométrique dessinée, vous pouvez alors choisir une couleur de remplissage.
Du fait que la palette de MsPaint^® ne propose qu'un jeu de 28 couleurs, vous cliquerez deux fois sur l'une des zones colorées de manière à choisir une couleur personnalisée.

Ici, j'ai choisi une couleur gris turquoise :
R=206 V=224 B=232;
donc, ici, vous saisissez directement ces valeurs dans les zones respectives.

Vous validez alors par OK puis prenez l'outil Pot de peinture nommé Remplissage pour appliquer la couleur dans l'étoile.
De la même manière, vous appliquerez le remplissage à l'extérieur de l'étoile avec une couleur RVB simple par exemple un bleu uni :
R=000 V=000 B=255;

La figure devient alors la suivante :

Il ne vous reste plus qu'à ajuster l'image de manière à ce que l'espace de remplissage inutilement utilisé soit rogné…

Vous enregistrez alors votre image au format BMP dans le dossier .\images (sous-dossier du dossier de votre application) et le nommez par exemple imagestar.bmp.
Vous basculez alors de nouveau sous Visual Basic où nous attend patiemment le Form2 laissé à l'abandon pendant tout ce travail…

L'étape suivante va consister à mettre en œuvre le formulaire. Dans les propriétés de ce dernier, repérez la propriété Picture et cliquez sur le bouton afin d'aller chercher l'image que vous venez de dessiner…

Ajustez alors le formulaire à une taille un peu plus grande que l'image.
Un certain nombre d'autres propriétés sont à définir pour ce formulaire et elles sont les suivantes :

• Name = frmTransStar
• BorderStyle = 0
• ScaleMode = 3 (Pixel)
• ShowInTaskbar = True

Pour continuer, vous allez prendre dans la boîte à outils, un contrôle PictureBox que vous allez positionner sur la droite de manière à ce qu'il ne vous gêne pas lors de la pose d'éventuels autres contrôles servant au formulaire à proprement parler.

Dessinez alors un petit carré d'environ 1 cm de coté (soit en gros 700 pixels) avec le curseur (figure 1), lâchez alors le bouton de la souris et le petit carré est entouré de 8 points d'ancrage (figure 2) ;

Dans la fenêtre des propriétés, repérez la propriété AutoSize et affectez-lui True (figure 3).

Repérez ensuite la propriété Picture de ce contrôle et affectez-lui la même image que celle que vous avez affectée à la même propriété pour le formulaire à savoir imagestar.bmp. Un certain nombre d'autres propriétés sont à définir pour ce contrôle et elles sont les suivantes :

• Name = pctStar
• AutoRedraw = True
• AutoSize = True
• BorderStyle = 0
• ScaleMode = 3 (Pixel)
• Visible = False

Pourquoi devez-vous faire cela ? Tout simplement parce que le formulaire sera ajusté sur la taille de ce contrôle. Une fois cela fait, vous pouvez placer le contrôle PictureBox à peu près n'importe où sur le formulaire. Mettez-le là où il ne vous gêne pas pour travailler si par exemple, vous avez d'autres contrôles à ajouter à votre formulaire.
Prenez bien en considération que la taille maximum de votre formulaire sera celle du contrôle PictureBox.

Insérez alors un nouveau module dans votre projet et profitez de ce que vous avez la main sur ce dernier pour le nommer de suite…
Par exemple : basTransforms

Les bonnes habitudes font gagner un temps considérable.

Dans ce module que vous ouvrez, vérifiez que la mention Option Explicit est bien mentionnée en entête de module, sinon, écrivez-la.

' **************************************************************************************************

' CreateRectRgn:
' Fonction qui créée une région rectangulaire
'
' CombineRgn:
' Fonction qui combine 2 régions et stocke le résultat dans une troisième :
' Les 2 régions sont combinées selon un mode spécifique.
'
' DeleteObject:
' Fonction qui détruit tout ce qui est objet logique à savoir pen, brush, font, bitmap, region,
' ou encore palette tout en libérant les ressources consommées par le système pour cet objet.
' Bien entendu, une fois détruit, le handle de cet objet n'existera plus à partir de cet instant.
'
' SetWindowRgn:
' Fonction qui définie la région d'une fenêtre pour une fenêtre donnée.
' La région de la fenêtre détermine la zone à l'intérieure de laquelle la fenêtre alloue au système
' la possibilité de dessiner un objet.
' Toutefois, le système n'affiche aucune portion de la fenêtre qui se trouve à l'extérieure de la
' région en question.

' **************************************************************************************************
Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal _
    X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal _
    hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Boolean) As Long

Private Const RGN_OR = 2

La partie des API étant écrite, il me reste à vous montrer la fonction miracle qui va transformer votre formulaire en étoile…
Vous écrirez ou recopierez le code suivant juste en dessous des déclarations :

Public Sub GenerateTransForm(ByVal Frm As Form, ByVal Pct As PictureBox, ByVal ColorValue As Long)
Dim lngX As Long, lngY As Long
Dim lngStartX As Long, lngStartY As Long
Dim lngEndX As Long, lngEndY As Long
Dim lngHRectregion As Long, lngTempHRectRegion As Long
Dim lngVoidReturn As Long

Dim blnStatus As Boolean
    
    Frm.Width = Frm.ScaleX(Pct.Width, vbPixels, vbTwips)
    Frm.Height = Frm.ScaleY(Pct.Height, vbPixels, vbTwips)
    DoEvents
    blnStatus = False
    For lngX = 0 To Pct.ScaleWidth
        blnStatus = False
        For lngY = 0 To Pct.ScaleHeight
            If blnStatus Then
                If Pct.Point(lngX, lngY) = ColorValue Then
                    lngEndX = lngX
                    lngEndY = lngY
                    If lngHRectregion = 0 Then
                        lngHRectregion = CreateRectRgn(lngStartX, lngStartY, lngEndX + 1, lngEndY)
                    Else
                        lngTempHRectRegion = CreateRectRgn(lngStartX, lngStartY, lngEndX + 1, lngEndY)
                        lngVoidReturn = CombineRgn(lngHRectregion, lngHRectregion, lngTempHRectRegion, RGN_OR)
                        DeleteObject lngTempHRectRegion
                    End If
                    blnStatus = False
                End If
             Else
                If Pct.Point(lngX, lngY) <> ColorValue Then
                    lngStartX = lngX
                    lngStartY = lngY
                    lngEndX = lngX
                    lngEndY = lngY
                    blnStatus = True
                End If
            End If
        Next
        ' *** Complément de code à ajouter entre les deux blocs Next pour éviter qu'une zone
        ' *** soit ignorée si le dernier pixel en bas de l'image n'est pas dans la couleur ciblée (ici bleue).
        ' *** Merci à "David Ughetto" pour cette suggestion...
        If blnStatus Then
          lngEndX = lngX
          lngEndY = lngY
          If lngHRectregion = 0 Then
            lngHRectregion = CreateRectRgn(lngStartX, lngStartY, lngEndX + 1, lngEndY)
          Else
            lngTempHRectRegion = CreateRectRgn(lngStartX, lngStartY, lngEndX + 1, lngEndY)
            lngVoidReturn = CombineRgn(lngHRectregion, lngHRectregion, lngTempHRectRegion, RGN_OR)
            DeleteObject lngTempHRectRegion
          End If
        End If
    Next
    lngVoidReturn = SetWindowRgn(Frm.hwnd, lngHRectregion, True)
    lngVoidReturn = DeleteObject(lngHRectregion)
End Sub

Cette procédure utilise trois arguments (Paramètres) qui sont respectivement l'objet Form, l'objet PictureBox et la combinaison convertie en Long de la palette RGB qui entoure l'objet dessiné, en l'occurrence l'étoile et donc ici, le bleu uni que j'ai appliqué à l'image.

IV-A-1. Comment fonctionne cette procédure ?▲

Il reste pour terminer à écrire quelques lignes pour le formulaire de manière à ce que la fonction soit appelée dès son chargement…

Option Explicit

Private Sub Form_Load()
    GenerateTransForm Me, pctStar, RGB(0, 0, 255)
'   SetFormToTop Me, True
End Sub

On appelle donc la procédure GenerateTransForm suivie de ses trois paramètres qui sont, comme stipulé plus haut, les objets qui constituent le formulaire.
Pour définir l'argument ColorValue, on associera la fonction RGB() qui prendra ses trois valeurs relatives à la couleur de remplissage de l'arrière-plan à savoir, 0 pour le rouge, 0 pour le vert et 255 pour le bleu.

Il y a une ligne commentée dans le code… J'ai fait exprès de la laisser telle que pour vous montrer qu'il est possible de mettre au premier plan la fenêtre de telle sorte à ce qu'elle ne passe jamais en dessous des autres dans l'environnement Windows.
Cette procédure utilise l'API SetWindowPos() avec les arguments qui s'imposent.
Je vous laisse le soin de chercher dans les codes source du Forum l'usage de cette fonction.

Vous pouvez constater que le pourtour du formulaire est coiffé d'une légère ligne bleue qui est mal nettoyée… Cela n'est pas forcément gênant si la figure est bien dessinée.
En fait, il est délicat d'obtenir quelque chose de parfait, le mélange noir/bleu étant ignoré de la combinaison 0, 0, 255.
Il vous faut effectuer des tests à maintes reprises en ayant plusieurs jeux d'images. Mais je conseille tout de même de conserver une bordure autour de la forme et surtout de faire en sorte que votre forme ne possède aucune couleur identique à celle de l'arrière-plan.
C'est par tests successifs que vous obtiendrez ce que vous souhaitez, j'en parle en connaissance de cause.

Pour déplacer le formulaire dans cet état, je vais utiliser deux API supplémentaires associées à un jeu de constantes que je vais exploiter sur l'événement qui gère les déplacements de la souris.
L'événement en question se nomme MouseMove() et il est disponible pour quasiment tous les contrôles posés sur un formulaire. Celui qui nous intéresse, en l'occurrence, est celui du formulaire lui-même.
Vous allez ajouter cette portion de code dans le module basTransforms:

' ReleaseCapture
' Fonction permettant de libérer la capture de la région d'une fenêtre dans le processus en cours
' puis reconstitue le processus d'entrée par la souris a son état normal.
'
' SendMessage
' Fonction qui envoie un message spécifique à une ou plusieurs fenêtres. Aucun résultat n'est retourné
' tant que la procédure d'appel n'a pas intercepté et traité le message contrairement d'ailleurs à la
' fonction PostMessage qui envoie un message dans une file d'attente de processus.

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Comme vous pouvez le constater, les fonctions autant que les constantes sont déclarées en Public.
Il suffit alors de solliciter l'événement MouseMove() précité dans le module du formulaire comme suit :

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End Sub

J'ai expressément ajouté un bloc If /End If qui vérifie quel bouton est appuyé et ici, c'est le gauche. cela se traduit par :
Si c'est bien le bouton gauche qui est enfoncé, alors appel respectif des fonctions ReleaseCapture() et SendMessage().

Vous pouvez alors tester de nouveau en appuyant sur F5 et vous constatez que vous pouvez déplacer le formulaire à votre guise.