Soyez le premier à donner votre avis sur cette source.
Vue 9 674 fois - Téléchargée 1 955 fois
'****************************************************************** '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
28 oct. 2005 à 21:20
Ca fait plaisir de voir k'on garde certains de mes sources même si on en a pas besoin lol ;-)
merci @ toi
28 oct. 2005 à 15:46
J'ai adoré le premier commentaire ça m'a fait beaucoup rire.
30 juil. 2005 à 19:53
mais content que cela ait attiré ton attention ;-) et merci
30 juil. 2005 à 15:12
Bien structuré, bien commenté et tout et tout.
Bref: Super 10/10
25 juil. 2005 à 15:02
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.