Convertir *.ico --->bmp .visualiseur et texte déroulant

Télécharger le projet
Commenter

Description


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