DedeSurf
Messages postés156Date d'inscriptionmardi 17 décembre 2002StatutMembreDernière intervention23 novembre 2011 23 déc. 2007 à 00:19
Option Explicit
Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long ' et de la relacher
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) _
As Long
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
' Structure contenant des infos sur une image
Public Type PICTDESC
' Normalement cette structure contient une union mais VB ne les gère pas
cbSizeofStruct As Long ' Taille de cette structure
picType As Long ' Type d'image : ICON, BITMAP, METAFILE, ENHMETAFILE
' Début union
hImage As Long ' Handle de l'image
xExt As Long ' Taille x de l'image pour une METAFILE
yExt As Long ' Taille y de l'image pour une METAFILE
End Type
' picType de PICTDESC pour une ICON
Public Const PICTYPE_ICON = 3
'permet de convertir une structure PICTDESC (et donc un handle d'image) en un IPictureDisp (= StdPicture)
Public Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
Public Function GetIcon(ByVal Path As String) As IPictureDisp
Dim hIco As Long
hIco = ExtractAssociatedIcon(0, Path, 0)
Set GetIcon = GetIconFromHandle(hIco)
End Function
Public Function GetIconFromHandle(hIcon As Long) As IPictureDisp
' Le REFIID de IPictureDisp (=GUID)
Dim IID_IPictureDisp As GUID
' Infos sur l'icone
Dim lpIcon As PICTDESC
'on met place l'IID de IPictureDisp
IID_IPictureDisp.Data1 = &H7BF80981
IID_IPictureDisp.Data2 = &HBF32
IID_IPictureDisp.Data3 = &H101A
IID_IPictureDisp.Data4(0) = &H8B
IID_IPictureDisp.Data4(1) = &HBB
IID_IPictureDisp.Data4(2) = &H0
IID_IPictureDisp.Data4(3) = &HAA
IID_IPictureDisp.Data4(4) = &H0
IID_IPictureDisp.Data4(5) = &H30
IID_IPictureDisp.Data4(6) = &HC
IID_IPictureDisp.Data4(7) = &HAB
' On initialise les champs requis :
lpIcon.cbSizeofStruct = Len(lpIcon)
lpIcon.hImage = hIcon
' le type : ICON
lpIcon.picType = PICTYPE_ICON
'on demande la création d'une interface de type IPictureDisp pour le handle d'icône
'et en indiquant de ne pas effacer le HICON quand l'interface est libéré
OleCreatePictureIndirect lpIcon, IID_IPictureDisp, 0, GetIconFromHandle
End Function
public sub form_load()
icon = geticon("bla bla/n")
end sub
Voila le tours est joué l'icone encore une fois n'est pas de très bonne qualité mais y a la transparence ! deplus les déclarations sont soit dans un module soit elle sont privées
Je t'ai collé une icone dans les règle de l'art !
++
DedeSurf
Messages postés156Date d'inscriptionmardi 17 décembre 2002StatutMembreDernière intervention23 novembre 2011 22 déc. 2007 à 23:39
Pour info le translash ne fonctionne pas ici, je ne sais pas pk.
Mais moi sa me fais marré de vous voir pinaillé pr sa !
Sinan la source ... ba jen vois pas l'interet de plus que LoadPicture ouvrir des bitmap !
Donc il ouvrira l'icone aux format bitmap et tous le monde s'est que comme le jpeg il y a pas de couleur transparente comme l'icone curseur gif png .... donc l'icone sera moche bof bof bof
même avec ExtractIcon DrawIcon, et meme avec sa sa donne la couleur de fond du control avec le quel tu travail a moin d'arrivé a travaillé juste avec une variable IPicturedisp ...
++
cs_Koiu
Messages postés269Date d'inscriptionjeudi 26 septembre 2002StatutMembreDernière intervention19 février 2015 30 nov. 2002 à 09:28
nimporte koi!!!!
NISANDSYSTEMS
Messages postés146Date d'inscriptionvendredi 1 novembre 2002StatutMembreDernière intervention13 décembre 2014 29 nov. 2002 à 18:02
tu t pas kc les neurons Koiu pou faire ça
pour ton Form1.Icon LoadPicture("C:icon.ico")doute!!!!
Form1.Icon = LoadPicture("C:icon.ico")=OK
cs_Koiu
Messages postés269Date d'inscriptionjeudi 26 septembre 2002StatutMembreDernière intervention19 février 2015 4 nov. 2002 à 18:00
OUAIS, jai pas bien compris!!!
NicolleauElise
Messages postés16Date d'inscriptionlundi 21 octobre 2002StatutMembreDernière intervention20 novembre 2002 4 nov. 2002 à 17:00
DarkSage, un ptit quoi ? Ce qui est sans interet c'est ton commentaire
cs_DarkSage
Messages postés17Date d'inscriptiondimanche 6 janvier 2002StatutMembreDernière intervention14 août 2004 19 oct. 2002 à 19:23
Mouais, pour faire mon chieur...
Faudrait p'être rajouter un p'tit après le C:
Et sinon, j'vois vraiment pas l'intéret de cette source, mais bon.
cs_Koiu
Messages postés269Date d'inscriptionjeudi 26 septembre 2002StatutMembreDernière intervention19 février 2015 19 oct. 2002 à 14:41
Oui, il faut faire
Form1.Icon = LoadPicture("C:icon.ico")
voila voila....
C'est tout simple mais ça marche super bien!!!!
Alan71
Messages postés530Date d'inscriptionlundi 3 juin 2002StatutMembreDernière intervention13 juin 2004 19 oct. 2002 à 12:59
Dit le direct, kon soit po obligé de downloader le zip (C surtout pour la compil').
Y faut faire un LoadPicture ou simplement regarder dans l'aide, non ?
23 déc. 2007 à 00:19
Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long ' et de la relacher
' déclaration pour fonction TransRegion
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) _
As Long
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
' Structure contenant des infos sur une image
Public Type PICTDESC
' Normalement cette structure contient une union mais VB ne les gère pas
cbSizeofStruct As Long ' Taille de cette structure
picType As Long ' Type d'image : ICON, BITMAP, METAFILE, ENHMETAFILE
' Début union
hImage As Long ' Handle de l'image
xExt As Long ' Taille x de l'image pour une METAFILE
yExt As Long ' Taille y de l'image pour une METAFILE
End Type
' picType de PICTDESC pour une ICON
Public Const PICTYPE_ICON = 3
'permet de convertir une structure PICTDESC (et donc un handle d'image) en un IPictureDisp (= StdPicture)
Public Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp)
Public Function GetIcon(ByVal Path As String) As IPictureDisp
Dim hIco As Long
hIco = ExtractAssociatedIcon(0, Path, 0)
Set GetIcon = GetIconFromHandle(hIco)
End Function
Public Function GetIconFromHandle(hIcon As Long) As IPictureDisp
' Le REFIID de IPictureDisp (=GUID)
Dim IID_IPictureDisp As GUID
' Infos sur l'icone
Dim lpIcon As PICTDESC
'on met place l'IID de IPictureDisp
IID_IPictureDisp.Data1 = &H7BF80981
IID_IPictureDisp.Data2 = &HBF32
IID_IPictureDisp.Data3 = &H101A
IID_IPictureDisp.Data4(0) = &H8B
IID_IPictureDisp.Data4(1) = &HBB
IID_IPictureDisp.Data4(2) = &H0
IID_IPictureDisp.Data4(3) = &HAA
IID_IPictureDisp.Data4(4) = &H0
IID_IPictureDisp.Data4(5) = &H30
IID_IPictureDisp.Data4(6) = &HC
IID_IPictureDisp.Data4(7) = &HAB
' On initialise les champs requis :
lpIcon.cbSizeofStruct = Len(lpIcon)
lpIcon.hImage = hIcon
' le type : ICON
lpIcon.picType = PICTYPE_ICON
'on demande la création d'une interface de type IPictureDisp pour le handle d'icône
'et en indiquant de ne pas effacer le HICON quand l'interface est libéré
OleCreatePictureIndirect lpIcon, IID_IPictureDisp, 0, GetIconFromHandle
End Function
public sub form_load()
icon = geticon("bla bla/n")
end sub
Voila le tours est joué l'icone encore une fois n'est pas de très bonne qualité mais y a la transparence ! deplus les déclarations sont soit dans un module soit elle sont privées
Je t'ai collé une icone dans les règle de l'art !
++
22 déc. 2007 à 23:39
Mais moi sa me fais marré de vous voir pinaillé pr sa !
Sinan la source ... ba jen vois pas l'interet de plus que LoadPicture ouvrir des bitmap !
Donc il ouvrira l'icone aux format bitmap et tous le monde s'est que comme le jpeg il y a pas de couleur transparente comme l'icone curseur gif png .... donc l'icone sera moche bof bof bof
même avec ExtractIcon DrawIcon, et meme avec sa sa donne la couleur de fond du control avec le quel tu travail a moin d'arrivé a travaillé juste avec une variable IPicturedisp ...
++
30 nov. 2002 à 09:28
29 nov. 2002 à 18:02
pour ton Form1.Icon LoadPicture("C:icon.ico")doute!!!!
Form1.Icon = LoadPicture("C:icon.ico")=OK
4 nov. 2002 à 18:00
4 nov. 2002 à 17:00
19 oct. 2002 à 19:23
Faudrait p'être rajouter un p'tit après le C:
Et sinon, j'vois vraiment pas l'intéret de cette source, mais bon.
19 oct. 2002 à 14:41
Form1.Icon = LoadPicture("C:icon.ico")
voila voila....
C'est tout simple mais ça marche super bien!!!!
19 oct. 2002 à 12:59
Y faut faire un LoadPicture ou simplement regarder dans l'aide, non ?