UNE INTERFACE SYMPA AVEC PAS GRAND CHOSE ET PEU DE CODE

'******************************************************************
'Attention !!! Ceci n'est que le code de la form
' en effet un module existe dans le projet pour les fonctions de découpe de la form
' et récupération des fichiers images depuis le fichiers ressource
'******************************************************************

Option Explicit

Private MousePosFrm As POINTAPI

'pour le déplacement de la fenetre
Private Sub FctMouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    With MousePosFrm
        .x = x
        .Y = Y
    End With
    If Button = vbLeftButton Then Screen.MousePointer = vbSizeAll
End Sub
'déplcament de la fenetre si le bouton gauche de la souris est appuyé
Private Sub FctMouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = vbLeftButton Then Me.Move Me.Left + x - MousePosFrm.x, Me.Top + Y - MousePosFrm.Y
End Sub
Private Sub FctMouseUp()
    Screen.MousePointer = vbDefault
End Sub

'raffraichissement du label d'information équivalent à un ToolTipText
Private Sub ChangeLblInfo(Optional ByVal Texte As String = "Gestionnaire Multimedia")

    DoEvents
    With LblInfo
        .Top = 0
        .FontSize = 14
        .FontBold = True
    End With
    With PicLbl
        .AutoRedraw = True
        .Move 0, 780, PicBG.Width, 600
        .PaintPicture PicBG.Picture, 0, 0, .Width, .Height, .Left, .Top, .Width, .Height
    End With
    With LblInfo
        .Caption = Texte
        .Top = (PicLbl.Height - .Height) / 2
        .Left = (PicBG.Width - .Width) / 2
    End With
    
End Sub

Private Sub Form_Load()

    Dim i As Long
    
    'création de l'interface
    With PicBG
        .AutoRedraw = True
        .BackColor = vbMagenta
        .BorderStyle = 0
        .AutoSize = True
        .BorderStyle = 0
        .ScaleMode = vbPixels
        .Move 0, 0, 6150, 4980
        .Picture = LoadResPic("FOND", "FOND")
        Me.BackColor = vbMagenta
        Me.Width = .Width
        Me.Height = .Height

        '"Découpe" la form suivant PictBG
        Call DecoupeForm(Me.hwnd, PicBG)
        .ScaleMode = vbTwips
    End With

    With PicMain
        .Move 900, 1590, 4350, 2430
        .PaintPicture PicBG.Picture, 0, 0, .Width, .Height, .Left, .Top, .Width, .Height
    End With

    With ImgCroix
        .Move 5340, 480
        .Tag = "CROIX"
        .Mode = AutoSize
        .MousePointer = [Cursor : Hand]
        Set .ImgMouseOut = LoadResPic(.Tag, "OUT")
        Set .ImgMouseHover = LoadResPic(.Tag, "HOVER")
        .Visible = True
    End With

    'création des boutons
    For i = 0 To 4
        If i <> 0 Then Load ImgMain(i)
        With ImgMain(i)
            .Tag = LoadResString(i)
            .Mode = AutoSize
            .AlphaColor = vbMagenta
            .Transparent = True
            .MousePointer = [Cursor : Hand]
            Set .ImgMouseOut = LoadResPic(.Tag, "OUT")
            Set .ImgMouseHover = LoadResPic(.Tag, "HOVER")
            Set .ImgMask = LoadResPic(.Tag, "MASK")
            .Visible = True
            Set .Container = PicMain
            If i <= 2 Then
                Set ImgMain(i).Container = PicMain
                ImgMain(i).Left = ((PicMain.Width / 3) * i) + (((PicMain.Width / 3) - ImgMain(0).Width) / 2)
                ImgMain(i).Top = ((PicMain.Height / 2) - ImgMain(i).Height) / 2
            Else
                Set ImgMain(i).Container = PicMain
                ImgMain(i).Left = ((PicMain.Width / 2) * (i - 3)) + (((PicMain.Width / 2) - ImgMain(0).Width) / 2)
                ImgMain(i).Top = (((PicMain.Height / 2) - ImgMain(i).Height) / 2) + (PicMain.Height / 2)
            End If
        End With
    Next
    
    'raffraichissement du label d'information
    ChangeLblInfo
    
End Sub

Private Sub ImgMain_MouseEnter(Index As Integer)
    ChangeLblInfo LoadResString(100 + Index)
End Sub

Private Sub ImgMain_MouseLeave(Index As Integer)
    ChangeLblInfo
End Sub

Private Sub ImgCroix_Click()
    If MsgBox("Quitter le gestionnaire multimedia ?", vbYesNo + vbQuestion, "Quitter") = vbYes Then Unload Me
End Sub

Private Sub ImgCroix_MouseEnter()
     If PicMain.Visible = True Then ChangeLblInfo "QUITTER"
End Sub

Private Sub ImgCroix_MouseLeave()
    If PicMain.Visible = True Then ChangeLblInfo
End Sub

Private Sub PicBG_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseDown(Button, Shift, x, Y): End Sub

Private Sub PicBG_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseMove(Button, Shift, x, Y): End Sub

Private Sub PicBG_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseUp: End Sub

Private Sub PicLbl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseDown(Button, Shift, x, Y): End Sub

Private Sub PicLbl_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseMove(Button, Shift, x, Y): End Sub

Private Sub PicLbl_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseUp: End Sub

Private Sub PicMain_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseDown(Button, Shift, x, Y): End Sub

Private Sub PicMain_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseMove(Button, Shift, x, Y): End Sub

Private Sub PicMain_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single): Call FctMouseUp: End Sub

Télécharger le zip

13 avril 2005 14:48:17 :

* ajout du fichier YommSubClasser.dll oublié (il s'agit du controle de Renfield recompilé pour des besoins particuliers mais je ne suis pas l'auteur de cette dll ) * ajout d'un fichier zip du source du controle YommFormZone

14 avril 2005 16:19:54 :

* refonte du projet pour inclure le source du controle * modifications apportées au controle lui même - ajout de la fonctionnalité transparence pour les modes stretch et repeat - ajout de la propriété backcolor utilisable en transparent = false * et ajout des commentaires qui en effet étaient assez peu nombreux

18 avril 2005 13:07:24 :

* modif du controle YommFormZone - modification pour inclure le source de la dll de subclassing à l'ocx ...ainsi , plus besoin de la dll , l'ocx se suffit à lui même - correction d'un bug en mode autosize

30 juillet 2005 14:01:11 :

modif pour le redimmensionnement du controle YommFormZone

30 juillet 2005 14:08:17 :

mise à jour du source pour mise à jour du controle YommFormZone