Foro de elhacker.net

Option Explicit
 
'*********************************************************************************************************************
'* Función           : mGetImage                                                                                      *
'* Fecha             : 15/03/2010 : 11:05                                                                             *
'* Autor             : Skyweb07 * skyweb09@hotmail.es                                                                 *
'* Referencias       : http://msdn.microsoft.com/en-us/library/ms678485%28VS.85%29.aspx                               *
'*                   : http://gpwiki.org/index.php/VB:Tutorials:WINAPI:Copy_DirectDrawSurface_To_StdPicture           *
'* Próposito         : Cargar una imagen en un picturebox o Image desde una ruta local o remota [URL]                 *
'* Comentarios       : Microsoft : El flujo debe estar en (bitmap), JPEG, WMF (metafile), ICO (icon), o formato GIF.  *
'* Soporte           : SO Minimo : Windows 2000 Professional                                                          *
'* Modo de uso       : PictureBox.picture = GetImage("URL de la imagen", Color Transparente [Opcional])               *
'**********************************************************************************************************************
 
Private Declare Function OleLoadPicturePath Lib "oleaut32.dll" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As GUID, ByRef ppvRet As IPicture) As Long
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Public Function GetImage(hURLorPath As String, Optional TransparentColor As OLE_COLOR = vbWhite) As StdPicture
 
    Dim uID As GUID
 
    With uID ' // StdPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
 
    Call OleLoadPicturePath(StrPtr(hURLorPath), 0&, 0&, TransparentColor, uID, GetImage)
 
End Function 

    End With
    'Aquí puede haber más code...
End Function

'OLEAUT32
Private Declare Function OleLoadPicturePath Lib "OLEAUT32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As GUID, ByRef ppvRet As IPicture) As Long
 
Private Type GUID
    cData1  As Currency
    cData2  As Currency
End Type
 
Public Function GetImage(hURLorPath As String, Optional TransparentColor As OLE_COLOR = vbWhite) As StdPicture
    Dim uID     As GUID
 
    With uID ' // StdPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
        .cData1 = 116045007755044.6976@
        .cData2 = -612146501409303.8709@
    End With
 
    Call OleLoadPicturePath(StrPtr(hURLorPath), 0&, 0&, TransparentColor, uID, GetImage)
End Function