Colabora: Capturar fechas Emilio Gordo Lima

GetDate
Capturar fechas de un calendario

Fecha: 03/Feb/99 (03/Dic/98)
Autor: Emilio Gordo Lima < [email protected] >

Te envio un ZIP con un modulillo que me parece interesante, para capturar fechas con un calendario, en vez de tener que teclearlas.
La explicacion de que hace y como, esta en un fichero de Word dentro del ZIP

Gracias ;)

Taluegop

Salu2

Emilio Gordo Lima
Systra Development S.L. - Dpto. Desarrollo
[email protected]

La explicaciï¿½n:

Se trata de un formulario que actua como calendario para introducir fechas. Necesita el control MSCAL.OCX que viene con Access 97.

Incluye el formulario propiamente dicho, y un modulo con el codigo necesario. Una vez incluidos ambos en el proyecto, el funcionamiento es simple. En cualquier caja de texto se coloca este codigo, en por ejemplo KeyDown:

Private Sub TxtFecha_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyF5 Then

TxtFecha.Text = GetDate.GetDate(TxtFecha, 4, 2)

End If

End Sub

Y ya ta! ;)

Te incluyo un pequeï¿½o proyecto de prueba para demostra el furrule ;)

Por cierto, dentro del modulo BAS hay una funcion basante interesante (creo) para transformar coordenadas de ventana cliente a coordenadas de pantalla ;)

Un saludo, y gracias por tu pagina, y por ponernoslo facil a los demas ;)

Taluegop

El cï¿½digo: (sï¿½lo el modulo BAS GetDate, el resto lo tienes en el Zip con el cï¿½digo)

'
Option Explicit
' Modulo de GetDate
' *****************************************************************
' * Puedes utilizar este mï¿½dulo, y su formulario correspondiente  *
' * como mas te plazca. Solo te pido que mantengas estas lineas   *
' * y que si cambias algo, lo pongas aqui. Asi mismo, si haces    *
' * alguna modificaciï¿½n interesante y que creas que puede mejorar *
' * el funcionamineto, te agradeceria me lo comunicaras y me      *
' * mandaras el cï¿½digo                                            *
' *****************************************************************
' * Last Revision : Oct 10 , 1998                                 *
' * @ Emilio Gordo Lima                                           *
' *****************************************************************

' La funcion eglClientToScreen se utiliza para obtener coordenadas
' x/y correspondientes al objeto Screen a partir de coordenadas X/Y
' de cliente.
' De todas formas no es necesario, si no necesitas que el calendario
' aparezca pegado al control que lo llama


Type POINTAPI ' 8 Bytes
        X As Long
        Y As Long
End Type

Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Function GetDate(Optional ctl As Control, Optional Position As Integer, Optional Align As Integer) As String
' Ctl : El control al que hay que pegar el calendario
' Position: Si se pasa CTL, la esquina del control:
'           1 - Arriba izquierda
'           2 - Arriba derecha
'           3 - Abajo izquierda
'           4 - Abajo derecha
' Align:    Si se pasa CTL, la esquina del calendario que hay que usar para alinear
'           1 - Esquina superior izquierda
'           2 - esquina superior derecha
'           3 - esquina inferior izquierda
'           4 - esquina inferior derecha
' Esta funciï¿½n presupone que el formulario FRMCALENDARIO existe en el proyecto

Dim X As Long
Dim Y As Long

    Load frmCalendario
    
    If IsMissing(ctl) Then
        ' se centra en la pantalla
        X = (Screen.TwipsPerPixelX * Screen.Width) / 2
        Y = (Screen.TwipsPerPixelY * Screen.Height) / 2
        frmCalendario.Left = X - (frmCalendario.Width / 2)
        frmCalendario.Top = Y - (frmCalendario.Height / 2)
        
    Else
        If Not (IsMissing(Position)) Then
            Select Case Position
                Case 1 ' Arriba izquierda
                    X = 0: Y = 0
                Case 2 ' arriba derecha
                    X = ctl.Width: Y = 0
                Case 3 ' abajo izquierda
                    X = 0: Y = ctl.Height
                Case 4
                    X = ctl.Width: Y = ctl.Height
            End Select
        End If
        eglClientToScreen ctl, X, Y
        If Not (IsMissing(Align)) Then
            Select Case Align
                ' Case 1 se trata como case else
                Case 2 ' superior derecha
                    frmCalendario.Left = X - frmCalendario.Width
                    frmCalendario.Top = Y
                Case 3 ' inferior izquierda
                    frmCalendario.Left = X
                    frmCalendario.Top = Y - frmCalendario.Height
                Case 4 ' inferior derecha
                    frmCalendario.Left = X - frmCalendario.Width
                    frmCalendario.Top = Y - frmCalendario.Height
                Case Else
                    frmCalendario.Left = X
                    frmCalendario.Top = Y
            End Select
        Else ' si no se especifica, se cuadra con la esquina superior izquierda
            frmCalendario.Left = X
            frmCalendario.Top = Y
        End If
    End If
    
    frmCalendario.Show 1
    GetDate = frmCalendario.Value
    Unload frmCalendario
    
End Function

Public Sub eglClientToScreen(ctl As Control, X As Long, Y As Long)
Dim lpPointApi As POINTAPI
Dim RetVal As Long

' X en twips
' y en twips
        
' Se transforman las coordenadas en pixels
    lpPointApi.X = X / Screen.TwipsPerPixelX
    lpPointApi.Y = Y / Screen.TwipsPerPixelY
        
    RetVal = ClientToScreen(ctl.hWnd, lpPointApi)
    
    If RetVal <> 0 Then
        ' se pasan las coordenadas devueltas a twips
        X = Screen.TwipsPerPixelX * lpPointApi.X
        Y = Screen.TwipsPerPixelY * lpPointApi.Y
    End If

End Sub

Fichero con el cï¿½digo de ejemplo (getdate_emilio.zip 6.78 KB)