Accueil > > > UNE INTERFACE SYMPA AVEC PAS GRAND CHOSE ET PEU DE CODE
UNE INTERFACE SYMPA AVEC PAS GRAND CHOSE ET PEU DE CODE
Information sur la source
Description
voilà ce source est juste un exemple faisant référence à pas mal de notions vous permettant de créer une interface sympa avec pas grand chose!!!! le notions utilisées dans ce projet : * l'utilisation de fichier ressource - récupération de chaine de texte depuis un fichier res avec LoadResString - récupération de donnée et conversion en fichier image (un peu plus complexe) * utilisation d'un controle perso (le YommFormZone V2, je vous demande pas qui l'a développé ;-) ) * découpage de fentêtre pour avoir une fenetre transparente * chargement dynamique de controles voilà en gros pour les notions ;-) pour l'interface tenez vous bien , elle ne contient que 7 controles (dont la form elle même) et le code de la fenêtre il est en dessous ;-) Quand je vous dis que cet exemple vous permet de faire une interface sympa avec pas grand chose je vous ments pas vous voyez !!!
Source
- '******************************************************************
- '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
-
'******************************************************************
'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
Conclusion
tous ce source est un regroupement de plusieurs notions qui combinées entre-elles donnent un truc plutot sympa non?
vous avez peut être déjà croisé certaines lignes de code de ce projet sur le site et c'est normal car je n'allais pas réinventer ce que d'autres avaient déjà fait. Mais les bouts de code récupérer ont été vérifiés et parfois modifiés pour une utilisation optimale !!!
voilà , en espérant vous faire plaisir
PS: avouez que certains d'entre vous ne pensaient pas pouvoir faire quelque chose dans ce genre aussi facilement ;-)
--------------------------------------------- -------------------------------------------------- ---------------------
le source du controle YommFormZone est dans un zip et oui , on ne peut pas compilé un exe si on fait un multiprojet avec un ocx
Historique
- 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
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|