home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sendun1a / frmfecha.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-20  |  2.9 KB  |  97 lines
  1. VERSION 5.00
  2. Begin VB.Form SysCal 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "Fecha"
  5.    ClientHeight    =   2340
  6.    ClientLeft      =   5985
  7.    ClientTop       =   4275
  8.    ClientWidth     =   4470
  9.    LinkTopic       =   "Form1"
  10.    LockControls    =   -1  'True
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   156
  15.    ScaleMode       =   3  'P
  16.    ScaleWidth      =   298
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   1  'CenterOwner
  19.    Begin VB.CommandButton cbtAceptar 
  20.       Caption         =   "&Aceptar"
  21.       Height          =   375
  22.       Left            =   3180
  23.       TabIndex        =   1
  24.       Top             =   90
  25.       Width           =   1215
  26.    End
  27.    Begin VB.CommandButton cmdOK 
  28.       Caption         =   "OK"
  29.       Height          =   372
  30.       Left            =   5445
  31.       TabIndex        =   0
  32.       Top             =   2895
  33.       Width           =   1212
  34.    End
  35. Attribute VB_Name = "SysCal"
  36. Attribute VB_GlobalNameSpace = False
  37. Attribute VB_Creatable = False
  38. Attribute VB_PredeclaredId = True
  39. Attribute VB_Exposed = False
  40. Dim Calendar As CSysMonthCal32
  41. Private Const H_MAX As Long = &HFFFF + 1
  42. Const DTN_FIRST = (H_MAX - 760&)
  43. Const DTN_DATETIMECHANGE = (DTN_FIRST + 1)
  44. Private Sub cbtAceptar_Click()
  45.     cmdOK_Click
  46. End Sub
  47. Public Sub cmdOK_Click()
  48.     Me.Hide
  49.     Unload Me
  50. End Sub
  51. Private Sub Form_Load()
  52.      
  53.     'Me.Width = 2775
  54.     Me.Height = 2670
  55.     Set Calendar = New CSysMonthCal32
  56.     With Calendar
  57.         Set .Parent = Me
  58.          
  59.         .Create
  60.         
  61.     End With
  62.     Me.Caption = Format$(Calendar.GetCalendarDate, "LONG DATE")
  63.     stFecha = Format$(Now, "dd-mm-yyyy")
  64.     SubClass Me.hWnd
  65. End Sub
  66. Private Sub Form_Unload(Cancel As Integer)
  67.     UnSubClass
  68. End Sub
  69. Public Sub ProcMsg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Result As Long)
  70.     Dim hdrX As NMHDRCAL
  71.     On Error Resume Next
  72.     Select Case uMsg
  73.         Case WM_NOTIFY
  74.             CopyMemory hdrX, ByVal lParam, Len(hdrX)
  75.             'si es el form, se obtiene la fecha
  76.             If hdrX.hwndFrom = Calendar.hWnd Or hdrX.code = DTN_DATETIMECHANGE Then
  77.                 
  78.                 stFecha = Format$(Calendar.GetCalendarDate, "dd-mm-yyyy")
  79.                 
  80.                 Me.Caption = Format$(Calendar.GetCalendarDate, "Long Date")
  81.                 
  82.             End If
  83.     End Select
  84. End Sub
  85. Private Sub SubClass(hWnd As Long)
  86.     On Error Resume Next
  87.     NextProcs = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
  88. End Sub
  89. Private Sub UnSubClass()
  90.     Dim hWndCur As Long
  91.     hWndCur = Me.hWnd
  92.     If NextProcs Then
  93.         SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
  94.         NextProcs = 0
  95.     End If
  96. End Sub
  97.