Enregistrer un gif sans convertiseur.

Soyez le premier à donner votre avis sur cette source.

Vue 6 192 fois - Téléchargée 304 fois

Description

Ce code sert a enregistrer un Gif, Jpg, Bmp à l'endroit ou la personne le desire !
Mais il camoufle une fonction pour copier donc il copie un fichier donc ça marche car il n'est pas modifié par le programme comme les fonctions pour enregistrer les PictureBox
------>
Pour ce faire vous avez besoin:
- d'un module
- un form bien sur
- un bouton ici appellé Command1
- d'un picture box si vous voulez montrer à l'utilisateur l'image à enregistrer ici appellé Picture 1 à qui vous y mettre la propriété Picture l'image à afficher.
- d'un common dialog (Allez dans component/Microsoft Common Dialog Controls 6.0 (SP3)) ici appellé cm1

Source / Exemple :


' À ÉCRIRE DANS LE MODULE

'Declarations
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4

Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_FILESONLY = &H80
Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_NO_CONNECTED_ELEMENTS = &H1000
Public Const FOF_NOCOPYSECURITYATTRIBS = &H800
Public Const FOF_NOERRORUI = &H400
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_WANTMAPPINGHANDLE = &H20
Public Const FOF_WANTNUKEWARNING = &H2000
Public Const FOF_NORECURSION = &H1000               

Public Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
    (Dest As Any, Sourc As Any, ByVal Length As Long)

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
    (lpFileOp As Any) As Long

Public Function copier(FROM As String, copie As String)
On Error GoTo erreur
Dim fso, msg
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.FileExists(FROM) Then 'on verifie si le fichier existe
copier = "Le fichier n'existe pas"
Exit Function
erreur:
copier = "Une erreur c'est produite"
Exit Function
End If

Dim fos As SHFILEOPSTRUCT       
Dim retval As Long              
             With fos
                .hWnd = 0                       'ou Me.hWnd si on a une Feuille par exemple
                .wFunc = FO_COPY                'Action == Copie
                .pFrom = FROM & vbNullChar 'Source path
                .pTo = copie & vbNullChar   'Dest Path
                .fFlags = FOF_NOCONFIRMMKDIR Or FOF_WANTMAPPINGHANDLE 'Flags de Copie
                .fAnyOperationsAborted = 0
                .hNameMappings = 0
                .lpszProgressTitle = vbNullChar
              End With

retval = SHFileOperation(fos)
copier = "OK"
End Function

'À ÉCRIRE DANS LE FORM

Private Sub Command1_Click()
On Error GoTo bug
cd1.DialogTitle = "Enregisterer l'image sous"
cd1.Filter = "Format GIF|*.gif"
cd1.FileName = "gauche.gif"
cd1.ShowSave

If cd1.FileName <> "" Then
resultat = copier(App.Path & "\images\gauche.gif", cd1.FileName)
If resultat = "OK" Then
MsgBox "Le fichier a été enrigistrer avec succés !"
Else
bug: MsgBox "Le fichier n'a pas été enrigistrer pour cause d'erreur"
End If
End If
End Sub

Conclusion :


Comme tout code, il y a de la place à amélioration. Si vous avez des idées, commentaires, critiques ne vous gênez pas à me les faire parvenir par la section commentaires.

Merci

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
7
Date d'inscription
samedi 14 juin 2003
Statut
Membre
Dernière intervention
3 décembre 2004

Arkko tes explications n'ont aucun sens. Le code non plus d'ailleurs...
C'est dommage car la fonctione de sauvegarde du contenu d'un PictureBox vers un Gif est une super idée. Tout ce que tu as proposé c'est une imposture. La note parle d'elle-même...
Messages postés
530
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
13 juin 2004

Mémère> pour copier un fichier, tu peu aussi utiliser la fct Name oldpath as newpath. Il me semble que ca marche
Messages postés
962
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
2 août 2010
1
Pourri
Messages postés
1
Date d'inscription
jeudi 21 février 2002
Statut
Membre
Dernière intervention
21 février 2002

T'ecrits des programmes bibelot, ça serre à rien et ça occupe de la place !
Et encore, je suis vache avec les bibelots là.
Messages postés
192
Date d'inscription
mercredi 26 décembre 2001
Statut
Membre
Dernière intervention
31 janvier 2007

Ouin Y'ont pos l'air à l'aimen :-( pas grave
Afficher les 11 commentaires

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.