Calendar Control - Calendar Only (Dialog)

Category: Controls - .Techniques

Date: 02-16-2022

Return to Index


 
'Primary Code:
 
UTC         - Greenwich, England
Local Time  - where the PC is located
 
 
TYPE SYSTEMTIME
  wYear      AS WORD
  wMonth     AS WORD
  wDayOfWeek AS WORD
  wDay       AS WORD
  wHour      AS WORD
  wMinute    AS WORD
  wSecond    AS WORD
  wMilliseconds AS WORD
END TYPE
 
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "commctrl.inc"
%IDC_Calendar = 500
%IDC_Date     = 501
Global hDlg,hCal,hCalendar as Dword, DT as SystemTime, OneOnly As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,400,400, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, %IDC_Date, Date$, 10,10, 120,20, %WS_Border
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y,iResult As Long, pt as Point
   Static DT As SystemTime
   Select Case Cb.msg
      Case %WM_ContextMenu
         If OneOnly=0 Then ShowCalendarDialog
   End Select
End Function
 
Sub ShowCalendarDialog()
   Local pt as Point
   GetCursorPos pt
   ScreenToClient hDlg, pt
   OneOnly = 1
   Dialog New Pixels, hDlg, "Select Date", pt.x, pt.y, 180, 155, %WS_SysMenu To hCal
   Control Add "SysMonthCal32", hCal, %IDC_Calendar, "Test", 0,0, 180,155, %WS_Child or %WS_Visible
   Control Handle hCal, %IDC_Calendar To hCalendar
   Dialog Show ModeLess hCal Call CalProc()
End Sub
 
CallBack Function CalProc() As Long
   Local iResult As Long
   Select Case CB.Msg
      Case %WM_Destroy
         OneOnly = 0
      Case %WM_Notify
         Select Case Cb.NMID
            Case %IDC_Calendar
               Select Case CB.nmcode
                  Case %MCN_Select
                     iResult = DateTime_GetSystemtime(hCalendar, DT)
                     Control Set Text hDlg, %IDC_Date, Str$(DT.wmonth) + "-" + Str$(DT.wday) + "-" +Str$(DT.wyear)
                     Dialog End hCal
               End Select
         End Select
   End Select
End Function
 
'gbs_00772
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm