非常感謝您的回答。我解決了以下問題。我使用了一個隱藏的臨時圖像和圖片框控件來分別存儲圖標或圖像。它們的內容用於填充父窗體上的控件。我希望代碼是可讀的。再次感謝你。
'調用代碼 ' 公共功能GetPictureOrIconAsImage(BYVAL sFilename作爲字符串)作爲圖片
昏暗strDefaultIcon作爲字符串 昏暗lngIconNumber只要 昏暗的圖標,新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.Clear
' End of error handler scope
On Error GoTo 0
端功能
'類圖標 ' 公共功能GetDefaultIcon(爲ByRef文件名作爲字符串,爲ByRef lngIconNumber長,爲ByRef strDefaultIcon作爲字符串)作爲布爾 '參數: ' 文件名:的擴展文件名,與「。」例如,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
端功能
公用Sub Draw_Icon(BYVAL strDefaultIcon作爲字符串,BYVAL lngIconNumber長,爲ByRef Picture_hDC只要)
昏暗lngIcon只要 昏暗lngError只要
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
結束子
公用Sub No_Icon(爲ByRef Picture_hDC只要)
昏暗strDefaultIcon作爲字符串 昏暗lngIconNumber只要 昏暗lngStringLength只要
'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)
結束子