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