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）画像を

薄暗い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）ブール 'としてパラメータ： ' ファイル名：の延長ファイル名は "。"例：'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 

エンド機能

公開サブ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 

End Subの

公開サブNo_Icon（ロングとしてByRefのPicture_hDC）文字列 ロング

'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の

限り 薄暗いlngStringLengthとして暗いlngIconNumberとして

薄暗いstrDefaultIcon