Pruebas ActiveX -gsImage

Ejemplo de Control ActiveX (gsImage.ocx)

La funci�n de esta p�gina es para que se instale en tu equipo.
S�lo funciona con Internet Explorer 3 o superior y Netscape con alg�n plug-in (creo).

Actualizado: 20/May/97
Revisado 8-Jul-97

Otra prueba (aunque realmente no es tan "prueba"), para poder usarlo con VB4.
Este control admite los formatos GIF y JPG. Se puede usar sin problemas con VB4 de 32 bits.

Bajate los listados del control y los ejemplos para VB4 y VB5 (cualquier edici�n) (gsImage.zip 26.1KB)

Este control no tiene pr�cticamente ning�n misterio, casi lo �nico que hace es tomar el control Image que incorpora VB5 y al estar compilado como control ActiveX, puedes usarlo en tus proyectos de VB4 (32 bits)
De esta forma dispondr�s de un control Image que puede cargar archivos del tipo GIF y JPG.

Si quieres obtener los listados del control, as� como un form de prueba, pulsa en el link que hay arriba.
Este control puedes usarlo en cualquier VB de 32bits, para modificarlo s�lo en VB5cce y dem�s versiones de pago.

Para ver los diferentes listados, pulsa en estos links:

El listado del Control (gsImage.ctl)
El Form de Prueba, v�lido tanto para VB4 como para VB5 (con un poco de Drag & Drop, para que no quede la cosa demasiado "sosa"

El listado del control

'-----------------------------------------------------------------
'Control de Imagen, para usar con VB4                   (20/May/97)
'-----------------------------------------------------------------
Option Explicit
'Event Declarations:
Event Click() 'MappingInfo=Image1,Image1,-1,Click
Attribute Click.VB_Description = "Ocurre cuando el usuario presiona y libera un bot�n del mouse encima de un objeto."
Event DblClick() 'MappingInfo=Image1,Image1,-1,DblClick
Attribute DblClick.VB_Description = "Ocurre cuando el usuario presiona y suelta un bot�n del mouse y lo vuelve a presionar y soltar sobre un objeto."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image1,Image1,-1,MouseDown
Attribute MouseDown.VB_Description = "Ocurre cuando el usuario presiona el bot�n del mouse mientras un objeto tiene el enfoque."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image1,Image1,-1,MouseMove
Attribute MouseMove.VB_Description = "Ocurre cuando el usuario mueve el mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image1,Image1,-1,MouseUp
Attribute MouseUp.VB_Description = "Ocurre cuando el usuario suelta el bot�n del mouse mientras un objeto tiene el enfoque."


' Cargar valores de propiedades desde el almacenamiento
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Local Error Resume Next
    Image1.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    Image1.Enabled = PropBag.ReadProperty("Enabled", True)
    Image1.Stretch = PropBag.ReadProperty("Stretch", False)
    ToolTipText = PropBag.ReadProperty("ToolTipText", "")
    Err = 0
End Sub


Private Sub UserControl_Resize()
    Static YaEstoy As Boolean
    
    If YaEstoy Then Exit Sub
    YaEstoy = True
    With Image1
        If .Stretch = False Then
            Height = .Height
            Width = .Width
        Else
            .Height = Height
            .Width = Width
        End If
    End With
    YaEstoy = False
    'Image1.ToolTipText = Extender.ToolTipText
End Sub


' Escribir valores de propiedades en el almacenamiento
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    On Local Error Resume Next
    Call PropBag.WriteProperty("BorderStyle", Image1.BorderStyle, 0)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Enabled", Image1.Enabled, True)
    Call PropBag.WriteProperty("Stretch", Image1.Stretch, False)
    Call PropBag.WriteProperty("ToolTipText", ToolTipText, "")
    Err = 0
End Sub


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=Image1,Image1,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Devuelve o establece un valor que determina si un objeto puede responder a eventos generados por el usuario."
    Enabled = Image1.Enabled
End Property


Public Property Let Enabled(ByVal New_Enabled As Boolean)
    Image1.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=Image1,Image1,-1,Picture
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "Devuelve o establece el gr�fico que se mostrar� en un control."
    Set Picture = Image1.Picture
End Property


Public Property Set Picture(ByVal New_Picture As Picture)
    Set Image1.Picture = New_Picture
    PropertyChanged "Picture"
    UserControl_Resize
End Property


Public Property Let Picture(ByVal New_Picture As Picture)
    Set Image1.Picture = New_Picture
    PropertyChanged "Picture"
    UserControl_Resize
End Property


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=Image1,Image1,-1,Appearance
Public Property Get Appearance() As Integer
Attribute Appearance.VB_Description = "Devuelve o establece si los objetos se dibujan en tiempo de ejecuci�n con efectos 3D."
    Appearance = Image1.Appearance
End Property


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=Image1,Image1,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Devuelve o establece el estilo del borde de un objeto."
    BorderStyle = Image1.BorderStyle
End Property


Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    Image1.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Obliga a volver a dibujar un objeto."
    UserControl.Refresh
End Sub


Private Sub Image1_Click()
    RaiseEvent Click
End Sub


Private Sub Image1_DblClick()
    RaiseEvent DblClick
End Sub


Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub


Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub


Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub


Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub


Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub


'�ADVERTENCIA! NO QUITAR O MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS!
'MappingInfo=Image1,Image1,-1,Stretch
Public Property Get Stretch() As Boolean
Attribute Stretch.VB_Description = "Devuelve o establece un valor que determina si un gr�fico cambia su tama�o para ajustarse al tama�o de un control Image."
    Stretch = Image1.Stretch
End Property


Public Property Let Stretch(ByVal New_Stretch As Boolean)
    Image1.Stretch = New_Stretch
    PropertyChanged "Stretch"
    UserControl_Resize
End Property


Public Property Get ToolTipText() As String
    ToolTipText = Image1.ToolTipText
End Property


Public Property Let ToolTipText(ByVal New_ToolTipText As String)
    Image1.ToolTipText = New_ToolTipText
    PropertyChanged "ToolTipText"
End Property

El listado del Form de Prueba Con un poco de Drag & Drop, para que no quede la cosa demasiado "sosa"
El form tiene un CommandButton y un CheckBox, adem�s del control de marras.

'--------------------------------------------------------------
'Prueba para el control gsImage                     (20/May/97)
'Para VB5 y VB4
'--------------------------------------------------------------
Option Explicit

Dim sImg1$(1 To 2)
Dim iImg%
Dim x1&, y1&
Dim iDrag%


Private Sub Command1_Click()
    iImg = iImg + 1
    If iImg > 2 Then
        iImg = 1
    End If
    gsImage1.Picture = LoadPicture(sImg1(iImg))
End Sub


Private Sub Check1_Click()
    gsImage1.Stretch = Check1.Value
End Sub


Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
    Source.Left = X - x1
    Source.Top = Y - y1
    Source.Drag vbEndDrag
End Sub


Private Sub Form_Load()
    iImg = 0
    'Pon aqu� las imagenes que prefieras
    sImg1(1) = "ActiveXanim.gif"
    sImg1(2) = "D:\Webs\guiller\Imagenes\el_guille.jpg"
    Command1_Click
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
End Sub


Private Sub gsImage1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        x1 = X
        y1 = Y
        iDrag = True
        gsImage1.Drag
    End If
End Sub


Private Sub gsImage1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        '
    Else
        iDrag = False
        gsImage1.Drag vbCancel
    End If
End Sub


Private Sub gsImage1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    iDrag = False
    gsImage1.Drag vbCancel
End Sub

En esta Revisi�n, lo que he hecho ha sido volver a comprobar el buen funcionamiento del control en VB4-32 bits y de camino le he a�adido al form de prueba un par de cosillas m�s, por ejemplo poder abrir una nueva imagen y tambi�n poder guardar la imagen actual como BMP, que es el �nico formato que permite el VB con la orden SavePicture, al menos el �nico formato que funciona.
He a�adido tres imagenes de muestra, para que puedas probar sin problemas, por eso el archivo ZIP es m�s grande de la cuenta. El control sigue siendo el mismo, no ha cambiado.
Recuerda que el VB no espera que se pueda a�adir a un archivo de Imagen archivos del tipo GIF ni JPG, as� que si desde el cuadro de propiedades vas a a�adir alguna imagen, esta deber�s seleccionarla con All Files (*.*).

Aqu� tienes el listado de las nuevas "ordenes" y un link para el listado de ejemplo. (t4_gsImg.zip 33.1 KB)

'Esto hay que a�adirlo/sustituir en las declaraciones del Form
Dim numImage As Integer
Dim sImg1$() 'Antes era Dim sImg1$(1 To 2)


'Un bot�n para examinar y abrir una nueva imagen
'
Private Sub cmdExaminar_Click()
    'Seleccionar una nueva imagen
    On Local Error Resume Next
    
    With CommonDialog1
        .Filter = "Imagenes (*.gif; *.jpg; *.bmp; *.wmf)|*.gif; *.jpg; *.bmp; *.wmf|Todos los archivos (*.*)|*.*"
        .filename = Text1
        .ShowOpen
        If Err = 0 Then
            Text1 = .filename
            numImage = numImage + 1
	    'Con Redim Preserve mantenemos en memoria los valores anteriores
            ReDim Preserve sImg1(numImage)
            sImg1(numImage) = Text1
            iImg = numImage
	    'La mostramos...
            gsImage1.Picture = LoadPicture(sImg1(iImg))
        End If
    End With
    Err = 0
    On Local Error GoTo 0
End Sub


'Este botoncito es el que nos permite guardar la imagen actual
'
Private Sub cmdGuardar_Click()
    'Guardar la imagen actual
    Dim bSalvar As Boolean
    
    On Local Error Resume Next
    
    With CommonDialog1
        .Filter = "BMP (*.bmp)|*.bmp|Todos los archivos (*.*)|*.*"
        .filename = Text1
        .ShowSave
        bSalvar = False
        If Err = 0 Then
            Text1 = .filename
            bSalvar = True
            If Len(Dir$(Text1.Text)) Then
                If MsgBox("Ese archivo ya existe, �lo quieres sobrescribir?", vbYesNo) = vbNo Then
                    bSalvar = False
                End If
            End If
            If bSalvar Then
                SavePicture gsImage1.Picture, Text1.Text
            End If
        End If
    End With
    Err = 0
    On Local Error GoTo 0
End Sub


'As� es como debe quedar el Command1_Click
'para que roten las imagenes a�adidas
'
Private Sub Command1_Click()
    iImg = iImg + 1
    If iImg > numImage Then
        iImg = 1
    End If
    gsImage1.Picture = LoadPicture(sImg1(iImg))
    Text1 = sImg1(iImg)
End Sub


'Este es el nuevo Form_Load
'Las imagenes est�n en el archivo comprimido que se acompa�a con esta nueva revisi�n
'
Private Sub Form_Load()
    numImage = 3
    ReDim sImg1(1 To numImage)
    iImg = 0
    sImg1(1) = "guille3.jpg"
    sImg1(2) = "ActiveXanim.gif"
    sImg1(3) = "el_guille.jpg"
    MostrarTip = 0
    Command1_Click
End Sub