一些图标在系统下看起来很好,但是使用picturebox控件载入得时候分辨率却变的非常低。另外我用LoadImage这个API函数来载入图标文件发现,第三、四个参数得数值不同得到得效果不一样,而且可能连图标都不一样,怎么回事,难道一个图标文件保存有好几个图标?如果这样如何选择其中一个图标?

解决方案 »

  1.   

    "难道一个图标文件保存有好几个图标?" 一个dll ocx或exe 有可能包含数个甚至上百个图标."使用picturebox控件载入得时候分辨率却变的非常低" 不会吧,抓到的图标再显示出来并没啥两样.【CBM666 的将系统图标添加进imagelist中】'添加 ImageList1 Command1 Picture1 Image1Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon 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 DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
    Dim i&, ticons&, p&()Private Sub Form_Load()
       With Picture1
          .Width = 480
          .Height = 480
          .BorderStyle = 0
          .AutoRedraw = True
       End With
       Me.Width = 8000
       Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
       Me.AutoRedraw = True
    End SubPrivate Sub Command1_Click()
       Call Geticonall(Me, Environ("windir") & "\system32\shell32.dll") '改为你自己的路径,OCX DLL皆可.
    End SubPublic Function Geticonall(pic1 As Object, pathstr As String) As Long
       On Error Resume Next
       If TypeOf pic1 Is Form Or TypeOf pic1 Is PictureBox Then pic1.AutoRedraw = False
       ticons = ExtractIcon(App.hInstance, pathstr, -1)
       For i = 0 To ticons - 1
          ReDim Preserve p&(i)
          p(i) = ExtractAssociatedIcon(App.hInstance, pathstr, i) '读取每个图标
          DrawIcon pic1.hdc, 32 * i, 0, p(i)
          BitBlt Picture1.hdc, 0, 0, 32, 32, pic1.hdc, i * 32, 0, vbSrcCopy
          ImageList1.ListImages.Add i + 1, "a" & i + 1, Picture1.Image
          'ListView1.SmallIcons = ImageList1
          'Set itm = ListView1.ListItems.Add(, "Row" & CStr(i), EXEName, 1, i)
          Picture1.Picture = Picture1.Image 'picture1可以拖到窗体外面
          Picture1.Refresh
          DestroyIcon p(i)
       Next i
       Geticonall = ticons '返回共有几个图标
       Image1.Picture = ImageList1.ListImages(3).Picture '验证是否已进入ImageList,别无它用
    End Function 
      

  2.   

    picturebox载入用loadpicture,第二个参数你是不是设成ICON了?
      

  3.   

    抓的图标是"虚"的,只是一个影像,它不是文件不能用LoadPictureBitBlt Picture1.hdc, 0, 0, 32, 32, pic1.hdc, i * 32, 0, vbSrcCopy 
    我抓到的所有图标是画在 pic1这个图像匡里面
    使用BitBlt将上面图像的一个区块拷到Picture1的影像里面