Un programme multi-fonctions(musique,cpature d'ecran,internet etc...)

Soyez le premier à donner votre avis sur cette source.

Vue 4 248 fois - Téléchargée 481 fois


Description

ceci est mon premier programme alors soyer indulgents SVP.Ce prog est comme sont nom l'indique multi fonction il contient:
une form mot de pass
une form capture d'ecran
un editeur de textes
internet
une form musique
et un "suprimmeur"
Je sais que j'invente rien mais ca peut toujour servir ;)

Source / Exemple :


capture:
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Dim numero As String
Dim code As String
Dim user As String

Private Sub cmdArreter_Click()
txtCode.Text = ""
txtUtilisateur.Text = ""
user = ""
code = ""
Timer1.Enabled = False
cmdCommencer.Enabled = True
End Sub

Private Sub cmdCommencer_Click()
If txtCode.Text = "" Or txtUtilisateur.Text = "" Then
MsgBox "Texte(s) vide!", vbOKOnly, "Attention"
Else
user = txtUtilisateur.Text
code = txtCode.Text
txtCode.Text = ""
txtUtilisateur.Text = ""
cmdCommencer.Enabled = False
cmdArreter.Enabled = False
Timer1.Enabled = True
End If
End Sub

Private Sub Form_Load()
numero = "0"
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub Timer1_Timer()
numero = numero + 1
Call keybd_event(vbKeySnapshot, 0, 0, 0)
DoEvents
SavePicture Clipboard.GetData, App.Path & "image" & numero & ".jpeg"
End Sub

Private Sub Timer2_Timer()
frmCapture.Caption = "Capture" & " " & Time
End Sub

Private Sub txtCode_Change()
If txtCode.Text = code And txtUtilisateur.Text = user Then
cmdArreter.Enabled = True
End If
End Sub

Private Sub txtUtilisateur_Change()
If txtCode.Text = code And txtUtilisateur.Text = user Then
cmdArreter.Enabled = True
End If

End Sub

code:
Dim foi As String

Private Sub cmdQuitter_Click()
End
End Sub

Private Sub cmdValider_Click()
If txtUtilisateur = "VirusMan" And txtCode.Text = "code" Then
txtUtilisateur.Text = ""
txtCode.Text = ""
Unload Me
frmMenu.Show
Else
txtUtilisateur.Text = ""
txtCode.Text = ""
foi = foi + 1
Select Case foi
Case "1"
MsgBox "Erreur,encore deux essais!", vbCritical, "Erreur"
Case "2"
MsgBox "Erreur,encore un essai!", vbCritical, "Erreur"
Case "3"
MsgBox "Erreur,pas plus de trois essais!", vbCritical, "Erreur"
End
End Select
End If
End Sub

Private Sub Form_Load()
foi = "0"
End Sub

Private Sub Timer1_Timer()
frmCode.Caption = "Code" & " " & Time
End Sub

editeur de textes:
Dim choi As String
Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub mnuEnregistrer_Click()
CommonDialog1.CancelError = True
On Error GoTo erreur
CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Output As #1
Write #1, txtTextes.Text
Close
erreur:
Exit Sub
End Sub

Private Sub mnuNouveau_Click()
choi = MsgBox("Attention , etes vous sur ?", vbYesNo, "Attention")
If (choi = vbYes) Then
txtTextes.Text = ""
End If
End Sub

Private Sub mnuOuvrir_Click()
CommonDialog1.CancelError = True
On Error GoTo erreur
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Input As #1
Input #1, a
txtTextes = a
Close
erreur:
Exit Sub
End Sub

Private Sub mnuPolice_Click()
CommonDialog1.CancelError = True
On Error GoTo erreur
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowFont
txtTextes.FontBold = CommonDialog1.FontBold
txtTextes.FontItalic = CommonDialog1.FontItalic
txtTextes.FontName = CommonDialog1.FontName
txtTextes.FontSize = CommonDialog1.FontSize
erreur:
Exit Sub
End Sub

Private Sub Timer1_Timer()
frmEditeur.Caption = "Editeur de textes" & " " & Time
End Sub

envois de touches:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub cmdCommencer_Click()
For foi = 0 To txtRepetition.Text
Sleep txtDelai.Text
keybd_event txtTouche1.Text, 0, 0, 0
keybd_event txtTouche1.Text, 0, 2, 0
keybd_event txtTouche2.Text, 0, 0, 0
keybd_event txtTouche2.Text, 0, 2, 0
keybd_event txtTouche3.Text, 0, 0, 0
keybd_event txtTouche3.Text, 0, 2, 0
keybd_event txtTouche4.Text, 0, 0, 0
keybd_event txtTouche4.Text, 0, 2, 0
keybd_event txtTouche5.Text, 0, 0, 0
keybd_event txtTouche5.Text, 0, 2, 0
keybd_event txtTouche6.Text, 0, 0, 0
keybd_event txtTouche6.Text, 0, 2, 0
Next foi
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub Timer1_Timer()
frmEnvois.Caption = "Envois de touches" & " " & Time
End Sub

internet:
Private Sub cmdChercher_Click()
If Combo1.Text = "" Then
MsgBox "Chemin invalide"
Else
WebBrowser1.Navigate Combo1.Text
Combo1.AddItem Combo1.Text
End If
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://www.vbfrance.com"
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub Timer1_Timer()
frmInternet.Caption = "Internet" & " " & Time
End Sub

menu:
Private Sub cmdValider_Click()
Select Case lstChoi.Text
Case "Capture"
Unload Me
frmCapture.Show
Case "Internet"
Unload Me
frmInternet.Show
Case "Multimedia"
Unload Me
frmMultimedia.Show
Case "Editeur"
Unload Me
frmEditeur.Show
Case "Envois"
Unload Me
frmEnvois.Show
Case "Suprimmeur"
Unload Me
frmSuprimmeur.Show
End Select
End Sub

Private Sub Timer1_Timer()
frmMenu.Caption = "Menu" & " " & Time
End Sub

multimedia:
Private Sub cmdOuvrir_Click()
mmc1.Command = "close"
CommonDialog1.CancelError = True
On Error GoTo erreur
CommonDialog1.ShowOpen
mmc1.FileName = CommonDialog1.FileName
mmc1.Command = "open"
erreur:
Exit Sub
End Sub

Private Sub Form_Load()
mmc1.Command = "close"
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub Timer1_Timer()
frmMultimedia.Caption = "Multimedia" & " " & Time
End Sub

suprimmeur:
Private Sub cmdChoisir_Click()
cmd1.CancelError = True
On Error GoTo erreur
cmd1.ShowOpen
txtFichier.Text = cmd1.FileName
erreur:
Exit Sub
End Sub

Private Sub cmdSuprimmer_Click()
If txtFichier.Text = "" Then
MsgBox "Erreur , texte vide !", vbCritical, "Erreur"
Else
If Dir(txtFichier.Text) <> "" Then
Kill txtFichier.Text
txtFichier.Text = ""
Else
txtFichier.Text = ""
End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMenu.Show
End Sub

Private Sub Timer1_Timer()
frmSuprimmeur.Caption = "Surpimmeur" & " " & Time
End Sub

Conclusion :


prochaine rajout prevu :
une form option
un tchat
un lecteur d'image qui va avec la capture
(si je dit "prochaint rajout c'est parceque je sais pas encore le faire)
j'ai reparer l'erreur en ajoutant du code(ne faites pas attention au message d'erreur)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
565
Date d'inscription
mercredi 19 mai 2004
Statut
Membre
Dernière intervention
30 avril 2008
1
merci
t'enfait pas je vais rajouter les commentaires
Messages postés
49
Date d'inscription
jeudi 10 juin 2004
Statut
Membre
Dernière intervention
6 mai 2006

Merci pour l'explicatif
ke vais essayer de comprendre ton codes(pas mnt parce que je debute encore en VB)
des que possible
et je vais etres precis
Bon bonne continuation et bonne prog A+
Messages postés
565
Date d'inscription
mercredi 19 mai 2004
Statut
Membre
Dernière intervention
30 avril 2008
1
1/10
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
sniffffffffffffffffffffff
UN 5 ME PLAIRAIT PLUS!!!!!!
Messages postés
565
Date d'inscription
mercredi 19 mai 2004
Statut
Membre
Dernière intervention
30 avril 2008
1
je ne peut pas te dire grand chose de plus a part que
mmc1.command = "play" lance le lecteur
mmc1.hwnddisplay = picture1.hwnd sert a pouvoir ouvrir
un fichier video
sinon je peut pas plus t'aider il faudrai que tu soit plus preci dans tes question
voila!
Messages postés
49
Date d'inscription
jeudi 10 juin 2004
Statut
Membre
Dernière intervention
6 mai 2006

Merci pour l'explication
tres cool de ta part .

bahh je veut plus bien sur ;-)))
Afficher les 21 commentaires

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.