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

Soyez le premier à donner votre avis sur cette source.

Vue 16 511 fois - Téléchargée 698 fois

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

Ajouter un commentaire

Commentaires

Signaler
mareluc
Messages postés
17
Date d'inscription
jeudi 11 septembre 2003
Statut
Membre
Dernière intervention
10 novembre 2005
 -
Bonjour et merci d'avoir répondu
J'avais déjà essayé: ouvrie avec...
J'ai fais de nouveaux essais avec d'autres icones:
- un tiré du répertoire Windows
- un autre que j'avais déjà créé avec paint
-> Le programme fonctionne
Paint fonctionne correctement avec d'autres images en .ico et .bmp
Le problème vient donc des icones d'origine que j'avais utilisés. Cependant, ils sont manipulés correctement avec d'autres logiciels. Et, en particulier, je peux les utiliser pour personnaliser mon bureau.
Mon intention était d'utiliser un meme icone pour mes développements perso en changeant les couleurs à l'aide de paint, en passant par une image .bmp.
Du coup, je suis coincé. J'ai perdu l'icone d'origine pour lequel j'avais flashé, et j'avais réussi à le récupéré avec un extracteur d'icone à partir de celui d'un fichier .exe.
Il faut croire que ces icones ne peuvent pas etre considérés comme des 'purs' formats .ico
Je t'aurais bien envoyé un exemple mais je ne sais pas si on peut insérer une image dans ces commentaires
Marcel
Signaler
cs_patoch
Messages postés
62
Date d'inscription
jeudi 12 avril 2001
Statut
Membre
Dernière intervention
25 septembre 2007
 -
Salut Marcel
c'est normal que l'image d'une icone soit allongé car le visioneur centrale est fait pour voir des grande images.
Par contre tu as ton icone en bas a gauge.
J'ai retestai le prog il fonctionne bien,j'ai pu ouvrir une icone sauvé en bmp avec paint,tu as peut etre un bug avec paint?
Essaye clic droit 'ouvrir avec paint'
@+ si ca persiste renvoie une reponse je te repondrai .
bye
Signaler
mareluc
Messages postés
17
Date d'inscription
jeudi 11 septembre 2003
Statut
Membre
Dernière intervention
10 novembre 2005
 -
Je viens d'essayer ce code, qui semble fonctionner correctement.
Cependant, apres une conversion ico->bmp, le fichier(bmp) obtenu n'est pas ouvert par paint (format non reconnu)
J'ai fais l'essai avec 2 fichiers .ico
- l'un obtenu a l'aide d'un extracteur d'icones
l'image visionnee par le programme est allongee
- l'autre est issue d'une bibliotheque d'icone
la lecture avec le visonner d'image montre une image polluee
Dans un cas comme dans l'autre, paint ne les ouvre pas
Je n'ai pas encore étudie le fonctionnement de "LoadPicture" par exemple, mais n'y aurait'il pas des options a prendre en compte par exemple?
Merci de répondre
Marcel
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)