VB6: Affichage d'une icône dans une zone d'image

Question

Je tente essentiellement de dessiner une image d'icône dans une zone d'image.

J'ai le sous-programme suivant. Paramètres d'entrée vérifiés et corrects, cependant l'icône n'apparaît pas dans la zone d'image lorsque DrawIcon est appelée (cela fait partie d'une classe plus grande).

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 

Y at-il quelque chose d'évident que je fais mal? J'ai essayé un certain nombre de solutions de StackOverflow et d'autres sites en vain.

Answer 1

Merci beaucoup pour vos réponses. J'ai résolu le problème avec ce qui suit. J'ai utilisé une image temporaire cachée et un contrôle de la zone d'image pour stocker l'icône ou l'image, respectivement. Leurs contenus sont utilisés pour remplir les contrôles sur le formulaire parent. J'espère que le code est lisible. Merci beaucoup encore une fois.

'appel Code ' Fonction publique GetPictureOrIconAsImage (ByVal sFilename As String) comme image

Dim strDefaultIcon As String Dim lngIconNumber As Long Dim Icône 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: ' Gestionnaire d'erreurs génériques Appel NonCriticalError (MODULE, Err, "GetPictureOrIconAsImage: ErrorHandler") Err.Clear

' End of error handler scope 
On Error GoTo 0 

End Function

'Classe Icône ' Fonction publique GetDefaultIcon (ByRef FileName As String, ByRef lngIconNumber As Long, ByRef strDefaultIcon As String) As Boolean 'Paramètres: ' FileName: L'extension de le nom de fichier, avec le "." par exemple, 'Picture_hDC: Le handle du contexte de l'appareil de Picture Box dans lequel vous voulez afficher l'icône '. 'Exemple: ' appel 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 

End Function

Sous Draw_Icon publique (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

Sous No_Icon publique (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