Accueil > > > UN PROGRAMME MULTI-FONCTIONS(MUSIQUE,CPATURE D'ECRAN,INTERNET ETC...)
UN PROGRAMME MULTI-FONCTIONS(MUSIQUE,CPATURE D'ECRAN,INTERNET ETC...)
Information sur la source
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
- 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
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)
Historique
- 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)
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
[WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
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 Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|