В ImageList

[_Мика_]

Я пытался различными способами в ImagList всунуть иконки которые я извлек с помощью ExtractIconEx, не фига не получается . Как эти сделать

[kazah_]

видно без ОСХ зде сь не обойтись...

ищи что-нтбудь такое (я где-то видел) или создавай сам.

[RayShade]

2 kazakh

Бессмысленные постинги лучше не делать.



2 автор темы

В смысле не можешь добавить? Ты из на диск сохраняешь сперва или нет?

[_Мика_]

Ладно. Вот кусок кода который извлекает иконки из Shell32.dll.
Теперь нужно както загнать каждую иконку по порядку в ИмажЛист

ExtractIconEx "shell32.dll", Z, mIcon, ByVal 0&, 1
DrawIcon Picture1.hdc, 32 * X, Y, mIcon
DestroyIcon mIcon

Надеюсь понятно

[Vi]

Код: Выделить всё

Option Explicit

Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long

Const PICTYPE_ICON As Long = 3
Private Type PICTDESC
  cbSizeofstruct As Long
  picType  As Long '
  hgdiobj As Long       ' Bitmap, icon, cursor, or metafile
End Type

Const IID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, myGUID As Any) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
    (ByRef pPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, pPicture As IPicture) As Long

Private Sub Form_Click()
  Dim mIcon As Long
  Dim pi As PICTDESC, pic As IPicture, myGUID(0 To 15) As Byte, li As ListImage
  ExtractIconEx "shell32.dll", 1, mIcon, ByVal 0&, 1
  DrawIcon Picture1.hdc, 0, 0, mIcon
 
  pi.cbSizeofstruct = LenB(pi)
  pi.picType = PICTYPE_ICON
  pi.hgdiobj = mIcon
 
  CLSIDFromString StrPtr(IID_IPicture), myGUID(0)
  OleCreatePictureIndirect pi, myGUID(0), 1, pic
  Set li = ImageList1.ListImages.Add(, , pic)
  Set Picture2.Picture = li.Picture
 
  DestroyIcon mIcon
 
End Sub


[_Мика_]

Хууух! Наконец то хоть ктото дал ответ я то думал уже все потеряно СПАСИБО огромное правда еще не посмотрел но всеравно СПАСИБо!!!

[Dagobert]

Есть API-Функция

Код: Выделить всё

Private Declare Function ImageList_ReplaceIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal I As Long, ByVal hIcon As Long) As Long

Правда, я использовал её с ImageList'ом созданным через API но может сработает.

[_Мика_]

А насчет кода VI
Чо то он не фур фур, жалуется на pic

[Vi]

Вместо IPicture, который определен в stdole библиотеке (в References...) можно использовать любой доступный интерфейс. Для этого замени определения IID_IPicture, OleCreatePictureIndirect и pic

с

Const IID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
(ByRef pPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, pPicture As IPicture) As Long

Dim pi As PICTDESC, pic As IPicture

на

1. Через IUnknown, который есть у каждого объекта
Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Const IID_IPicture = IID_IUnknown

Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
(ByRef pPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, pPicture As IUnknown) As Long

Dim pi As PICTDESC, pic As IUnknown

2. Через IPictureDisp
Const IID_IPictureDisp = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Const IID_IPicture = IID_IPictureDisp

Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
(ByRef pPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, pPicture As IPictureDisp) As Long

Dim pi As PICTDESC, pic As IPictureDisp

3. Через Object
Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"
Const IID_IPicture = IID_IDispatch

Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
(ByRef pPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, pPicture As Object) As Long

Dim pi As PICTDESC, pic As Object

[_Мика_]

Ладно попробую