lunes, 16 de octubre de 2017

VBA Access. Módulo de Clase clsCarousel. Clase para hacer un carrusel de imágenes combinándola con un timer.

Option Compare Database
Option Explicit

'1 En el formulario donde haremos el carrusel, definimos una variable del tipo clsCarousel
'2 Crearemos un control imagen
'3 Instanciamos el objeto y llamamos al método LoadImages pasando la carpeta donde contenga las imágenes y el nombre del control imagen por referencia
'4 Iniciamos un Timer con el refresco que queramos
'5 cada evento del timer (OnTimer), llamaremos al método NextImage

Private ControlImagen As Control
Private NumImagenActual As Integer
Private DiccionarioImagenes As Dictionary

Private Sub Class_Initialize()
    NumImagenActual = 0
End Sub

Private Sub Class_Terminate()
    If Not DiccionarioImagenes Is Nothing Then
        DiccionarioImagenes.RemoveAll
        Set DiccionarioImagenes = Nothing
    End If
End Sub

Function LoadImages(ByVal CarpetaImagenes As String, ByRef ctlImagen As Control) As Boolean
On Error GoTo error
    Set DiccionarioImagenes = New Dictionary
 
    Dim i As Integer
    i = 0
    Dim file As Object
    Dim fso As New FileSystemObject
    For Each file In fso.GetFolder(CarpetaImagenes).Files
        i = i + 1
        DiccionarioImagenes.Add CStr(i), CStr(file)
    Next file
     
    Set ControlImagen = ctlImagen
    NextImage
 
    LoadImages = True
Exit Function
Resume
error:
    LoadImages = False
    Debug.Print Err.Number & ": " & Err.Description
End Function

Function NextImage()
On Error Resume Next
    NumImagenActual = NumImagenActual Mod DiccionarioImagenes.Count + 1
    ControlImagen.Picture = DiccionarioImagenes.Item(CStr(NumImagenActual))
End Function

No hay comentarios:

Publicar un comentario

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...