VB6：在图片框中显示图标

Question

我基本上只是想在图片框中绘制一个图标图像。

我有以下子程序。输入参数已验证并正确，但是在调用DrawIcon 时，图标不会显示在图片框中（这是更大类的一部分）。

Public Sub Draw_Icon(ByVal strDefaultIcon As String, ByVal lngIconNumber As Long, ByRef Picture_hDC As Long)

Dim lngIcon As Long
Dim lngError As Long

    lngIcon = ExtractIcon(App.hInstance, strDefaultIcon, lngIconNumber)

    If (lngIcon = 1 Or lngIcon = 0) Then
        Call No_Icon(Picture_hDC)
    Else
        lngError = DrawIcon(Picture_hDC, 0, 0, lngIcon)
        lngError = DestroyIcon(lngIcon)
    End If
End Sub

有什么明显的我做错了吗？我尝试了 StackOverflow 和其他网站的许多解决方案，但均无济于事。

Answer 1

非常感谢您的回答。我用以下方法解决了这个问题。我使用隐藏的临时图像和图片框控件分别存储图标或图像。它们的内容用于填充父窗体上的控件。我希望代码是可读的。再次非常感谢您。

' 调用代码 ' 公共函数 GetPictureOrIconAsImage(ByVal sFilename As String) As Picture

将 strDefaultIcon 调暗为字符串 Dim lngIconNumber As Long 暗淡的图标作为新的 clsIcon

' Set error handler
On Error GoTo ErrorHandler   

picTempPicture.Picture = LoadPicture("")
picTempIcon.Picture = LoadPicture("")

' Return picture if this is a picture file, otherwise attempt to return icon
If (modEasyQProcs.IsPictureFile(sFilename)) Then
    picTempPicture.Picture = LoadPicture(sFilename)
    Set GetPictureOrIconAsImage = picTempPicture.Picture
Else
    If (Icon.GetDefaultIcon(sFilename, lngIconNumber, strDefaultIcon)) Then
        Call Icon.Draw_Icon(strDefaultIcon, lngIconNumber, picTempIcon.hDC)
    Else
        Call Icon.No_Icon(picTempIcon.hDC)
    End If

    Set GetPictureOrIconAsImage = picTempIcon.Image
End If

Exit Function

ErrorHandler: ' 通用错误处理程序 调用 NonCriticalError(MODULE, Err, "GetPictureOrIconAsImage:ErrorHandler") Err.清除

' End of error handler scope
On Error GoTo 0

结束函数

' 类图标 ' 公共函数 GetDefaultIcon(ByRef FileName As String, ByRef lngIconNumber As Long, ByRef strDefaultIcon As String) As Boolean '参数： 'FileName：文件名的扩展名，带“.”例如.doc 'Picture_hDC：你想要图标的图片框的设备上下文句柄 '要显示在上面。 '例子： '调用GetDefaultIcon(".doc",Picture1.hDC)

Dim TempFileName As String
Dim lngError As Long
Dim lngRegKeyHandle As Long
Dim strProgramName As String
Dim lngStringLength As Long
Dim lngIcon As Long
Dim intN As Integer

GetDefaultIcon = False

TempFileName = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)

If (LCase(TempFileName) = ".exe") Then
    strDefaultIcon = Space(260)
    lngStringLength = GetSystemDirectory(strDefaultIcon, 260)
    strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL"
    lngIconNumber = 2

    GetDefaultIcon = True
Else
    lngError = RegOpenKey(HKEY_CLASSES_ROOT, TempFileName, lngRegKeyHandle)
    If (lngError = 0) Then
        lngStringLength = 260
        strProgramName = Space$(260)

        lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strProgramName, lngStringLength)
        If (lngError = 0) Then
            lngError = RegCloseKey(lngRegKeyHandle)

            lngError = RegCloseKey(lngRegKeyHandle)
            strProgramName = Left(strProgramName, lngStringLength - 1)
            lngError = RegOpenKey(HKEY_CLASSES_ROOT, strProgramName & "\DefaultIcon", lngRegKeyHandle)

            If (lngError = 0) Then
                lngStringLength = 260
                strDefaultIcon = Space$(260)
                lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strDefaultIcon, lngStringLength)
                If (lngError) Then
                    lngError = RegCloseKey(lngRegKeyHandle)
                Else
                    lngError = RegCloseKey(lngRegKeyHandle)
                    strDefaultIcon = Trim$(Left(strDefaultIcon, lngStringLength - 1))

                    intN = InStrRev(strDefaultIcon, ",")

                    If (intN >= 1) Then
                        lngIconNumber = Trim$(Right(strDefaultIcon, Len(strDefaultIcon) - intN))
                        strDefaultIcon = Trim$(Left(strDefaultIcon, intN - 1))

                        GetDefaultIcon = True
                    End If
                End If
            End If
        End If
    End If
End If

结束函数

Public Sub Draw_Icon(ByVal strDefaultIcon As String, ByVal lngIconNumber As Long, ByRef Picture_hDC As Long)

Dim lngIcon As Long Dim lngError As Long

lngIcon = ExtractIcon(App.hInstance, strDefaultIcon, lngIconNumber)

If (lngIcon = 1 Or lngIcon = 0) Then
    Call No_Icon(Picture_hDC)
Else
    lngError = DrawIcon(Picture_hDC, 0, 0, lngIcon)

    If (lngError) Then lngError = DestroyIcon(lngIcon)
End If

结束子

Public Sub No_Icon(ByRef Picture_hDC As Long)

将 strDefaultIcon 调暗为字符串 Dim lngIconNumber As Long Dim lngStringLength As Long

'No icon could be found so we use the normal windows icon
'This icon is held in shell32.dll in the system directory, Icon 0
strDefaultIcon = Space(260)
lngStringLength = GetSystemDirectory(strDefaultIcon, 260)
strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL"
lngIconNumber = 0
Call Draw_Icon(strDefaultIcon, lngIconNumber, Picture_hDC)

结束子