Visual Basic World, Visual basic 6 et .net Visual Basic 6 et .net World
Revenir à la liste des sources


puceCode source n°2 : Convertir une icône et en bitmap
Auteur : P. Cuisinaud Codes source visual studio .net codevb6.zip - Taille : 2 Ko
Public VChemin As String 'Chemin application
Public VFichier As String 'Fichier image

Private Sub Convertir_Click()
    Dim VSelec As Boolean, X As Integer, Y As Integer
    
    Screen.MousePointer = 11
    VSelec = False
    Y = 0
    Label5.Caption = 0
    Label6.Caption = 0
    'On verifie si au moins un fichier est sélectionné
    For X = 0 To File1.ListCount - 1
        If File1.Selected(X) Then
            VSelec = True
            Y = Y + 1
        End If
    Next X
    Label5.Caption = Y
    If Not VSelec Then
        Screen.MousePointer = 1
        MsgBox "Erreur : Aucun fichier séléctionné!", VbExclamation, "Conversion" & _
             " Icône en Bitmap..."
        Exit Sub
    End If
    'Convertion
    For X = 0 To File1.ListCount - 1
        If File1.Selected(X) Then
            VFichier = Dir1.Path & "\" & File1.List(X)
            Image1.Picture = LoadPicture(VFichier)
            Picture1.Picture = LoadPicture(VFichier)
            VFichier = Left(VFichier, Len(VFichier) - 3) & "bmp"
            SavePicture Picture1.Image, VFichier
            Label6.Caption = Label6.Caption + 1
        End If
    Next X
    Screen.MousePointer = 1
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dim VDrv As String
    
    VDrv = Dir1.Path
    On Error Resume Next
    Dir1.Path = Drive1.Drive
    If Err = 68 Then
        MsgBox "Erreur : " & Err.Description, 16,  & _
             "Conversion Icône en Bitmap..."
        Drive1.Drive = VDrv
    End If
End Sub

Private Sub File1_Click()
    If File1.FileName <> "" Then
        VFichier = Dir1.Path & "\" & File1.FileName
        Image1.Picture = LoadPicture(VFichier)
        Picture1.Picture = LoadPicture(VFichier)
    End If
End Sub

Private Sub Form_Load()
    VChemin = App.Path
    If Right(VChemin, 1) <> "\" Then VChemin = VChemin & "\"
    Picture1.BorderStyle = 0
    Label2.Caption = VChemin
End Sub

Private Sub Quitter_Click()
    'Quitte le programme
    End
End Sub

Remonter