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


Télécharger le projet
Commenter

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)
Télécharger le projet

Codes Sources

A voir également

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 (CCJ)