[Función] GetImage [VB6]

Iniciado por skyweb07, 15 Marzo 2010, 19:24 PM

0 Miembros y 1 Visitante están viendo este tema.

skyweb07

Bueno estaba intentando hacer algo pero me salio este churro... Saludos

Código (vb) [Seleccionar]
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



EDITADO : Perdón por el error que me falto un pedazo de code al postearlo :D

RAID-MAM


Shell Root

xD si creo que le falto...
Código (vb) [Seleccionar]
   End With
   'Aquí puede haber más code...
End Function
Por eso no duermo, por si tras mi ventana hay un cuervo. Cuelgo de hilos sueltos sabiendo que hay veneno en el aire.

Karcrack

The stream must be in BMP (bitmap), JPEG, WMF (metafile), ICO (icon), or GIF format.
Me gusta :D Minimalista! :P

ssccaann43 ©

Esto lo habras sacado de acá:http://www.runelocus.com/forums/archive/index.php/t-25306.html

Y creo que si, la gran mayoria de las variables estan iguales...

:silbar:

Citar
Twisted
21st February 2009, 01:13
Hello, I'm not sure what the rule is on double posting here so I'm sorry if there is one. Just thought id let twisted know something.

This code might interest you, allows you to loads a picture from a url to a picturebox.

Private Type TGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

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 TGUID, ByRef ppvRet As IPicture) As Long

Public Function LoadPicture(ByVal filename As String) As Picture

Dim myTGUID As TGUID

myTGUID.Data1 = &H7BF80980
myTGUID.Data2 = &HBF32
myTGUID.Data3 = &H101A
myTGUID.Data4(0) = &H8B
myTGUID.Data4(1) = &HBB
myTGUID.Data4(2) = &H0
myTGUID.Data4(3) = &HAA
myTGUID.Data4(4) = &H0
myTGUID.Data4(5) = &H30
myTGUID.Data4(6) = &HC
myTGUID.Data4(7) = &HAB

On Error GoTo LblError

OleLoadPicturePath StrPtr(filename), 0, 0, 0, myTGUID, LoadPicture

Exit Function

LblError:

MsgBox Err.Description

Set LoadPicture = VB.LoadPicture(filename)
End Function

Also if you would like me to convert any code from vb.net version to vb6 i am more than willing to.

Nah nah its cool.
But by the looks of things that loads a picture from a image file on your computer, And i tried to do this, It only worked for as i said files already on the computer. I was looking for ones that load of the internet kinda like the code that you just gave me except it work's for links like:


Image1.Picture = VB.LoadPicture("http://garcya.us/images/car-wallpapers19.jpg")


Thats a link to a car, I didn't work with the code it gave me an error.
But once i downloaded it put it in C:/ i just change the code to.


Image1.Picture = VB.LoadPicture("C:/car-wallpapers19.jpg")


And it worked great.

So in other words do you have a code like this, but loads of an image from a URL rather then a location on your Computer?

P.S
I just found out with your code you can adjust the size, color depth, and the X and Y coord's for the picture.
Nice .DLL there lol.
- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"

Karcrack

#5
Cita de: ssccaann43 en 16 Marzo 2010, 13:43 PM
Esto lo habras sacado de acá:http://www.runelocus.com/forums/archive/index.php/t-25306.html

Y creo que si, la gran mayoria de las variables estan iguales...

:silbar:
Que malo eres >:D :xD

Si solo es un API como quieres que se haga de otra forma? Que cargue el type con dos Currencys? Tal que asi:
Código (vb) [Seleccionar]
'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


No hay mucho que hacer en la llamada a un API, asi que no seas malo :P

ssccaann43 ©

Pero quizas pudo colocar la referencia, y no decir que el source es de el...

Pero igual, Excelente Copy & Paste...! :silbar:
- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"

Komodo

Cita de: ssccaann43 en 16 Marzo 2010, 14:52 PM
Pero quizas pudo colocar la referencia, y no decir que el source es de el...

Pero igual, Excelente Copy & Paste...! :silbar:
Ya vino este user a mi ex-foro, con unos copys &pastes..

No me meteré en bullas, y menos sin que sepais quien soy de verdad.


ssccaann43 ©

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"

freddyjose00

Bueno Miguel tienen razón el debio decir de donde viene el codigo y así se fuera visto mejor.. De todas maneras buen aporte para los que no sabemos de otras páginas como: http://www.runelocus.com/forums/archive/index.php/t-25306.html ...  :silbar:

Creo que una de los progresos más notorios es que ya no se siente la necesidad compulsiva de argumentar o justificar las cosas. Estamos mucho más dispuestos a admitir que ciertas cosas son instintivas y otras son intelectual.

Rem Koolhaas