Je vais finir sans doute à bientot lacher DB pour complétement adopter PB si ca continue comme ça !!!
Cette fois-ci je me suis amusé à créer un programme pour tous les gens qui ont un appareil photos numérique comme moi et qui ont donc des photos non compressées (pour cela il fallait les ouvrir une par une avec paint, puis faire 'Enregistrer' et magie ... la taille de la photo était diminuée par 2
).Donc j'ai fais un petit programme qui avait cet optique principal.
J'y ait également ajoutée la prise en charge de plusieurs supports graphiques, ainsi que des options supplémenatires.
Voial donc mon code :
Code : Tout sélectionner
; ####################################################################################
; # Programme permettant de compresser les images d'un dossier selon le format et #
; # le taux de compression sélectionné par l'utilisateur. #
; # #
; # @ auteur : Lionel #
; # @ date : vendredi 12 Novenbre 2004 #
; ####################################################################################
; chargement des décodeurs et encodeurs
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Dim Extension.s(100)
Dim fichiers.s(3000)
Global nbExtension.l
Global Dossier.s
Global Formats.s
Global Compression.l
Global Prefixe.s
Declare FileListing()
Declare SortFiles()
Declare CompresseLesImages()
Declare CompresseImage(img.s)
Declare.s GetKeyValue(topKey, sKeyName.s, sValueName.s)
#PROJECT_NAME$ = "Images Compressor"
; ###################################################################################
;- ___ Fenetre principale ___
; ###################################################################################
If OpenWindow(0, 100, 200, 340, 260, #PB_Window_SystemMenu, #PROJECT_NAME$ + " - Compression des images")
; creation de la liste d'objets
If CreateGadgetList(WindowID())
TextGadget (0, 10, 10, 150, 15, "Répertoire des images :")
StringGadget (1, 10, 30, 230, 24, GetKeyValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\", "My Pictures"))
ButtonGadget (2, 260, 30, 60 , 24, "Parcourir")
TextGadget(3, 10, 70, 150, 15, "Qualité des images :")
TextGadget(4, 15, 90, 100, 15, "Format :")
; Formats de compression
ComboBoxGadget(5, 75, 87, 60, 80)
AddGadgetItem(5, -1, "JPEG")
AddGadgetItem(5, -1, "PNG")
AddGadgetItem(5, -1, "BMP")
TextGadget(6, 190, 90, 130, 15, "Compression :")
; Taux de compression
ComboBoxGadget(7, 260, 87, 60, 160)
For i.l = 0 To 10
AddGadgetItem(7, -1, Str(i))
Next i
TextGadget(8, 10, 130, 250, 15, "Réglages (si même nom de fichier)")
OptionGadget( 9, 15, 150, 110, 20, "Ecraser l'original")
OptionGadget(10, 15, 170, 110, 20, "Rajouter le préfixe :")
StringGadget(11,150, 170, 30, 23, " _")
ButtonGadget (12, 90, 230, 70 , 24, "Lister")
ButtonGadget (13, 170, 230, 70 , 24, "Quitter")
EndIf
SetGadgetState(5, 0) ; on sélectionne par défaut JPEG
SetGadgetState(7, 5) ; on sélectionne par défaut la qualité 5
SetGadgetState(9, 1) ; on sélectionne l'écrasement des fichiers par défaut
DisableGadget(11, 1) ; on désactive le préfixe
DisableGadget(12, 1) ; on désactive le boutton 'Lister'
; chargement des formats supportés
Restore FormatsGraphiques
nbExtension = 0
Read a.s
While a <> "-1"
nbExtension = nbExtension + 1
Extension(nbExtension) = a
Read a
Wend
; début de la boucle
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_EventGadget ; on a fait une action sur un des gadgets
Select EventGadgetID()
Case 2 ; appel du PathRequester()
a.s = PathRequester("Sélectionne du dossier","")
If a <> "": SetGadgetText(1,a): EndIf
Case 5 ; Liste des formats
If GetGadgetText(5) = "JPEG"
DisableGadget(7, 0)
Else
DisableGadget(7, 1)
EndIf
Case 9 ; on écrase le fichier
DisableGadget(11, 1)
Case 10 ; on rajoute un préfixe
DisableGadget(11, 0)
Case 13 ; on quitte le programme
End
Case 12 ; listage des fichiers images
FileListing()
EndSelect
; réactualisation du boutton 'lister'
If FileSize(GetGadgetText(1)) = -2 And (GetGadgetState(9) = 1 Or ( GetGadgetState(10)=1 And Trim(GetGadgetText(11))<>""))
DisableGadget(12, 0)
Else
DisableGadget(12, 1)
EndIf
EndIf
Until EventID = #PB_EventCloseWindow Or EventGadgetID() = 12
EndIf
End
; ###################################################################################
;- ___ Fenetre secondaire ___ Procedure de listage des fichiers graphiques ______
; ###################################################################################
Procedure FileListing()
; récupération des valeurs
Dossier = Trim(GetGadgetText(1))
If Right(Dossier,1) <> "\": Dossier = Dossier + "\": EndIf
Formats = GetGadgetText(5)
Compression = Val(GetGadgetText(7))
If GetGadgetState(10): Prefixe = Trim(GetGadgetText(11)): Else: Prefixe = "": EndIf
; on ferme l'ancienne fenêtre
CloseWindow(0)
nbFileInFolder.l = 0
; on liste tous les fichiers graphiques trouvés
If ExamineDirectory(0, Dossier, "*.*")
Repeat
fileType.l = NextDirectoryEntry() ; recupération du type du fichier
; analyse sur les fichiers
If fileType = 1
file.s = DirectoryEntryName()
ok.b = 0
For i.b = 1 To nbExtension
If Extension(i) = LCase(GetExtensionPart(file)): ok = 1: EndIf
Next i
If ok ; le fichier est un fichier graphique
nbFileInFolder = nbFileInFolder + 1
fichiers(nbFileInFolder) = file
EndIf
EndIf
Until FileType = 0 ; tant que le dossier n'est pas vide
EndIf
If nbFileInFolder = 0
MessageRequester(#PROJECT_NAME$,"Il n'y a aucune image dans ce dossier." + Chr(13) + Chr(10) + " Le programme va donc se terminer.",#PB_MessageRequester_Ok)
End
EndIf
; appel de la fonction pour les trier
SortFiles()
; ### on construit une nouvelle fenêtre ###
If OpenWindow(1, 100, 200, 260, 320, #PB_Window_SystemMenu, #PROJECT_NAME$ + " - Liste des images")
If CreateGadgetList(WindowID())
ListIconGadget(0, 10, 10, 240, 270, "Listes des images", 236, #PB_ListIcon_CheckBoxes | #PB_ListIcon_GridLines)
ButtonGadget(1,65,290,120,24,"Lancer la compression")
EndIf
; on ajoute les fichiers à la liste (et on coche la case)
For i = 1 To nbFileInFolder
AddGadgetItem(0,-1,fichiers(i)): SetGadgetItemState(0,CountGadgetItems(0)-1,#PB_ListIcon_Checked)
Next i
; début de la boucle
Repeat
EventID = WaitWindowEvent()
; lancement de l'encodage
If EventGadgetID() = 1
CompresseLesImages()
End
EndIf
Until EventID = #PB_EventCloseWindow
EndIf
End
EndProcedure
; ###################################################################################
;- ___ Procedure de tri alphabetique des fichiers ____________
; ###################################################################################
Procedure SortFiles()
EndProcedure
; ###################################################################################
;- ___ Procedure Lancement de la compression des images _________
; ###################################################################################
Procedure CompresseLesImages()
For i = 0 To CountGadgetItems(0)-1
If GetGadgetItemState(0,i) = #PB_ListIcon_Checked
;MessageRequester("",fichiers(i+1),#PB_MessageRequester_Ok)
CompresseImage(fichiers(i+1))
EndIf
Next i
RunProgram(Dossier)
EndProcedure
; ###################################################################################
;- ___ Procedure qui compresse une seule image ________
; ###################################################################################
Procedure CompresseImage(img.s)
;Dossier.s
;Formats.s
;Compression.l
;Prefixe
If LoadImage(1,Dossier+img)
out.s = Dossier+Prefixe+Left(img,Len(img)-Len(GetExtensionPart(img)) ) + Formats
If FileSize(out)>=0
If DeleteFile(NomFichier$) = 0
MessageRequester(#PROJECT_NAME$,"Impossible de supprimer le fichier :" + Chr(13) + Chr(10) + out, #PB_MessageRequester_Ok)
FreeImage(1): ProcedureReturn
EndIf
EndIf
; enregistrement de l'image
r.l = 0
Select Formats
Case "BMP": r = SaveImage(1,out, #PB_ImagePlugin_BMP):
Case "PNG": r = SaveImage(1,out, #PB_ImagePlugin_PNG):
Case "JPEG": r = SaveImage(1,out, #PB_ImagePlugin_JPEG, Compression):
EndSelect
If r = 0
; problème lors de l'enregistrement de l'image
MessageRequester(#PROJECT_NAME$,"Impossible d'enregistrer l'image :" + Chr(13) + Chr(10) + out, #PB_MessageRequester_Ok)
Else
; l'opération s'est bien déroulée
;MessageRequester("","Enregistrement réussit de :" + Chr(13) + Chr(10) + out, #PB_MessageRequester_Ok)
EndIf
FreeImage(1)
Else
MessageRequester(#PROJECT_NAME$,"Le chargement de l'image " + img + " a échoué", #PB_MessageRequester_Ok)
EndIf
EndProcedure
; ###################################################################################
;- ___ Procedure qui compresse une seule image ________
; ###################################################################################
Procedure.s GetKeyValue(topKey, sKeyName.s, sValueName.s)
hKey.l
lpData.s
lpcbData.l
lType.l
lReturnCode.l
GetValue.s
If Left(sKeyName, 1) = "\": sKeyName = Right(sKeyName, Len(sKeyName) - 1): EndIf
GetHandle.l = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
If GetHandle = #ERROR_SUCCESS
lpcbData = 255 : lpData = Space(255)
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = #ERROR_SUCCESS
Select lType
Case #REG_SZ
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = 0
GetValue = Left(lpData, lpcbData - 1)
Else
GetValue = ""
EndIf
Case #REG_DWORD
GetValue = ""
EndSelect
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn GetValue
EndProcedure
; ###################################################################################
;- ___ Zone de donnees pour les formats graphiques pris en cpte ________
; ###################################################################################
DataSection
FormatsGraphiques:
Data.s "bmp", "jpeg", "jpg", "png", "tiff", "tga", "-1"
EndDataSection
Sous Xp ca marche, si d'autres personnes peuvent tester et me dire si ça marche sous toutes les plateformes ca serait cool !
Merci @ ++
