UN PROGRAMME MULTI-FONCTIONS(MUSIQUE,CPATURE D'ECRAN,INTERNET ETC...)

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

Télécharger le zip

19 août 2004 22:01:42 :

Problemme avec la fonction suprimmeur dans frmMenu a eté reparer!

20 août 2004 10:51:17 :

Des commentaire (pour debutant)

22 août 2004 22:04:00 :

il y a plu qu'une erreur

22 août 2004 22:10:31 :

erreur reparer(compenser)