Avec les fonctions PB des images, c'est assez limité mais personnellement j'utilise la dll Freeimage (wrapper de Progi1984) et c'est tellement mieux...
Il serait possible de créer un librairie de Freeimage car les source C sont dispo mais je n'y connais strictement rien...
Le code est extrait de mon projet, donc une procedure est écrite avec un peu d'assembleur pour correspondre à mes besoins.
Après réduction de l'image png, la transparence n'est pas conservé avec PB (mais avec Freeimage et un peu d'imagination on y arrive).
Chez moi les tiff ne s'affichent pas (mais c'est parfait avec Freeimage qui est capable d'ouvrir de très grandes images).
Code : Tout sélectionner
EnableExplicit
EnableASM
;- Declarations
Declare Free_ScrollArea_From_Images()
;-Constantes Fenêtres
Enumeration
#MainWindow
EndEnumeration
;-Constantes Gadgets
Enumeration 0
#Texte_ScrollAreaGadget_Icone
#HmainCombo
#ScrollAreaGadget_Icone ; scrollarea fenêtre principale
#ScrollAreaGadget_OpenFileRequesterIcone ; scrollarea fenêtre d'ouverture fichier ico etc
#ContainerGadget_OpenFileRequesterIcone ; ListViewGadget d'ouverture fichier png, jpg etc
#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone
EndEnumeration
Enumeration 0;
; Read-Write
#FileFormat_Unknown
#ICO
#CUR
#ANI
#ICL
#DLL
#BMP
#PNG
#JPG
#TIF
; Read-Only
#EXE
#OCX
#CPL
#SRC
EndEnumeration
#Option_Fenetre = #PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget
#CRLF = Chr(13) + Chr(10)
#CRLF_2 = #CRLF + #CRLF
#Format_16 = 16
#Format_32 = 32
#Format_48 = 48
#Format_96 = 96
#Format_128 = 128
#Offset_X_Icone_Apercu = 3
#Offset_Y_Icone_Apercu = 3
#Intervale_X_Icone_Apercu = 3
#Intervale_Y_Icone_Apercu = 3
#Taille_Icone_Apercu = #Format_48
#largeurScrollAreaOpenfile = ((#Taille_Icone_Apercu + #Intervale_X_Icone_Apercu)*5) + (#Offset_X_Icone_Apercu*2) + 25
; valeur retournée en cas d'erreur
#Return_Error = 0
; couleur fond scrollarea de Getopenfilename
#CoulerFondScrollarea_Getopenfilename = #White
; constante des messages de la boîte de dialogue
; #CDN_FIRST = -601
#CDN_FOLDERCHANGE = (#CDN_FIRST-2)
#CDN_HELP = #CDN_FIRST-4
#CDN_INITDONE = #CDN_FIRST
#CDN_FILEOK = #CDN_FIRST-5
#CDN_SELCHANGE = #CDN_FIRST-1
#CDN_SHAREVIOLATION = #CDN_FIRST-3
#CDN_TYPECHANGE = #CDN_FIRST-6
#OFN_FORCESHOWHIDDEN = $10000000
#OFN_ENABLESIZING = $800000
#Maxi_File_Buffer_31_Ko = 31*1024 ; taille du buffer de texte de la boîte de dialogue
; les deux constantes suivantes pour l'extension des fichiers lnk
#Link_extensionFile = ".lnk"
#Link_extensionFile_Length = 4
#HeapCompatibilityInformation = 0
Structure AfficheMiniature
Reduction.l ; True l'image est réduite sinon false
X_Position.l ; position X sur le gadget d'affichage
Y_Position.l ; position Y sur le gadget d'affichage
Width.l ; Largeur d'origine de l'image
Height.l ; hauteur d'origine de l'image
EndStructure
Structure AfficheImg
; mémorise l'id statique de l'image gadget pour l'icone
StaticImageGadgetId.l
; mémorise l'id statique de l'image créée
StaticImageId.l
EndStructure
CompilerIf Defined(Chaine, #PB_Structure) = #False
Structure Chaine
pt.c[260]
EndStructure
CompilerEndIf
CompilerIf Defined(EnumChidlDatas, #PB_Structure) = #False
Structure EnumChidlDatas
rc.RECT
Dialog.l
EndStructure
CompilerEndIf
CompilerIf Defined(AffichageMiniature, #PB_Structure) = #False
Structure AffichageMiniature
Reduction.l ; rue l'image est réduite sinon false
X_Position.l ; position X sur le gadget d'affichage
Y_Position.l ; position Y sur le gadget d'affichage
Width.l ; Largeur d'origine de l'image
Height.l ; hauteur d'origine de l'image
EndStructure
CompilerEndIf
CompilerIf Defined(OFNOTIFY, #PB_Structure) = #False
Structure OFNOTIFY
hdr.NMHDR
*lpOFN.OPENFILENAME
pszFile.l
EndStructure
CompilerEndIf
CompilerIf Defined(OPENFILENAMEXP, #PB_Structure) = #False
Structure OPENFILENAMEXP Extends OPENFILENAME
pvReserved.l
dwReserved.l
FlagsEx.l
EndStructure
CompilerEndIf
Global hMainWindow ; Handle de la fenêtre principale
Global Largeur_Ecran ; mémorise la largeur de l'écran
Global Hauteur_Ecran ; mémorise la hauteur de l'écran
Global Ecran.RECT ; pour retrouver la taille de l'écran
Global Old_Dialogue_Proc ; mémorise la procédure d'origine de la fenetre parent du dialog
Global hListIcon_Apercu.l ; mémorise le handle de la listicon des aperçus
Global Font_Textegadget_Nb_Format_Icones
Global BrushBkgWindow ; mémorise la solidbrush couleur fond fenêtre
Global Old_ScrollGadget_Proc.l ; mémorise l'adresse de la callback Windows du scrollAreaGadget
Global _WIN32_WINNT.w ; version de window par l'API
Global _WIN32_IE.w ; version d'Internet explorer
Global Nb_Button_ToolBarGetOpenFileName.b; mémorise le nombre de boutons de la Toolbar Getopenfilerequester
Global Quitter_Application.b ; = #true on ferme l'application
Global FileNumber.l ; retourne le nombre de fichiers sélectionés après la fermeture d dialogue
Global HeapFragValue.l
Global NewList Infos.AfficheImg() ; utilisé pour mémoriser les images
; Macro
Macro FreeGadgetEx(StaticGadget3)
If IsGadget(StaticGadget3)
FreeGadget(StaticGadget3)
EndIf
EndMacro
Macro FreeFontEX(StaticFont)
If IsFont(StaticFont)
FreeFont(StaticFont)
EndIf
EndMacro
Macro SetGadgetColorEX(StaticGadget12, type, color)
If IsGadget(StaticGadget12)
SetGadgetColor(StaticGadget12, type, color)
EndIf
EndMacro
Macro ShowScrollBarEx(StaticGadget88, Mode, affichage)
If IsGadget(StaticGadget88)
ShowScrollBar_(GadgetID(StaticGadget88), Mode, affichage)
EndIf
EndMacro
Macro SetGadgetFontEx(StaticGadget11, StaticFontId)
If IsFont(StaticFontId) And IsGadget(StaticGadget11)
SetGadgetFont(StaticGadget11, FontID(StaticFontId))
EndIf
EndMacro
Macro ResizeGadgetEx(Gadget, x, y, Largeur, Hauteur)
If IsGadget(Gadget)
ResizeGadget(Gadget, x, y, Largeur, Hauteur)
EndIf
EndMacro
Macro SetGadgetTextEx(StaticGadget4, ch)
If IsGadget(StaticGadget4)
SetGadgetText(StaticGadget4, ch)
EndIf
EndMacro
Macro FreeImageEx(StaticImage3)
If IsImage(StaticImage3)
FreeImage(StaticImage3)
EndIf
EndMacro
Macro InvalidateRectEX(Staticgadget, lpRect, bErase)
If IsGadget(Staticgadget)
InvalidateRect_(GadgetID(Staticgadget), lpRect, bErase)
UpdateWindow_(GadgetID(Staticgadget))
EndIf
EndMacro
; - Procedures
Procedure _UPeekB(valeur.l)
; identique à PeekB() sauf que la valeur retournée est un long non signé (pas d'extension de signe)
MOV edx, valeur
MOVZX eax, byte[edx]
ProcedureReturn
EndProcedure
Procedure.s IE_Version()
; retourne une chaine donnant la version de IE au format défini ici http://support.microsoft.com/kb/164539
Protected Hkey.l, Version$ = ""
Protected lpType.l, lpcbData.l, resultat.l
If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer\", 0, #KEY_QUERY_VALUE, @Hkey)<>#ERROR_SUCCESS
ProcedureReturn ""
EndIf
;1er appel pour déterminer la taille du buffer
resultat = RegQueryValueEx_(Hkey, "Version", 0, @lpType, @Version$, @lpcbData)
If resultat<>#ERROR_MORE_DATA
RegCloseKey_(Hkey)
ProcedureReturn ""
EndIf
Version$ = Space(lpcbData + 2) ; alloue 2 caractères 0 de fin de chaine
; lpcbData contient la taille du buffer à allouer pour la fonction
; 2ème appel de la fonction
resultat = RegQueryValueEx_(Hkey, "Version", 0, @lpType, @Version$, @lpcbData)
RegCloseKey_(Hkey)
If resultat<>#ERROR_SUCCESS
ProcedureReturn ""
EndIf
ProcedureReturn Version$
EndProcedure
Procedure Init_Main()
Protected lib.l, *HeapSetInformation
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @Ecran.RECT, 0)
Largeur_Ecran = Ecran\right-Ecran\Left
Hauteur_Ecran = Ecran\bottom-Ecran\top-20
; WinVersion
If OSVersion()<#PB_OS_Windows_2000
MessageRequester("Error/Erreur", "Windows version is to old (Windows 2000 minimum)" + Chr(13) + Chr(13) + "La version de Windows est trop ancienne (Windows 2000 minimum)", #MB_ICONERROR)
End
EndIf
Select OSVersion()
Case #PB_OS_Windows_Vista, #PB_OS_Windows_Server_2008, #PB_OS_Windows_Future
_WIN32_WINNT = $0600
Case #PB_OS_Windows_Server_2003
_WIN32_WINNT = $0502
Case #PB_OS_Windows_XP
_WIN32_WINNT = $0501
Case #PB_OS_Windows_2000
_WIN32_WINNT = $0500
EndSelect
If _WIN32_WINNT< = $0400
MessageRequester("Error/Erreur", "Windows version is to old" + Chr(13) + Chr(13) + "La version de Windows est trop ancienne", 16)
End
EndIf
_WIN32_IE = Val(StringField(IE_Version(), 1, "."))
BrushBkgWindow = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; tente d'utiliser la défragmentation de la mémoire (Low-fragmentation Heap)
lib = OpenLibrary(#PB_Any, "Kernel32.dll")
If lib
*HeapSetInformation = GetFunction(lib, "HeapSetInformation")
HeapFragValue = 2
If CallFunctionFast(*HeapSetInformation, GetProcessHeap_(), #HeapCompatibilityInformation, @HeapFragValue, SizeOf(HeapFragValue))
Debug("Success!\n")
Else
Debug "Failure " + Str(GetLastError_())
EndIf
CloseLibrary(lib)
EndIf
EndProcedure
Procedure UnInit_Main()
; destruction de la brush
If BrushBkgWindow
DeleteObject_(BrushBkgWindow)
EndIf
EndProcedure
Procedure ScrollAreaGadget_CallBack(Window, Message, wParam, lParam)
Protected Resultat.l = CallWindowProc_(Old_ScrollGadget_Proc, Window, Message, wParam, lParam)
Select Message
Case #WM_PARENTNOTIFY
Select wParam & $FFFF
Case #WM_LBUTTONDOWN, #WM_RBUTTONDOWN, #WM_MBUTTONDOWN
SetFocus_(Window)
Resultat = 0
EndSelect
Case #WM_LBUTTONDOWN, #WM_RBUTTONDOWN, #WM_MBUTTONDOWN
SetFocus_(Window)
Resultat = 0
EndSelect
ProcedureReturn Resultat
EndProcedure
Procedure DialogueCallBack(Window, Message, wParam, lParam)
Protected ReturnValue = CallWindowProc_(Old_Dialogue_Proc, Window, Message, wParam, lParam)
Select Message
Case #WM_DESTROY
FreegadgetEX(#ScrollAreaGadget_OpenFileRequesterIcone)
FreegadgetEX(#ContainerGadget_OpenFileRequesterIcone)
FreegadgetEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone)
FreeFontEX(Font_Textegadget_Nb_Format_Icones)
Font_Textegadget_Nb_Format_Icones = 0
Free_ScrollArea_From_Images()
ReturnValue = 0
Case #WM_CTLCOLORSTATIC
If IsGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone) And lParam = GadgetID(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone)
; on colorise le texte en blue
If BrushBkgWindow
SetBkMode_(wParam, #TRANSPARENT)
SetTextColor_(wParam, #Blue)
ReturnValue = BrushBkgWindow
EndIf
EndIf
EndSelect
ProcedureReturn ReturnValue
EndProcedure
Procedure.l enumChildren(hwnd.l, *Var.EnumChidlDatas)
Protected parentText.Chaine
Protected childText.Chaine
Protected classText.Chaine
Protected rc1.RECT
If hwnd = 0
ProcedureReturn #Return_Error
EndIf
If GetDlgCtrlID_(hwnd) = 0
ProcedureReturn #Return_Error
EndIf
If GetClassName_(hwnd, @classText, 256) = 0
ProcedureReturn #Return_Error
EndIf
SendMessage_(hwnd, #WM_GETTEXT, 256, @childText)
If PeekS(classText) = "SysListView32"
hListIcon_Apercu = hwnd
EndIf
If PeekS(classText) = "ToolbarWindow32"
If GetWindowRect_(hwnd, @rc1) = 0
ProcedureReturn #Return_Error
EndIf
If ScreenToClient_(GetParent_(hwnd), @rc1) = 0
ProcedureReturn #Return_Error
EndIf
If ScreenToClient_(GetParent_(hwnd), @rc1 + 8) = 0
ProcedureReturn #Return_Error
EndIf
; on compare avec les tailles de contenue par *rc.rect, si supérieur *rc.rect prend les valeurs
; on ne compare que la position en x car la Toolbar voulue est la plus proche du bord gauche
If rc1\left<*Var\rc\left
CopyMemory(@rc1, *Var\rc, SizeOf(RECT))
*Var\Dialog = hwnd ; handle de la toolbar
EndIf
EndIf
ProcedureReturn #True
EndProcedure
Procedure LoadImageEx(chaine$, *rc.AffichageMiniature)
; mémorise l'identifiant statique de l'image crée
Protected Img
; Mémorise la largeur du ScrollAreaGadget
Protected WidthGadgetMax.l
; Mémorise la hauteur du ScrollAreaGadget
Protected HeightGadgetMax.l
; mémorise le ratio image origine
Protected ratio_origine.f
; mémorise le ratio du gadget d(affichage
Protected ratio_gadget.f
; mémorise le ratio de l'image affichée
Protected ratio_dest.f
; mémorise un ratio temporaire
Protected ratio_Temp.f
; mémorise la largeur de l'image redimensionnée
Protected NewWidth
; mémorise la largeur de l'image redimensionnée
Protected Newheight
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
Img = LoadImage(#PB_Any, chaine$)
If Img
WidthGadgetMax = #largeurScrollAreaOpenfile-25-(#Offset_X_Icone_Apercu*2)
HeightGadgetMax = GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone)-(#Offset_Y_Icone_Apercu*2)-25
; récupération des tailles de l'image d'origine
*Rc\Width = ImageWidth(Img)
*Rc\Height = ImageHeight(Img)
; calcul du ratio image d'origine largeur/hauteur
ratio_origine = *Rc\Width/*Rc\Height
; calcul du ratio gadget d'affichage largeur/hauteur
ratio_gadget = WidthGadgetMax/HeightGadgetMax
; on redimensionne si un des côtés au moins est > au côté correspondant du gadget
If (HeightGadgetMax> = *Rc\Height) And (WidthGadgetMax> = *Rc\Width)
; on ne redimensionne pas
NewWidth = *Rc\Width
Newheight = *Rc\Height
*Rc\Reduction = #False
Else ; (HeightGadgetMax < *Rc\Height) And (WidthGadgetMax < *Rc\Width)
ratio_Temp = WidthGadgetMax/*Rc\Width
ratio_dest = HeightGadgetMax/*Rc\Height
; on utilise le ratio le plus petit pour réduire l'image d'origine
If ratio_Temp<ratio_dest
ratio_dest = ratio_Temp
EndIf
*Rc\Reduction = #True
; on redimensionne
NewWidth = Round((*Rc\Width*ratio_dest), 0)
Newheight = Round((*Rc\Height*ratio_dest), 0)
ResizeImage(img, NewWidth, Newheight)
EndIf
; fixe la valeur des éléments *Rc\X_Position et *Rc\Y_Position
*Rc\X_Position = (#largeurScrollAreaOpenfile-NewWidth)/2
If (#largeurScrollAreaOpenfile-NewWidth) & 1 ; impaire
*Rc\X_Position-1
EndIf
*Rc\Y_Position = (HeightGadgetMax + 25 + (#Offset_Y_Icone_Apercu*2)-Newheight)/2
If (HeightGadgetMax + 25 + (#Offset_Y_Icone_Apercu*2)-Newheight) & 1 ; impaire
*Rc\Y_Position-1
EndIf
ProcedureReturn img
Else
ProcedureReturn #Return_Error
EndIf
EndProcedure
Procedure Free_ScrollArea_From_Images()
; la procedure retire tous les gadgets du scrollarea du Dialogue GetOpenFileName_()
If ListSize(Infos())
; on efface les éléments correspondants
ForEach Infos()
FreeImageEx(Infos()\StaticImageId) ; image
If IsGadget(Infos()\StaticImageGadgetId)
SetGadgetState(Infos()\StaticImageGadgetId, 0)
FreeGadget(Infos()\StaticImageGadgetId) ; gadget utilisé pour afficher l'image
EndIf
Next
ClearList(Infos())
EndIf
InvalidateRectEX(#ScrollAreaGadget_OpenFileRequesterIcone, #Null, #True)
EndProcedure
Procedure Affiche_Image(chaine$)
; mémorise le texte d'énumération de l'icône
Protected Texte$
; mémorise le type de fichier
Protected FileType.l
; mémorise l'identifiant des images bmp etc
Protected Img.l
; mémorise la position de l'image réduite qui sera affichée (format BMP, PNG etc)
Protected Rc.AffichageMiniature
Free_ScrollArea_From_Images()
If FileSize(chaine$)>0 And IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone) And IsGadget(#ContainerGadget_OpenFileRequesterIcone)
Free_ScrollArea_From_Images()
Select LCase(Right(chaine$, 4))
Case ".bmp"
FileType = #BMP
Img = LoadImageEx(chaine$, @rc)
Case ".jpg"
FileType = #JPG
Img = LoadImageEx(chaine$, @rc)
Case ".png"
FileType = #PNG
Img = LoadImageEx(chaine$, @rc)
Case ".tif"
FileType = #TIF
Img = LoadImageEx(chaine$, @rc)
EndSelect
Select FileType
;-#BMP, #JPG
Case #BMP, #JPG, #PNG
; on masque le scrollaragadget
HideGadget(#ScrollAreaGadget_OpenFileRequesterIcone, 1)
; on affiche la listviewgadget
HideGadget(#ContainerGadget_OpenFileRequesterIcone, 0)
If Img<>#Return_Error
If AddElement(Infos())
Infos()\StaticImageId = Img
Infos()\StaticImageGadgetId = ImageGadget(#PB_Any, Rc\X_Position, Rc\Y_Position, 0, 0, ImageID(Img))
If Infos()\StaticImageGadgetId
If Rc\reduction
Texte$ = "Image réduite - "
Else
Texte$ = "Image non réduite - "
EndIf
Texte$ + Str(rc\Width) + " x " + Str(rc\height) + " pixels"
SetGadgetTextEx(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Texte$)
EndIf
EndIf
EndIf
EndSelect
EndIf
EndProcedure
Procedure.l OFHookProc(hdlg, Message, wParam, *lParam.OFNOTIFY)
; ; mémorise l'identifiant système du dialogue
Protected hDialog.l
; résultat de la fonction
Protected Resultat = #False
; retrouve les coordonnées du bureau et de la boite de dialogue
Protected wr.RECT, wr1.RECT, rcc.RECT
; mémorise le handle du parent de la boite de dialogue
Protected Parent_hdlg.l
; mémorise l'adresse du buffer mémoire de 31 Ko
Protected *FileBuffer.long
; mémorise le chemin du fichier
Protected Path$
; mémorise la longuer du chemin
Protected Path_Lenght.l
; mémorise les coordonnées de la Toolbar de gauche qui ne s'affiche pas bien avec les thèmes XP
Protected rc.RECT
; mémorise les coordonnées de la zone client de la boite de dialogue
Protected clientRect.rect
; mémorise les coordonnées de la boite de dialogue
Protected windowrect.rect
; mémorise les coordonnées de de la boite de dialogue lors de l'énumération et son handle
Protected ToolBarGauche.EnumChidlDatas
; mémorise les coordonnées du bouton Annuler
Protected Cancel.RECT
; mémorise la hauteur calculée de la toobar pour redimensionnement eventuel
Protected HauteurToolBar.l
; mémorise les écarts entre la zone client de la boite dialogue et ses coordonnée entières de la fenêtre
; est utilisé pour déterminer s'il faut ou non redimensionner, cette variable est aussi utilisée pour
; calculer l'offset à appliquer aux bouton Annuler et Ok
Protected ecartWindow.l
; mémorise le texte de plusieurs fichiers sélectionnés
Protected Texte$
; mémorise l'identifiant de la zone propre du scrollareagadget
Protected hWnd_ScrollArea
; mémorise si la fenêtre Getopenfilename a déjà été modifiée
Protected GetOpenfilename_modifer
Select Message
Case #WM_INITDIALOG
Parent_hdlg.l = GetParent_(hdlg)
If Parent_hdlg = 0
Resultat = #True
Else
Old_Dialogue_Proc = SetWindowLong_(Parent_hdlg, #GWL_WNDPROC, @DialogueCallBack())
EndIf
If GetWindowRect_(Parent_hdlg, wr.RECT) And GetWindowRect_(GetDesktopWindow_(), wr1.RECT)
If ((wr1\right/2)-((wr\right + #largeurScrollAreaOpenfile + 10)/2)>20) And (((wr1\bottom/2)-((wr\bottom)/2))>20)
MoveWindow_(Parent_hdlg, (wr1\right/2)-((wr\right + #largeurScrollAreaOpenfile + 10)/2), ((wr1\bottom/2)-((wr\bottom)/2)), wr\right + #largeurScrollAreaOpenfile + 30, wr\bottom-wr\top, #True)
EndIf
EndIf
If UseGadgetList(Parent_hdlg)
hDialog = GetDlgItem_(Parent_hdlg, #lst1)
If hDialog
If GetWindowRect_(hDialog, wr.RECT) And ScreenToClient_(hdlg, wr.RECT) And ScreenToClient_(hdlg, @wr\right)
wr1\left = -10
GetWindowRect_(GetDlgItem_(Parent_hdlg, #IDCANCEL), wr1.RECT)
ScreenToClient_(hdlg, wr1.RECT)
ScreenToClient_(hdlg, @wr1\right)
; création du scrollAreaGadget perso
If ScrollAreaGadget(#ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 20, wr\top + 22, #largeurScrollAreaOpenfile, wr1\bottom-wr\top-20, #largeurScrollAreaOpenfile-25, wr1\bottom-wr\top-40, 55, #PB_ScrollArea_Flat)
hWnd_ScrollArea = FindWindowEx_(GadgetID(#ScrollAreaGadget_OpenFileRequesterIcone), 0, "PureScrollAreaChild", 0)
If hWnd_ScrollArea
Old_ScrollGadget_Proc = SetWindowLong_(hWnd_ScrollArea, #GWL_WNDPROC, @ScrollAreaGadget_CallBack())
EndIf
SetGadgetColorEX(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_Gadget_BackColor, #CoulerFondScrollarea_Getopenfilename)
SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerWidth, #largeurScrollAreaOpenfile-25)
ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_VERT, #True)
CloseGadgetList()
TextGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 40, GadgetY(#ScrollAreaGadget_OpenFileRequesterIcone)-25, #largeurScrollAreaOpenfile-20, 20, "", #PB_Text_Center)
SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
EndIf
; création de la ListGadget perso
If ContainerGadget(#ContainerGadget_OpenFileRequesterIcone, wr\right + 20, wr\top + 22, #largeurScrollAreaOpenfile, wr1\bottom-wr\top-20, #PB_Container_Flat)
SetGadgetColor(#ContainerGadget_OpenFileRequesterIcone, #PB_Gadget_BackColor, #White)
HideGadget(#ContainerGadget_OpenFileRequesterIcone, 1)
If IsGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone) = 0
TextGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 40, GadgetY(#ContainerGadget_OpenFileRequesterIcone)-25, #largeurScrollAreaOpenfile-20, 20, "", #PB_Text_Center)
SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
EndIf
EndIf
EndIf
EndIf
EndIf
Resultat = #True
Case #WM_NOTIFY
*FileBuffer = *lParam\lpOFN\lCustData
If (_WIN32_WINNT> = $0501) And (GetOpenfilename_modifer = #False)
; on retrouve les coordonnées de la toolbar et de son handle
; on force ToolBarGauche\rc\left à une grande valeur pour que le teste dans EnumChildWindows_ soit Ok
ToolBarGauche\rc\left = 65534
EnumChildWindows_(*lParam\hdr\hwndFrom, @enumChildren(), @ToolBarGauche)
If Nb_Button_ToolBarGetOpenFileName< = 0
Nb_Button_ToolBarGetOpenFileName = SendMessage_(ToolBarGauche\dialog, #TB_BUTTONCOUNT, 0, 0)
If Nb_Button_ToolBarGetOpenFileName
; on réinitialise la fenêtre et le contrôle si besoin
; on retrouve la taille des boutons
; retrouve les coordonnées du dernier bouton
If SendMessage_(ToolBarGauche\dialog, #TB_GETITEMRECT, Nb_Button_ToolBarGetOpenFileName-1, @rc)
; calcul de la hauteur ToolBar
If GetWindowRect_(*lParam\hdr\hwndFrom, windowrect.RECT) And GetClientRect_(*lParam\hdr\hwndFrom, @clientRect)
HauteurToolBar = rc\bottom + (Nb_Button_ToolBarGetOpenFileName*((SendMessage_(ToolBarGauche\dialog, #TB_GETPADDING, 0, 0)>>16) & $FFFF))
; calcul de la différence entre la zone client de la fenêtre et la fenêtre
ecartWindow.l = (windowrect\bottom-windowrect\top)-(clientRect\bottom-clientRect\top)
; on vérifie avant de modifier si le point bas de la toolbar \bottom est inférieur au point bas du boutton annuler
; si c'est le cas on modifie, sinon on laisse
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), Cancel.RECT); And (_WIN32_WINNT >= $0600)
If ScreenToClient_(*lParam\hdr\hwndFrom, @Cancel\right)
; on teste si la hauteur de la toolbar des boutons à gauche dépasse le point bas du bouton "Quitter"
If HauteurToolBar>Cancel\bottom
; cette valeur sera ajoutée à la valeur de la hauteur de la toolbar pour dimensionner la boite de dialogue correctement
; on augmente la taille de la fenêtre du dialogue
MoveWindow_(*lParam\hdr\hwndFrom, windowrect\left, windowrect\top, windowrect\right-windowrect\left, HauteurToolBar + ToolBarGauche\rc\top + ecartWindow, #True)
; on rectifie la taille de la toolbar des boutons à gauche pour qu'elle ne soit pas trop grande par rapport aux nombre de boutons
HauteurToolBar-((Nb_Button_ToolBarGetOpenFileName)*((SendMessage_(ToolBarGauche\dialog, #TB_GETPADDING, 0, 0)>>16) & $FFFF)) + 2
MoveWindow_(ToolBarGauche\dialog, ToolBarGauche\rc\left, ToolBarGauche\rc\top, ToolBarGauche\rc\right-ToolBarGauche\rc\left, HauteurToolBar, #True)
; on décale les 2 boutons OK et Cancel et les 2 texte gadget qui vont avec
; on descend le bouton cancel, on retrouve les coordonnées de la fenêtre déplacée
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), wr1.RECT) And GetWindowRect_(*lParam\hdr\hwndFrom, windowrect.RECT)
ecartWindow = (windowrect\bottom-wr1\bottom)/2
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
; calcul de l'écart entre la partie basse du bouton et celle de la fenêtre, le tout divisé par 2
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
; on repositionne le scrollarea juste après le déplacement du bouton cancel car on a ses coordonnées avec wr1
ResizeGadgetEx(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone) + (ecartWindow))
ResizeGadgetEx(#ContainerGadget_OpenFileRequesterIcone, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#ContainerGadget_OpenFileRequesterIcone) + (ecartWindow-2))
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb1), wr1.RECT)
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb1), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc2), wr1.RECT)
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc2), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
ecartWindow*2/3
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDOK), wr1.RECT)
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDOK), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb13), wr1.RECT)
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb13), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
; texte "Nom du fichier"
If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc3), wr1.RECT)
If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc3), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
EndIf
EndIf
Else
; on ne modifie pas car pas besoin et la boite a été centré en WM_InitDialog
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
Select *lParam\hdr\code
Case #CDN_INITDONE
GetOpenfilename_modifer = #True
;- #CDN_FOLDERCHANGE, #CDN_TYPECHANGE
Case #CDN_FOLDERCHANGE, #CDN_TYPECHANGE
ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_HORZ, #False)
SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
SendMessage_(*lParam\hdr\hwndFrom, #CDM_SETCONTROLTEXT, #edt1, @"")
If IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone)
SetGadgetTextEx(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, "")
Free_ScrollArea_From_Images()
EndIf
;- #CDN_SELCHANGE
Case #CDN_SELCHANGE
If *lParam\hdr\code = #CDN_SELCHANGE
ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_HORZ, #False)
If IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone)
Free_ScrollArea_From_Images()
; on vide la liste de ses éléments
PokeL(*FileBuffer, 0) ; on remet la chaine à 0
; avant d'afficher, on vérifie que le fichier est bien dans la zone d'écriture des noms de fichiers
SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETSPEC, #Maxi_File_Buffer_31_Ko, *FileBuffer)
; on compte les " contenu dans la chaine
If _UPeekB(*FileBuffer) = '"'
; remet les scrollbar à 0
SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerHeight, GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone)-20)
SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerWidth, #largeurScrollAreaOpenfile-25)
Texte$ = "Plusieurs éléments sont sélectionnés"
ElseIf _UPeekB(*FileBuffer)
; on teste que c'est un fichier et pas un dossier
Path_Lenght = 1
Path$ = Space(Path_Lenght)
Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFILEPATH, Path_Lenght, @Path$)
If Path_Lenght>0
Path$ = Space(Path_Lenght-1)
If Len(Path$) = Path_Lenght-1
; Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFOLDERPATH, Path_Lenght, @Path$)
Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFILEPATH, Path_Lenght, @Path$)
; on teste si c'est un lien, fichier lnk
; si oui, on ne fait rien, sinon, c'est un fichier à afficher
If LCase(Right(PeekS(*FileBuffer), #Link_extensionFile_Length))<>#Link_extensionFile
Path$ = GetPathPart(Path$)
If Len(Path$)
If Right(Path$, 1)<>"\"
Path$ + "\"
EndIf
If FileSize(Path$ + PeekS(*FileBuffer))> = 0
; *********************************************
; c'est ici que l'on affiche l'image sélectionnée
Affiche_Image(Path$ + PeekS(*FileBuffer))
; *********************************************
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndSelect
Resultat = #True
EndSelect
ProcedureReturn Resultat
EndProcedure
Procedure.l Open_FileRequester(InitialDir$, Pattern.l, PatternPosition.l, buffer.l)
Protected Resultat.l
Protected lpofn.OPENFILENAMEXP
lpofn\lStructSize = SizeOf(OPENFILENAMEXP)
lpofn\hwndOwner = hMainWindow
lpofn\hInstance = #Null
lpofn\lpstrFilter = pattern
lpofn\lpstrCustomFilter = #Null
lpofn\nMaxCustFilter = #Null
lpofn\nFilterIndex = PatternPosition
lpofn\lpstrFile = buffer
lpofn\nMaxFile = #Maxi_File_Buffer_31_Ko
lpofn\lpstrFileTitle = #Null
lpofn\nMaxFileTitle = #Null
lpofn\lpstrInitialDir = @InitialDir$ ; Windows 2000/XP et > sinon voir la définition
lpofn\lpstrTitle = @"Ouvrir les fichiers"
lpofn\flags = #OFN_HIDEREADONLY | #OFN_EXPLORER | #OFN_ENABLEHOOK | #OFN_ALLOWMULTISELECT | #OFN_FILEMUSTEXIST | #OFN_FORCESHOWHIDDEN | #OFN_SHAREAWARE | #OFN_PATHMUSTEXIST
lpofn\nFileOffset = 0
lpofn\nFileExtension = 0
lpofn\lpstrDefExt = 0
lpofn\lCustData = buffer
lpofn\lpfnHook = @OFHookProc()
lpofn\lpTemplateName = 0
lpofn\pvReserved = 0
lpofn\FlagsEx = 0
Font_Textegadget_Nb_Format_Icones = LoadFont(#PB_Any, "TAHOMA", 9, #PB_Font_Italic | #PB_Font_HighQuality)
EnableWindow_(WindowID(#MainWindow), #False)
Nb_Button_ToolBarGetOpenFileName = #False
If GetOpenFileName_(@lpofn)
Resultat = #True
Else
Resultat = -CommDlgExtendedError_()
EndIf
EnableWindow_(WindowID(#MainWindow), #True)
ProcedureReturn Resultat
EndProcedure
Procedure.s Open_FileRequesterEx(InitialDir$, Pattern, PatternPosition, *ReturnedFilesNumber)
Protected *FileBuffer
Protected nb_files
Protected getFile$ = ""
Protected No_Error
*FileBuffer = AllocateMemory(#Maxi_File_Buffer_31_Ko) ; 31 Ko alloué pour la chaîne
If *FileBuffer = 0
ProcedureReturn getFile$
EndIf
No_Error = Open_FileRequester(InitialDir$, Pattern, PatternPosition, *FileBuffer)
If Len(PeekS(*FileBuffer))
If No_Error = #True
If FileSize(GetFilePart(PeekS(*FileBuffer)))<0
; on met une virgule à la place des 0 pour séparer les fichiers et le chemin également
; si il y a un double 0, c'est la fin de chaine, on termine sans mettre de virgule
; le nombre de fichiers est le nobre de virgule
! xor ecx, ecx ; ecx mémorise le nombre de virgules
! mov eax, [p.p_FileBuffer] ; eax = adresse zone mémoire
! boucle :
! inc eax ; eax pointe le 1er élément
! cmp word [eax], 0 ; teste si c'est un double 0, si oui on quite
! je quit
! cmp byte [eax], 0 ; il n'y a pas de double 0, on teste le 0 simple
! je virgule ; si = 0 on met une virgule
! jmp boucle
! virgule :
! mov byte [eax], ","
! inc ecx
! jmp boucle
! quit :
! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
! mov [eax], ecx ; i vaut le nombre de fichiers contenu dans la chaine
Else
; un seul fichier de sélectionné
! mov ecx, 1
EndIf
! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
! mov [eax], ecx
getFile$ = PeekS(*FileBuffer)
Else
; GetOpenFileName_ retourne nonzero si c'est OK
; sinon retourne 0 et il faut tester CommDlgExtendedError_()
; ici GetOpenFileName a retourné 0
;
; GetOpenFileName_() retourne 0
; si CommDlgExtendedError_() = 0 --> le bouton cancel a été activé, on ne fait rien
;
; on met le compteur de fichier à 0
! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
! sub ecx, ecx ; ecx vaut le nombre de fichiers contenu dans la chaine soit 0 ici
! mov [eax], ecx
; on traite les erreurs
; si CommDlgExtendedError_() = 0 --> le bouton cancel a été activé, on ne fait rien
If No_Error
MessageRequester("Error/Erreur", "An error system has occur, no file names returned" + Chr(13) + Chr(13) + "Une erreur système est arrivéee, aucun nom de fichier renvoyé")
EndIf
EndIf
EndIf
FreeMemory(*FileBuffer)
ProcedureReturn getFile$
EndProcedure
;- Code principal
hMainWindow = OpenWindow(#MainWindow, Ecran\left, Ecran\top, Largeur_Ecran, Hauteur_Ecran, "Openfilerequester et miniatures", #Option_Fenetre)
If hMainWindow = 0
MessageRequester("Erreur système", "La création de la fenêtre principale a échouée." + #CRLF + "L'application va se terminer.", 16)
End
EndIf
Init_Main()
;ShowWindow_(hMainWindow, #SW_SHOWMAXIMIZED)
Open_FileRequesterEx("C:\" + "\JPG", ?Patern_Ico, 1, @FileNumber)
; ShowWindow_(hMainWindow, #SW_SHOWMAXIMIZED)
; ;- Boucle
; Repeat
; Select WaitWindowEvent()
;
; Case #PB_Event_CloseWindow
; Quitter_Application = #True
;
; EndSelect
; Until Quitter_Application
; restauration de la mémoire etc
UnInit_Main()
DisableASM
End
DataSection
Patern_Ico : ; filtre pour les fichiers au format ico, dll, exe, icl etc
Data.s "Tous formats"
Data.s "*.ani;*.cur;*.icl;*.ico;*.dll;*.exe;*.bmp;*.jpg;*.png;*.tif;*.tiff"
Data.s "icones (*.icl;*.ico;*.dll;*.exe)"
Data.s "*.icl;*.ico;*.dll;*.exe"
Data.s "Bibliothèques d'icône (*.icl)"
Data.s "*.icl"
Data.s "Curseurs (*.ani, *.cur)"
Data.s "*.ani;*.cur"
Data.s "Images (*.bmp, *.jpg, *.png, *.tif, *.tiff)"
Data.s "*.bmp;*.jpg;*.png;*.tif;*.tiff"
; Data.s "Curseurs animés(*.ani)"
; Data.s "*.ani"
; Data.s "Curseurs simples(*.cur)"
; Data.s "*.cur"
Data.w 0 ; double 0 de fin de chaine signalant la fin des filtres de la boîte
EndDataSection
