Source / Exemple :
'"""""""""""""""""""""""""""""""""""""""""""""""""
'" http://www.chez.com/pitrack1 "
'" pitrack1@club-internet.fr "
'" Source crée avec visual basic 5.0 "
'"""""""""""""""""""""""""""""""""""""""""""""""""
Private Sub Command1_Click()
'Fin du programme
M$ = "Voulez-vous vraiment quitter le programme de conversion ?"
Réponse% = MsgBox(M$, vbYesNo + vbQuestion, "Quitter le programme")
If Réponse% = vbYes Then
End
End If
End Sub
Private Sub Command2_Click()
'Les erreurs sont ignorées
On Error Resume Next
'Fichier(s) sélectionné(s) ?
For X% = 0 To File1.ListCount - 1
'Mention active sélectionnée ?
If File1.Selected(X%) Then
'Par exemple c:iconesitmap oto.ico
Fichier$ = Dir1.Path + "" + File1.List(X%)
'Charger icône
Image1.Picture = LoadPicture(Fichier$)
Picture1.Picture = LoadPicture(Fichier$)
If Option1.Value = True Then
'Nom défini automatiquement par remplacement de l'extension
'Pas de changement de localisation!
Fichier$ = Left$(Fichier$, Len(Fichier$) - 3) + "bmp"
SavePicture Picture1.Image, Fichier$
ElseIf Option2.Value = True Then
'Affectation manuelle du nom de fichier
'Chemin d'accès personnalisé!
If Val(Text2.Text) <> 0 Then
'Pas de 0 dans les noms de fichier
Fichier$ = Text3.Text + Text1.Text + Text2.Text + ".bmp"
Else
'Incrément
Fichier$ = Text3.Text + Text1.Text + ".bmp"
End If
'Enregistrer l'icône en Bitmap
SavePicture Picture1.Image, Fichier$
'Augmenter compteur
Nr% = Val(Text2.Text) + 1
'Noter nouvelle valeur dans la zone de texte
Text2.Text = Trim$(Str$(Nr%))
End If
End If
Next X%
End Sub
Private Sub Command3_Click()
'Ouvre la visionneuse
FormDia.Show vbModal
End Sub
Private Sub Command4_Click()
'Ouvre la boite de dialogue Enregistrer
On Error GoTo TraiteErreur
Dim Source As String
Dim Cible As String
Source = File1.Path
If Right(Source, 1) <> "" Then Source = Source & ""
Source = Source & File1.filename
Dialog.Flags = 2
Dialog.ShowSave
Cible = Dialog.filename
FileCopy Source, Cible
File1.Refresh
Exit Sub
TraiteErreur:
If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, 16, "Erreur !"
End Sub
Private Sub Command5_Click()
'Supprime l'image définitivement
On Error GoTo TraiteErreur
ChDrive Drive1.Drive
ChDir File1.Path
Kill (File1.filename)
File1.Refresh
Exit Sub
TraiteErreur:
MsgBox Err.Description, 16, "Erreur !"
End Sub
Private Sub Dir1_Change()
'Chemin du disque
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
'Chemin du répertoire
On Error Resume Next
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
If File1.filename <> "" Then
Fichier$ = Dir1.Path + "" + File1.filename
'Charger l'icône
Image1.Picture = LoadPicture(Fichier$)
Picture1.Picture = LoadPicture(Fichier$)
Fichier$ = Path$ + File1.filename
Label4 = "Aperçu de :" + File1.filename
End If
End Sub
Private Sub Form_Load()
'Chemin de destination = Chemin du programme
Chemin$ = App.Path
If Right$(Chemin$, 1) <> "" Then
Chemin$ = Chemin$ + ""
End If
Text3.Text = Chemin$
End Sub
Private Sub mnuapro_Click()
frmDeroule.Show
End Sub
Private Sub mnuenregistre_Click()
'Ouvre la boite de dialogue Enregistrer
On Error GoTo TraiteErreur
Dim Source As String
Dim Cible As String
Source = File1.Path
If Right(Source, 1) <> "" Then Source = Source & ""
Source = Source & File1.filename
Dialog.Flags = 2
Dialog.ShowSave
Cible = Dialog.filename
FileCopy Source, Cible
File1.Refresh
Exit Sub
TraiteErreur:
If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, 16, "Erreur !"
End Sub
Private Sub mnuquitte_Click()
'Fin du programme
M$ = "Voulez-vous vraiment quitter le programme de conversion et de Visualisation?"
Réponse% = MsgBox(M$, vbYesNo + vbQuestion, "Quitter le programme")
If Réponse% = vbYes Then
End
End If
End Sub
Private Sub mnusauve_Click()
'Les erreurs sont ignorées
On Error Resume Next
'Fichier(s) sélectionné(s) ?
For X% = 0 To File1.ListCount - 1
'Mention active sélectionnée ?
If File1.Selected(X%) Then
'Par exemple c:iconesitmap oto.ico
Fichier$ = Dir1.Path + "" + File1.List(X%)
'Charger icône
Image1.Picture = LoadPicture(Fichier$)
Picture1.Picture = LoadPicture(Fichier$)
If Option1.Value = True Then
'Nom défini automatiquement par remplacement de l'extension
'Pas de changement de localisation!
Fichier$ = Left$(Fichier$, Len(Fichier$) - 3) + "bmp"
SavePicture Picture1.Image, Fichier$
ElseIf Option2.Value = True Then
'Affectation manuelle du nom de fichier
'Chemin d'accès personnalisé!
If Val(Text2.Text) <> 0 Then
'Pas de 0 dans les noms de fichier
Fichier$ = Text3.Text + Text1.Text + Text2.Text + ".bmp"
Else
'Incrément
Fichier$ = Text3.Text + Text1.Text + ".bmp"
End If
'Enregistrer l'icône en Bitmap
SavePicture Picture1.Image, Fichier$
'Augmenter compteur
Nr% = Val(Text2.Text) + 1
'Noter nouvelle valeur dans la zone de texte
Text2.Text = Trim$(Str$(Nr%))
End If
End If
Next X%
End Sub
Private Sub mnusupprime_Click()
'Supprime l'image définitivement
On Error GoTo TraiteErreur
ChDrive Drive1.Drive
ChDir File1.Path
Kill (File1.filename)
File1.Refresh
Exit Sub
TraiteErreur:
MsgBox Err.Description, 16, "Erreur !"
End Sub
Private Sub mnuvisionne_Click()
'Ouvre la visionneuse
FormDia.Show vbModal
End Sub
Private Sub opPattern_Click(Index As Integer)
Select Case Index
Case 0
'Affichage des fichiers d'icônes
File1.Pattern = "*.ico"
'Conversion possible
Command2.Enabled = True
mnusauve.Enabled = True
Case 1
'Affichage de fichiers Bitmaps
File1.Pattern = "*.bmp"
'Verrouiller la conversion puisque déja en *.bmp
Command2.Enabled = False
mnusauve.Enabled = False
Case 2
'Affichage des fichiers jpeg
File1.Pattern = "*.jpg"
'Verrouiller la conversion
Command2.Enabled = False
mnusauve.Enabled = False
Case 3
'Affichage des fichiers Gif
File1.Pattern = "*.Gif"
'Verrouiller la conversion
Command2.Enabled = False
mnusauve.Enabled = False
End Select
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
'N'accepter que des chiffres entre 0 et 9
Permis$ = "0123456789"
'Toujours autoriser RETOUR ARR.
Permis$ = Permis$ + Chr$(8)
If InStr(Permis$, Chr$(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub File1_PathChange()
' Affiche le chemin d'accès dans le contrôle Label.
Label5.Caption = Dir1.Path
End Sub
-------------------------------------------
Option Explicit
Private Sub Form_Load()
Dim Fichier As String
Fichier = Form1.File1.Path
If Right(Fichier, 1) <> "" Then Fichier = Fichier & ""
Fichier = Fichier & Form1.File1.filename
ImageDia.Picture = LoadPicture(Fichier)
ImageDia.Top = (Screen.Height - ImageDia.Height) / 2
ImageDia.Left = (Screen.Width - ImageDia.Width) / 2
End Sub
Private Sub ImageDia_DblClick()
Unload Me
End Sub
Private Sub ImageDia_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Fichier As String
Fichier = Form1.File1.Path
If Right(Fichier, 1) <> "" Then Fichier = Fichier & ""
Select Case Button
Case 1
Form1.File1.ListIndex = Form1.File1.ListIndex - 1
Case 2
Form1.File1.ListIndex = Form1.File1.ListIndex + 1
End Select
Fichier = Fichier & Form1.File1.filename
ImageDia.Picture = LoadPicture(Fichier)
ImageDia.Top = (Screen.Height - ImageDia.Height) / 2
ImageDia.Left = (Screen.Width - ImageDia.Width) / 2
End Sub
Private Sub Timer1_Timer()
Dim Fichier As String
Fichier = Form1.File1.Path
If Right(Fichier, 1) <> "" Then Fichier = Fichier & ""
If Form1.File1.ListIndex = Form1.File1.ListCount - 1 Then
Unload Me
Exit Sub
End If
Form1.File1.ListIndex = Form1.File1.ListIndex + 1
Fichier = Fichier & Form1.File1.filename
ImageDia.Picture = LoadPicture(Fichier)
ImageDia.Top = (Screen.Height - ImageDia.Height) / 2
ImageDia.Left = (Screen.Width - ImageDia.Width) / 2
'Lecture du nom de fichier
Label2 = "" & Form1.File1.filename
End Sub
--------------------------------------------
Private Sub Ferme()
Unload frmDeroule
End Sub
Private Sub Form_Click()
Ferme
End Sub
Private Sub Form_Load()
lblNomLicence = NomUtilisateur
End Sub
'
Private Sub imgImage_Click()
Ferme
End Sub
'
Private Sub lblLicence_Click()
Ferme
End Sub
'
Private Sub lblNom_Click()
Ferme
End Sub
Private Sub lblNomLicence_Click()
Ferme
End Sub
'
Private Sub lblTitre_Click()
Ferme
End Sub
'
Private Sub lblVersion_Click()
Ferme
End Sub
'
Private Sub picTexte_Click()
Ferme
End Sub
'
Private Sub tmrTexte_Timer()
If picTexte.Top > -5775 Then
picTexte.Top = picTexte.Top - 30 ' vitesse de déroulement -100 + rapide; -30 + lent
Else
picTexte.Top = 0 ' on recommence
End If
End Sub
'
Private Sub tmrDepart_Timer()
tmrTexte.Enabled = True ' départ du timer qui déclenchera le timer Texte
End Sub
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.