Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: k_arlytos en Marzo 20, 2014, 03:36:05 pm
-
buenas que tal disulpe las molestias pero existen algun codigo que este acoplado a un usercontrol
que permita pintar una imagen desde un archivo res...
estado haciendo pruebas con algunos controles como el ucImage y el ClsImageControls que tienen para
leer y pintar imagenes desde un res. pero no me sale
tengo errores tambien de estas dos apis...
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
y
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
el primero uso para esto
Private Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long
Dim clrFore As UcsRgbQuad
Dim clrBack As UcsRgbQuad
OleTranslateColor clrFirst, 0, VarPtr(clrFore)
OleTranslateColor clrSecond, 0, VarPtr(clrBack)
With clrFore
.R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) / 255
.G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) / 255
.b = (.b * lAlpha + clrBack.b * (255 - lAlpha)) / 255
End With
CopyMemory VarPtr(pvAlphaBlend), VarPtr(clrFore), 4
End Function
y la otra funcion la saque del proyecto de ucimage
me dice que hay conflicto
pero lo que mas me interesa saber es si existe algun modulo que pueda leer desde un res pero dentro de un usercontrol
-
Hola K_arlytos, podes resolverlo de dos formas, o renombras la api (Preferentemente la de la funcion pvAlphaBlend) con otro nombre por ejemplo :
Private Declare Sub CopyMemorylng Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
y luego la cambias dentro de la funcion
o bien usas la misma para ambos casos, donde te sugiero que elimines la que tiene los parametros "Long", osea la de la funcion pvAlphaBlend, entonces esa función quedaría así
' Función para trasladar un color a otro en porcentaje lAlpha(0 A 255)
Private Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long
Dim clrFore As UcsRgbQuad
Dim clrBack As UcsRgbQuad
OleTranslateColor clrFirst, 0, VarPtr(clrFore)
OleTranslateColor clrSecond, 0, VarPtr(clrBack)
With clrFore
.R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) / 255
.G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) / 255
.B = (.B * lAlpha + clrBack.B * (255 - lAlpha)) / 255
End With
CopyMemory pvAlphaBlend, clrFore, 4
End Function
PD: no entiendo bien en sí, cual es la duda con el titulo del post, tengo entendido que el ucImage le desde Res, cual es el problema, o pon algo de código haber si estas haciendo algo mal.
-
bueno sobre el problema del copymemory era un problema que no podia resolverlo.. espero que a otras personas les ayude tambien
lo que tengo en mente es poder leer una imagen desde un *.res pero desde mi usercontrol y poder pintarlo en un area o
coordenas que yo establesca
tengo como referencia el ClsImageControls "pero segun recuerdo eso lo usabas en los botones y se tenia que compilar primero para que se vea el efecto..." lo que yo deseo es que se visualice sin tener que compilarlo
algo parecido a este metodo, pero este metodo lo lee desde un archivo... y lo que deseo es que se lea desde el archivo *.res
http://leandroascierto.com/foro/index.php?topic=2481.0
solo copie y pegue el codigo del modulo "ClsImageControls" para probar pero no me pinta nada
http://www.mediafire.com/download/e5n1rden3r9uqz1/leerRes.rar
-
Estimado k_arlytos
Ya has intentado usar LoadResPicture esto te retorna un objeto del tipo stdPicture
Por ejemplo:
Command1.Picture = LoadResPicture(101, vbResIcon)
Saludos, desde algún lugar de Lima - Perú
-
quisiera trabajarlo con tipo de dato Long, para trabajarlo con apis
-
espero alguien pueda ayudar.. aun no encuentro la solucion :(
-
Estimado k_arlytos
Por un lado, indicas que quieres pintar una imagen que está en tu archivo .res en tu user control. Y por otro lado, dices que quieres trabajar con datos tipo Long.
Cuando dices que quieres sacar la imagen de un archivo .res te estás refiriendo a un archivo externo a al binario compilado en VB6. Por qué el .res al momento de compilar se incluye dentro del binario resultante. Por favor, puedes aclarar que es lo que realmente necesitas. Gracias.
Saludos, desde algún lugar de Lima - Perú
-
como dice Albertomi, vos tenes un .res al momento de "edicion" (osea desde el IDE de vb). ahora, cuando compilas (.exe), no tendria porque estar el .res ahi, sino que ha quedado embeido en la seccion de recursos.
vos queres usar las apis que leen desde recursos, y ver como queda desde "edicion" sin tener que compilar?
o SIEMPRE queres usar un .res y leer recursos desde ahi (inclusive compilado) ?
-
lo unico que deseo nada mas es leer una imagen desde un archivo *.res para poder pintarlo en mi usercontrol.. esa imagen es algo como un "imagen cerrar", es algo que siempre se debe de pintar por eso lo quiero sacar desde un *.res, eh revisado algunos archivos como el ucImage
tengo entendido que la funcion LoadResPicture(101, vbResIcon) te retorna un objeto stdPicture
pero al tener como resultado un stdPicture como lo puedo pintar en una seccion de mi user control?
en este ejemplo la imagen se sacan desde un archivo...
http://leandroascierto.com/foro/index.php?topic=2481.0
creo que con esta API es posible pintarlo pero lo que veo es que no usa ningun parametro de stdPicture
GdipDrawImageRectRectI hGraphics, hImg, DestX, DestY, DestW, DestH, x, y, Width, Height, &H2, 0&, 0&, 0&
el ucImage no usa stdPicture para pintar la imagen obtenida de un *.res y este tampoco
http://www.mediafire.com/download/e5n1rden3r9uqz1/leerRes.rar
lo saque de la clase ClsImageControls de leandro
-
Ninguno de esos codigos saca una imagen de un .res, mas bien de los recursos del exe compilado. El .res es necesario solo en tiempo de edicion.
Ahora bien, esos codigos usan GDI+, el cual maneja a los graficos como punteros (hGraphics), los cuales deben ser inicializados con imagrnes DC, bit stream (un archivo, los datos binarios de un recurso), o desde otros objetos. Hay apis que convierten stdpicture en hGraphics.
Pero, vos podes cargar la imagen desde recursos como un stdpicture y pintarla con los metodos PaintPicture del UC (pasarle como imagen lo q leiste del recurso)
-
Amigo
revisa esto quizás te sirva
http://leandroascierto.com/foro/index.php?topic=1980.msg11194#msg11194
-
pero yo quiero que el *.res este en mi proyecto en modo de diseño para poder obtener la imagen cuando se ejecute
asi este o no el *.res en mi sistema
-
Hola, vos queres leer una imagen png desde el archivo de recurso de tu proyecto y dibujarla, bien lo que tenes que hacer es poner una imagen PNG y para que sea organizado guardala dentro de un tipo "CUSTOM", y el nombre que vos quieras. me explico no la guardes como un bitmap esto es para que la puedas leer con LoadResData de vb, ahora bien esto te devuelve un array de bits, despues fijate el codigo de abajo como funciona, tambien te incluyo un link de descarga para que veas como esta nombrada la imagen dentro del archivo de recurso.
Option Explicit
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As Any, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipDrawImageRect Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mImage As Long, ByVal mX As Single, ByVal mY As Single, ByVal mWidth As Single, ByVal mHeight As Single) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipGetImageDimension Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mWidth As Single, ByRef mHeight As Single) As Long
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Function LoadImageFromStream(ByRef bvData() As Byte, ByRef hImage As Long) As Boolean
On Local Error GoTo LoadImageFromStream_Error
Dim IStream As IUnknown
If Not IsArrayDim(VarPtrArray(bvData)) Then Exit Function
Call CreateStreamOnHGlobal(bvData(0), 0&, IStream)
If Not IStream Is Nothing Then
If GdipLoadImageFromStream(IStream, hImage) = 0 Then
LoadImageFromStream = True
End If
End If
Set IStream = Nothing
LoadImageFromStream_Error:
End Function
Private Function IsArrayDim(ByVal lpArray As Long) As Boolean
Dim lAddress As Long
Call CopyMemory(lAddress, ByVal lpArray, &H4)
IsArrayDim = Not (lAddress = 0)
End Function
Private Sub Form_Load()
Dim gdiSI As GDIPlusStartupInput
Dim gToken As Long
Dim ArrImagen() As Byte
Dim hImage As Long
Dim hGraphics As Long
Dim mWidth As Single, mHeigth As Single
Me.AutoRedraw = True
gdiSI.GdiPlusVersion = &H1
GdiplusStartup gToken, gdiSI 'Inicializa GDI Plus, El puntero es "gToken"
If gToken Then
ArrImagen = LoadResData("IMAGEN", "CUSTOM") 'Lee una imagen desde el archivo de Recurso con LoadResData este devuelve un Array de bits
If LoadImageFromStream(ArrImagen, hImage) Then 'GDI Plus lee la imagen desde el array de bits y el puntero de la imagen es "hImagen"
If GdipCreateFromHDC(Me.hdc, hGraphics) = 0 Then 'Crea un Grafico a partir de un HDC "hGraphics" es el puntero
GdipGetImageDimension hImage, mWidth, mHeigth 'Obtiene las dimenciones de la imagen
GdipDrawImageRect hGraphics, hImage, 0, 0, mWidth, mHeigth 'Pinta la imagen sobre el Grafico, el cual veremos en nuestro formulario
GdipDeleteGraphics hGraphics 'Elimina el Grafico
End If
GdipDisposeImage hImage 'Descarga la imagen
End If
GdiplusShutdown gToken 'Detiene GDI Plus
End If
Me.Refresh 'Refresco el formulario.
End Sub
Esta todo bien comentado por lo que no vas a tener problemas para adaptarlo a como vos quieras usarlo.
Descargar..
http://www.mediafire.com/download/z728ikndz5z525u/Karlitos.zip
-
Muchisimas gracias leandro de ley que esto les va a servir a los que estan metido en esto...
voy a estudiarlo...
-
y si esa imagen estuviese pintado en una esquina como podria hacer para que alguien le pueda dar click a esa imagen pintada y me muestre un msgbox?
puesto que eso no es un control con eventos si no que es una imagen pintada
no tengo idea de como hacerlo....
de antemano muchas gracias...
-
Maneja el evento MouseClick del UC, y dependiendo de las coordenadas, actua en consecuencia
-
y es posible crear una region en esa parte donde se pinta la imagen y
cada vez que se pasa el mouse cause algun evento....?
una region cuadrada por ejemplo cada vez que el mouse este en esa parte cuadrada del usercontrol
ocurra una accion, se podra hacer eso? usando alguna api
-
Lo mejor a mi parcer, es usar RECT, seguramente es mas rapido que crear una region y lo mismo para verificar si el mouse esta dentro de el RECT, asi que bien las apis a utilizar son:
PtInRect (la cual te da si un punto esta dentro de un rectangulo)
luego dentro del timer como no tenes evento "x, y" usas GetCursorPos y ScreenToClient
en cuanto lo que preuntas si hay algun evento que haga esto, pues no, tenes que codificar todo, no hay una forma sensilla, pero bueno el codigo es un poco de logica, te paso un ejemplo bien completo, agrega un timer en un formulario. (Después vos lo adaptas a tu usercontrol y con todos los chiches)
Option Explicit
Private Declare Function PtInRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'solo para el ejemplo
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Dim m_RECT As RECT
Dim m_MouseIn As Boolean
Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.AutoRedraw = True
SetRect m_RECT, Me.ScaleWidth - 48, 24, Me.ScaleWidth - 24, 48 'Asigno el rectangulo a la derecha de 24x24
PintarRectangulo m_RECT, vbGreen 'lo pinto en un estado normal Verde
Timer1.Enabled = False 'Seteo los datos para el timer
Timer1.Interval = 100
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If PtInRect(m_RECT, X, Y) Then 'si esta dentro del rectangulo
If m_MouseIn = False Then 'una bandera para que no se repita siempre este paso hasta que no salga el mouse (ver en el timer event)
m_MouseIn = True
Timer1.Enabled = True
Debug.Print "Entra en el rectangulo"
If (Button = vbLeftButton) Then 'boton izquierdo
PintarRectangulo m_RECT, vbRed
Else
PintarRectangulo m_RECT, vbBlue 'esto es porque a veces el usuario pincha en el boton luego se arrepiente y despues vuelve sobre el boton. probar esto en cualquier boton.
End If
End If
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (PtInRect(m_RECT, X, Y) = 1) And (Button = vbLeftButton) Then 'dos condiciones dentro del rectangulo y con el boton izquierdo.
If m_MouseIn Then
Debug.Print "MouseDown en el rectangulo"
PintarRectangulo m_RECT, vbRed
End If
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (PtInRect(m_RECT, X, Y) = 1) And (Button = vbLeftButton) Then
If m_MouseIn Then 'condiciones para decier que esto fue un click
Debug.Print "Click en el rectangulo"
PintarRectangulo m_RECT, vbBlue
End If
End If
End Sub
'Opcional, es en el caso que se hacen muchos click seguidos (no es el caso para un boton cerrar.)
Private Sub Form_DblClick()
Dim PT As POINTAPI
GetCursorPos PT
ScreenToClient Me.hwnd, PT
If (PtInRect(m_RECT, PT.X, PT.Y) = 1) And (GetKeyState(vbLeftButton) < 0) Then
PintarRectangulo m_RECT, vbRed
Debug.Print "MouseDown en el rectangulo 2"
End If
End Sub
'Esto es la parte donde se controla si el mouse sale del rectangulo, el timer se habilita solo cuando el mouse habia entrado en el rectangulo. NO consume muchos recursos
Private Sub Timer1_Timer()
Dim PT As POINTAPI
GetCursorPos PT
ScreenToClient Me.hwnd, PT
If PtInRect(m_RECT, PT.X, PT.Y) = 0 Then 'no estan en el rectangulo entonces..
Timer1.Enabled = False 'detengo el timer
m_MouseIn = False 'cambio la bandera
PintarRectangulo m_RECT, vbGreen 'restablesco el color del boton
Debug.Print "Sale de el rectagulo"
End If
End Sub
Private Sub Form_Resize()
SetRect m_RECT, Me.ScaleWidth - 48, 24, Me.ScaleWidth - 24, 48 'muevo las nuevas cordenadas
PintarRectangulo m_RECT, vbGreen
End Sub
'solo un ejemplo para pintar el rectangulo (si pasa el codigo a un user control cambia el me. por usercontrol.)
Private Sub PintarRectangulo(ByRef tRECT As RECT, oColor As OLE_COLOR)
Dim hBrush As Long
Me.Cls
hBrush = CreateSolidBrush(oColor)
FillRect Me.hdc, tRECT, hBrush
DeleteObject hBrush
Me.Refresh
End Sub
El uso del timer sea un control o por api a mi parecer es lo mejor, ya que se podría evitar, pero también podrían fallar algunos eventos.
-
muchas gracias leandro.... voy aestudiarlo y a probarlo