Controles OCX

Controles OCX


Controles OCX

Para para la creacion de un ocx muy simple haremos lo siguiente

1.-Crear un nuevo proyecto de tipo Exe estándar


2.-Ahora nuevamente desde el menú Archivo seleccionar la opción Agregar Proyecto y elegir un Proyecto de tipo Control Activex , para de esta manera tener 2, y formar un grupo de proyectos


3.-Ahora en la ventana del Usercontrol colocar una barra de scroll Horizontal y una vertical con el nombre por defecto y a las mismas establecerle la propiedad Visible en Fals


4.-Ahora abrir la ventana de código del Usercontrol y pegar el siguiente código

Option Explicit
Private Sub Cargar_Imagen()
' Si el image no tiene cargada una imagen sale
If Image1.Picture = 0 Then
HScroll1.Visible = False
VScroll1.Visible = False
Exit Sub
End If
'Posiciona el control Image
With Image1
.Visible = False
.Left = 0
.Top = 0
End With
'Oculta los ScrollBar
With HScroll1
.Value = 0
.Visible = False
End With
With VScroll1
.Value = 0
.Visible = False
End With
'Asigna el valor máximo de los Scroll los hace visible
With Image1
If .Width > Width Then
HScroll1.Visible = True
HScroll1.Max = .Width - Width
Else
.Left = 0
End If
If .Height > Height Then
VScroll1.Visible = True
VScroll1.Max = .Height - Height
Else
.Top = 0
End If
.Visible = True
End With
'Posiciona y redimensiona los dos ScrollBar en el control
VScroll1.Move ScaleWidth - VScroll1.Width, 0, VScroll1.Width, ScaleHeight
HScroll1.Move 0, (ScaleHeight - HScroll1.Height), _
(ScaleWidth - VScroll1.Width), HScroll1.Height
If VScroll1.Visible = False Then
HScroll1.Width = ScaleWidth
End If
If HScroll1.Visible = False Then
VScroll1.Height = ScaleHeight
End If
End Sub
Private Sub HScroll1_Change()
If HScroll1.Value > Image1.Width Then
Exit Sub
Else
Image1.Left = 0 - HScroll1.Value
End If
End Sub
Private Sub HScroll1_Scroll()
If HScroll1.Value > Image1.Width Then
Exit Sub
Else
Image1.Left = 0 - HScroll1.Value
End If
End Sub
Private Sub UserControl_AmbientChanged(PropertyName As String)
' Ajusta el color del Picture cuando cambia el _
color del formulario contenedor del control
UserControl.BackColor = Ambient.BackColor
End Sub
Private Sub UserControl_Resize()
If Ambient.UserMode Then
Call Cargar_Imagen
End If
End Sub
Private Sub UserControl_Show()
'si está en tiempo de ejecución el usecontrol entonces carga el gráfico
If Ambient.UserMode Then
Cargar_Imagen
End If
End Sub
'Mueve la posición Left del control Image
Private Sub VScroll1_Change()
If VScroll1.Value > Image1.Height Then
Exit Sub
Else
Image1.Top = 0 - VScroll1.Value
End If
End Sub
'Mueve la posición Top del control Image
Private Sub VScroll1_Scroll()
If VScroll1.Value > Image1.Height Then
Exit Sub
Else
Image1.Top = 0 - VScroll1.Value
End If
End Sub
'Propiedad Picture
Public Property Get Picture() As Picture
Set Picture = Image1.Picture
End Property
Public Property Let Picture(ByVal La_Imagen As Picture)
Set Picture = La_Imagen
End Property
Public Property Set Picture(ByVal La_Imagen As Picture)
If Ambient.UserMode Then
Set Image1.Picture = La_Imagen
Cargar_Imagen
PropertyChanged "Picture"
Else
MsgBox "El control permite solo cargar graficos en " & _
"tiempo de ejecución", vbInformation
End If
End Property
'Propiedad BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal El_Color As OLE_COLOR)
UserControl.BackColor = El_Color
PropertyChanged "BackColor"
End Property
'Guarda y lee los valores de las propiedades
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
UserControl.BackColor = .ReadProperty("BackColor", &H8000000F)
Image1.Picture = .ReadProperty("Picture", Nothing)
End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty "BackColor", UserControl.BackColor, &H8000000F
.WriteProperty "Picture", Image1.Picture, Nothing
End With
End Sub
Private Sub UserControl_InitProperties()
'Valores por defecto del usercontrol al iniciar
With UserControl
.Width = 2500
.Height = 2500
.ScaleMode = vbTwips
.BackColor = Ambient.BackColor
.BorderStyle = 1
End With
' Valores por defecto del Image y valores para la posición y tamaño
With Image1
.Top = 0
.Left = 0
.Stretch = False
.BorderStyle = 0
End With
End Sub
'Sub para guardar el gráfico en disco, con SavePicture
Public Sub Save_Picture(ByVal FileName As String)
SavePicture Image1.Picture, FileName
End Sub
5.-El siguiente paso a seguir es colocar el siguiente codigo en el formulario para probar el control

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
ScrollImage1.Picture = LoadPicture(Dir1 & "\" & File1.FileName)
End Sub
Private Sub Form_Load()
File1.Pattern = "*.gif;*.jpg;*.ico;*.bmp"
End Sub


6.-Ahora presionaremos F5 para probar el control



Puedes escribirme a mi dirección de E-MAIL: diegoandresvp@hotmail.com


Página creada por Andres Vela alumno de la Unidad Educativa Salesiana Don Bosco