1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Défi: problèmes irésolut en vb

Défi: problèmes irésolut en vb

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 166 fois - Téléchargée 43 fois

Commenter

Contenu du snippet

Voici quelque probeme que jai pas encore résolut.
1)Toufer le app.path parent :Je créer un ocx et mon ocx doit aller lire dans le app.path du projet auqel il est ajouter. (Le app.path du ocx est pas lui du projet forcément)
2)avec un ocx: Créer un(type de) public enum avec les fichier dans un dossier : example:
L'utilisateur entre DreamMedia(ocx).lireMusique(choix des musiques présent dans le dossier)
example:

OcX.JouerMusique(PremiereMusique)
(2e musique )
Note:les musique ne sont pas constante,il peu en avoir une seul comme 1000.

3)Je cherche comment personaliser un ocx(créer son propre petite case dans le coté.....
jenre créer loption personamlisé et metre ses option comme on veut ert non prendre les préfait.(((jwenre ajouter loption ListeFIchier ou personaliser a meme place que caption,top,left......vous devez acvoir comprit =:0)

4)Comment metre un poblic enum simplement a un ocx sa marche pas(un example et sa vas etre ok)

5)et derniere...Voici un code que je veut rapetiser ou optimiser a vous de vous esayer(sé un ocx(renommer variable indexer,tout est permit)jaimerais bien voi comment faire des Fonction avec mon code,bref minimiser la taille augmenter la vitesse et commentaire je mexcuse lol)

Source / Exemple : 


'Public Property Get JouerMusique1() As Long
    'JouerMusique = m_BackColor
'End Property
'******************************************
'**      Author: Marc Baril              **
'**        Date: 19/01/2002              **
'******************************************
'** Description: Simplification de       **
'**              Clsmultimdia            **
'**              Wav,Midi,AVI            **
'******************************************
'**      Tested: On  Windows  98 and  XP **
'**                                      **
'******************************************

'1 - Ajouter les musiques et les sons dans un répetoire respectif de votre projet
'2 - Ajouter Se module se module  ainsi que Execution.frm dans votre projet
'3 - Ajouter Initialiser dans le Form_Load ou Form_Initialize de votre projet
'4 - Pour jouer une musique utiliser JouerMusique (Index de la musique)
'5 - Pour jouer un son utiliser JouerSound (Index du son)
'7 - Commande utilisé: JouerMusique,JouerSound,PauseMusique,StopMusique,ContinueMusique
Dim IsInitialiser, IsNotReInitialiser, IsContainFileOnInit, IsGoodFileNameOnInit, IsGoodIndex, IsOkBeforeRead, IsGoodFile, IsGoosType, IsGoodName, IsGoodFolder As Boolean 'sur form fairre arbre des erreur..
Dim NbMusique, NbSound, NbVideo As Integer
Dim LireMusique(60), LireSound(60), LireVideo(60) As String
Dim Filepath As String
Public Enum Type_Degrade
    Escalier = 1
    Glisanto = 2
End Enum
Public Enum Arret_Type
    Musique = 1
    Sound = 2
    Tout = 3
End Enum

Public Sub Initialiser()
    Dim Find As String
    
    If Execution.MMPlayer.IsSoundCardEnabled Then Else: Message (6)
    
    Find = Dir(App.Path & "\Musique\" & "*.*")
        If Find <> "" Then
            Do
            If Find <> "." And Find <> ".." Then
                NbMusique = NbMusique + 1
                LireMusique(NbMusique) = "\Musique\" & Find
            End If
            Find = Dir()
            Loop Until Find = ""
         End If

    Find = Dir(App.Path & "\Sound\" & "*.*")
        If Find <> "" Then
            Do
            If Find <> "." And Find <> ".." Then
                NbSound = NbSound + 1
                LireSound(NbSound) = "\Sound\" & Find
            End If
            Find = Dir()
            Loop Until Find = ""
         End If
         
    Find = Dir(App.Path & "\Video\" & "*.*")
        If Find <> "" Then
            Do
            If Find <> "." And Find <> ".." Then
                NbVideo = NbVideo + 1
                LireVideo(NbVideo) = "\Video\" & Find
            End If
            Find = Dir()
            Loop Until Find = ""
         End If
End Sub
'************************************************************************************
'************************************************************************************
'************************************************************************************
Public Sub JouerMusique(Index As Integer)
    If IsNumeric(Index) Then
        If Index <= NbMusique And Index > 0 Then
            Filepath = App.Path & LireMusique(Index)
            Execution.MMPlayer.FileName = Filepath
            Execution.MMPlayer.Play
        Else
            If Index = 0 Then Message (7) Else Message (8)
        End If
    Else
        Execution.MVPlayer.FileName = App.Path & "\Musique\" & Index
    End If
End Sub

Public Sub JouerSound(Index As Integer)
    If IsNumeric(Index) Then
        If Index <= NbSound And Index > 0 Then
            Filepath = App.Path & LireSound(Index)
            Execution.SMPlayer.FileName = Filepath
            Execution.SMPlayer.Play
        Else
            If Index = 0 Then Message (9) Else Message (10)
        End If
    Else
        Execution.MVPlayer.FileName = App.Path & "\Sound\" & Index
    End If
End Sub

Public Sub JouerVideo(Emplacement_X As Integer, Emplacement_Y As Integer, Largeur As Integer, Longueur As Integer, Nom_du_Video As String)
    Execution.Height = Longueur
    Execution.Width = Largeur
    Execution.Top = Emplacement_Y
    Execution.Left = Emplacement_X
    Execution.MVPlayer.Height = Longueur
    Execution.MVPlayer.Width = Largeur
    Execution.MVPlayer.Top = 0
    Execution.MVPlayer.Left = 0
    Execution.Show
    If IsNumeric(Nom_du_Video) Then
        If Nom_du_Video <= NbVideo And Nom_du_Video > 0 Then
            Filepath = App.Path & LireVideo(Nom_du_Video)
            Execution.MVPlayer.FileName = Filepath
            Execution.MVPlayer.Play
            Else
                If Nom_du_Video = 0 Then Message (7) Else Message (8)
        End If
        Else
            Execution.Show
            Execution.MVPlayer.FileName = App.Path & "\Video\" & Nom_du_Video
    End If
End Sub
'************************************************************************************
'************************************************************************************
'************************************************************************************
Public Sub StopMultimedia(Apliquation_sur As Integer)
    On Error Resume Next
    If Apliquation_sur = 1 Then Execution.MMPlayer.Stop
    If Apliquation_sur = 1 Then Execution.MMPlayer.CurrentPosition = 1
        If Apliquation_sur = 2 Then Execution.SMPlayer.Stop
            If Apliquation_sur = 3 Then Execution.MMPlayer.Stop
            If Apliquation_sur = 3 Then Execution.MMPlayer.CurrentPosition = 1
            If Apliquation_sur = 3 Then Execution.SMPlayer.Stop
End Sub

Public Sub PauseMusique()
    On Error Resume Next
    Execution.MMPlayer.Pause
End Sub
'************************************************************************************
'************************************************************************************
'************************************************************************************
Public Sub SautMusique(Saut_de_combien_de_seconde As Integer)
    On Error Resume Next
    If Execution.MMPlayer.PlayState <> mpPlaying Then Exit Sub
    Execution.MMPlayer.CurrentPosition = Execution.MMPlayer.CurrentPosition + Saut_de_combien_de_seconde
End Sub

Public Sub ContinueMusique()
    On Error Resume Next
    Execution.MMPlayer.Play
End Sub
'************************************************************************************
'************************************************************************************
'************************************************************************************
Public Sub VolumeMusique(Nouveau_Volume_en_pourcentage As Integer, Apliquation_sur As Integer)
    On Error Resume Next
    Volume = (Nouveau_Volume_en_pourcentage * 25) - 2500
    If Apliquation_sur = 1 Then Execution.MMPlayer.Volume = Volume
        If Type_Volume = 2 Then Execution.SMPlayer.Volume = Volume
            If Apliquation_sur = 3 Then Execution.MMPlayer.Volume = Volume
            If Apliquation_sur = 3 Then Execution.SMPlayer.Volume = Volume
            Execution.MMPlayer.Mute = IIf(Volume + 2500 = 0, True, False)
End Sub

Public Sub DegradeMusique(Durée_du_dégrader As Integer, Nouveau_Volume_en_pourcentage As Integer, Type_De_dégrader As Integer)
    On Error Resume Next
    Dim VolumeActuel As Integer
    Dim Facteur As Integer
    VolumeActuel = Execution.MMPlayer.Volume
    Facteur = ((((Nouveau_Volume_en_pourcentage * 25) - 2500) - VolumeActuel) / Durée_du_dégrader)
    Durée_du_dégrader = IIf(Type_Deg = Escalier, Durée_du_dégrader, Durée_du_dégrader * 10)
    For I = 1 To Durée_du_dégrader
        If Type_De_dégrader = Escalier Then Execution.MMPlayer.Volume = Execution.MMPlayer.Volume + Facteur Else Execution.MMPlayer.Volume = Execution.MMPlayer.Volume + Facteur / 10
        If I = Durée_du_dégrader Then Execution.MMPlayer.Volume = (Nouveau_Volume_en_pourcentage * 25) - 2500
        Execution.MMPlayer.Mute = IIf(Execution.MMPlayer.Volume = -2500, True, False)
        DoEvents
        If Type_De_dégrader = Escalier Then Pause 1 Else Pause 0.1
    Next I
End Sub

Public Sub BalanceMusique(Nouvelle_Balance_de_100_a_minus_100 As Integer, Apliquation_sur As Integer)
    On Error Resume Next
    If Apliquation_sur = 1 Then Execution.MMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50
        If Apliquation_sur = 2 Then Execution.SMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50
            If Apliquation_sur = 3 Then Execution.MMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50
            If Apliquation_sur = 3 Then Execution.SMPlayer.Balance = Nouvelle_Balance_de_100_a_minus_100 * 50
End Sub

Public Sub Message(Index As Integer)
    If Index = 7 Then MsgBox ("Un appel à la musique indexée 0 a été faite,changer l'indexe inexistant s,il s'agit d'une erreur de code et Vérifier que la musique désirée se trouve bien dans le répertoire Musique dans un sous dossier de votre projet")
    If Index = 8 Then MsgBox ("Un appel à la musique don l'index est inéxistante a été faite,mais la musique appelée n'existe pas.Vous devez changé cet indexe.")
    If Index = 9 Then MsgBox ("Un appel à un son indexé 0 a été faite,changer l'indexe inexistant s,il s'agit d'une erreur de code et Vérifier que le son désirée se trouve bien dans le répertoire Musique dans un sous dossier de votre projet")
    If Index = 10 Then MsgBox ("Un appel à un son d'on l'index est inéxistante a été faite,mais le son appelé n'existe pas.Vous devez changé cet indexe.")
    If Index = 11 Then MsgBox ("Les dossiers Musique et Sound dans votre projet son introuvable veyez les ajouter ,louverture du programme doit etre interompu.")
End Sub
'************************************************************************************
'************************************************************************************
'Ajout pour simplifier la programmation
'************************************************************************************
'Pause permet plusieur fonction symultané,mais Sleep jele tout les controles
'Pause fontionne au 0.5 seconde et Sleep au miliemme
Public Sub Pause(NbSec As Single)
    Dim Sortie As Single
    Sortie = Timer + NbSec
    DoEvents
    Do Until Timer >= Sortie
    Loop
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = 720
    UserControl.Width = 720
End Sub

Maintenant la form execution avec du code de florant

'Code de Florent.
'Si vous ajoutez ce code dans un de vos programmes, citez-moi.

Option Explicit
Public OldWidth As Integer  'On va stocker l'ancienne largeur de la feuille dans cette variable
Public OldHeight As Integer 'De même pour le hauteur

Private Sub Form_Load()
OldWidth = Width 'Au chargement, l'ancienne largeur de la feuille est la largeur actuelle
OldHeight = Height 'De même pour la hauteur
End Sub

Private Sub Form_Resize()
On Error Resume Next 'Si il y a une erreur, on continue
Dim XCoeff As Single 'Le coefficient qui va nous servir pour la largeur et le placement horizontal des contrôles
Dim YCoeff As Single 'De même pour la hauteur et le placement vertical des contrôles
Dim Controle As Control 'Control représente n'importe quel contrôle de la feuille
XCoeff = Width / OldWidth 'Un simple rapport entre la nouvelle largeur et l'ancienne
YCoeff = Height / OldHeight 'Dee même pour la hauteur
For Each Controle In Me 'Pour chaque controle de la feuille...
Controle.Move Controle.Left * XCoeff, Controle.Top * YCoeff, Controle.Width * XCoeff, Controle.Height * YCoeff 'On le déplace et redimmentionne en même temps
Next 'Et on passe au suivant
OldWidth = Width 'On change l'ancienne largeur par la nouvelle
OldHeight = Height 'De même avec la hauteur
End Sub
 
'vérifier fichier
'Fichier_Existe= IIF(Dir(Path ) = "",true,false)

A voir également

Ajouter un commentaire Commentaires
XGuarden
Messages postés
259
Date d'inscription
dimanche 14 juillet 2002
Statut
Membre
Dernière intervention
17 août 2012
9 déc. 2006 à 06:55
Ten fait toi pas, ce code date de 4 ou 5 ans lol depuis j'ai pas mal régler tout mes problemes et améliorer ma technique de programmation de 100 fois lol
MadM@tt
Messages postés
2167
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
16 juillet 2009
 1
17 avril 2005 à 22:02
Rien compris moi non plus...
DHKold
Messages postés
153
Date d'inscription
vendredi 6 décembre 2002
Statut
Membre
Dernière intervention
29 mai 2005
 2
16 août 2003 à 15:33
Vous allez parfois voir dans la FAQ?
Sinon j'avoue que je n'ai pas tout compris...
A la place du enum, pourquoi tu ne créé pas seulmement une fonction ou une méthode qui demande en argument le numéro de la musique à jouer?
Dalida
Messages postés
6728
Date d'inscription
mardi 14 mai 2002
Statut
Contributeur
Dernière intervention
11 janvier 2016
20 août 2002 à 18:15
ca donne le tournis c't'histoire!
:o(
cs_korg
Messages postés
26
Date d'inscription
jeudi 9 mai 2002
Statut
Membre
Dernière intervention
25 mars 2006
3 août 2002 à 19:05
j'ai rien compris!
Afficher les 18 commentaires
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 (XGuarden)