PROCEDURE
DessineIconeFichier(
sFileName est
chaîne
,
sNomChpImage est
chaîne
=
"
"
,
.
.
.
LOCAL
hDC est
entier
système
=
0
,
nTaille est
entier
=
16
)
SI
sNomChpImage<
>
"
"
_ET_
PAS
ChampExiste
(
sNomChpImage)
ALORS
RENVOYER
Faux
FIN
bRes est
booléen
sDefaultIcon est
chaîne
=
SysRep
(
srSystème
)
+
"
\SHELL32.DLL
"
nIconIndex est
entier
sFileExt est
chaîne
sProgramName est
chaîne
nbIcons,
nIndex,
nError sont
entier
hIcon est
entier
système
sFileExt =
Minuscule
(
fExtraitChemin
(
sFileName,
fExtension
)
)
SELON
sFileExt
CAS
"
.ico
"
SI
fFichierExiste
(
sFileName)
ALORS
sDefaultIcon=
sFileName
nIconIndex =
0
GOTO
DRAW_ICON
FIN
CAS
"
.exe
"
nIconIndex =
2
SI
fFichierExiste
(
sFileName)
ALORS
sDefaultIcon=
sFileName
nIconIndex =
0
FIN
GOTO
DRAW_ICON
FIN
SI
RegistreExiste
(
"
HKEY_CLASSES_ROOT\
"
+
sFileExt)
ALORS
sProgramName =
RegistreLit
(
"
HKEY_CLASSES_ROOT\
"
+
sFileExt,
0
)
sDefaultIcon =
RegistreLit
(
"
HKEY_CLASSES_ROOT\
"
+
sProgramName +
"
\DefaultIcon
"
,
0
)
nIndex =
Position
(
sDefaultIcon,
"
,
"
,
Taille
(
sDefaultIcon)
,
DepuisFin
)
SI
nIndex ALORS
sDefaultIcon =
sDefaultIcon[[
A
nIndex-
1
]]
nIconIndex =
sDefaultIcon[[
nIndex+
1
A
]]
FIN
FIN
DRAW_ICON:
SI
nTaille=
16
ALORS
nbIcons =
API
(
"
SHELL32
"
,
"
ExtractIconExA
"
,
sDefaultIcon,
nIconIndex,
Null
,
&
hIcon,
1
)
SINON
hIcon =
API
(
"
SHELL32
"
,
"
ExtractIconA
"
,
0
,
sDefaultIcon,
nIconIndex)
FIN
SI
hIcon DANS
(
-
1
,
0
,
1
)
ALORS
RENVOYER
Faux
FIN
SI
sNomChpImage<
>
"
"
ALORS
{
sNomChpImage,
indChamp
}
.
.
Visible
=
Faux
hDC =
dDébutDessin
(
sNomChpImage)
nError =
API
(
"
USER32
"
,
"
DrawIconEx
"
,
hDC,
0
,
0
,
hIcon,
nTaille,
nTaille,
0
,
0
,
3
)
{
sNomChpImage,
indChamp
}
.
.
Visible
=
Vrai
SINON
nError =
API
(
"
USER32
"
,
"
DrawIconEx
"
,
hDC,
0
,
0
,
hIcon,
nTaille,
nTaille,
0
,
0
,
3
)
FIN
API
(
"
USER32
"
,
"
DestroyIcon
"
,
hIcon)
RENVOYER
Vrai