GetDate
Capturar fechas de un calendario
Fecha: 03/Feb/99 (03/Dic/98)
Autor: Emilio Gordo Lima < emilio@systra.es >
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
emilio@systra.es
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)