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

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

＆＃39;调用代码＆＃39; 公共函数GetPictureOrIconAsImage（ByVal sFilename As String）As Picture

Dim strDefaultIcon As String Dim lngIconNumber As Long Dim Icon As New 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：＆＃39;通用错误处理程序调用NonCriticalError（MODULE，Err，＆＃34; GetPictureOrIconAsImage：ErrorHandler＆＃34;） Err.Clear

' End of error handler scope
On Error GoTo 0

结束功能

＆＃39;类图标＆＃39; 公共函数GetDefaultIcon（ByRef FileName As String，ByRef lngIconNumber As Long，ByRef strDefaultIcon As String）As Boolean ＆＃39;参数：＆＃39; FileName：文件名的扩展名，使用＆＃34;。＆＃34;例如.doc ＆＃39; Picture_hDC：您希望图标的图片框的设备上下文句柄＆＃39;显示。＆＃39;实施例：＆＃39;调用GetDefaultIcon（＆＃34; .doc＆＃34;，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

End Sub

Public Sub No_Icon（ByRef Picture_hDC As Long）

Dim strDefaultIcon As String 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)

End Sub

VB6：在图片框中显示图标

1 个答案: