'Resizable Calendar bevets 13/Nov/2004 
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/monthcal/reflist.asp 

AutoDefine "Off" 

Type SYSTIME  
   Def wYear:Word    
   Def wMonth:Word    
   Def wDayOfWeek:Word    
   Def wDay:Word    
   Def wHour:Word    
   Def wMinute:Word    
   Def wSecond:Word    
   Def wMilliseconds:Word    
EndType  

Type NMHDR 
    int hwndFrom 
    UINT idFrom 
    UINT code 
EndType 
  
Type NMDAYSTATE 
    NMHDR nmhdr 
    SYSTIME stStart 
    int cDayState 
    pointer prgDayState 
EndType 

CONST WS_VISIBLE = 0x10000000  
CONST WS_CHILD = 0x40000000 
CONST SWP_NOSIZE = 0x1 
CONST SWP_NOMOVE = 0x2 
CONST SWP_NOZORDER = 0x4 
CONST SWP_FRAMECHANGED = 0x20 
CONST SWP_NOCOPYBITS = 0x100 
CONST GMR_DAYSTATE = 1 
CONST GMR_VISIBLE = 0 
CONST MCN_FIRST = (-750) 
CONST MCN_GETDAYSTATE = (MCN_FIRST+3) 
CONST MCN_SELECT = (MCN_FIRST + 4) 
CONST MCM_FIRST = 0x1000 
CONST MCM_GETCURSEL = (MCM_FIRST + 1) 
CONST MCM_GETMONTHRANGE = (MCM_FIRST + 7) 
CONST MCM_SETDAYSTATE = (MCM_FIRST+8) 
CONST MCM_GETMINREQRECT = (MCM_FIRST + 9) 
CONST MCM_SETCOLOR = (MCM_FIRST + 10) 
CONST MCS_DAYSTATE = 0x1 
CONST MCS_WEEKNUMBERS = 0x4 
CONST MCSC_BACKGROUND = 0 
CONST MCSC_TEXT = 1 
CONST MCSC_TITLEBK = 2 
CONST MCSC_TITLETEXT = 3 
CONST MCSC_MONTHBK = 4 
CONST MCSC_TRAILINGTEXT = 5 
CONST WM_ERASEBKGND = 0x14 
CONST MCS_NOTODAY = 0x10 

declare "user32",InvalidateRect(hWnd:int,lpRect:pointer,bErase:int),int 
Declare Import,SetWindowPos(hwnd:Int,hWndInsertAfter:Int,x:Int,y:Int,cx:Int,cy:Int,wFlags:Int),Int 
Declare Import,CreateWindowExA(ex:Int,classx:String,name:String,style:Int,x:Int,y:Int,x1:Int,y1:Int,parent:Int,id:Int,hinstance:Int,ed:Int),Int  
Declare Import,DestroyWindow(hWnd:Int),Int  
Declare Import,InitCommonControlsEx(p:pointer) 

Type initcommctl 
   UInt dwSize 
   UInt dwICC 
EndType

initcommctl icex 
icex.dwICC = 0x00000100 
icex.dwSize = len(icex) 
InitCommonControlsEx(icex) 
pointer daystate,MonthRange 
Int warray[5] 
int harray[5] 
Int MyCalendar,cols,rows,x 
Window win,cwin 
WinRect crect 
Int WHICHBITS 
Int Bitarray[32] 
Bitarray[1]=1 
For x = 2 To 31:Bitarray[x]=Bitarray[x-1]*2:Next x 
WHICHBITS=Bitarray[16] | Bitarray[26] 
rows=2:cols=2 
OpenWindow win,-1000,-1000,0,0,@Caption|@SYSMenu,0,"Resizable Calendar",&mainwindow  
OpenWindow cwin,0,0,0,0,@NOCaption|@BORDER,win,"Calendar Window",&childwindow 
Menus() 
WaitUntil win=NULL 
If daystate <> NULL Then Delete daystate 
If MonthRange <> NULL Then Delete MonthRange 
End  
  
Sub mainwindow(),INT
Select @Class 
   Case @IDMENUPICK 
      If @MENUNUM = 1 
         WHICHBITS=Bitarray[1] | Bitarray[11] | Bitarray[21] 
         Int mr 
         mr=GetMonthRange(1) 
         SetBold(mr) 
         Return 0
      EndIf 
      cols=Val(Mid$(Str$(@MENUNUM),2,1))   :' number of columns 
      rows=Val(Mid$(Str$(@MENUNUM),3,1))   :' number of rows 
      SetClientSize(cwin,warray[rows],harray[cols]) 
      SetWindowPos(MyCalendar,0,0,0,warray[rows],harray[cols],SWP_FRAMECHANGED) 
      SetClientSize(win,warray[rows],harray[cols],1) 
      CenterWindow win 
   Case @IDCloseWindow 
      DestroyWindow(MyCalendar) 
      CloseWindow win 
EndSelect  
Return 0
EndSub 

Sub childwindow(),INT
Select @Class 
   Case @IDControl 
      If  @ControlID=5 
         If @notifycode = MCN_SELECT Then checkDate() 
         If @notifycode =  MCN_GETDAYSTATE 
            pointer p:int y,cDayState 
            p=*<NMDAYSTATE>@LPARAM 
            cDayState=#<NMDAYSTATE>p.cDayState 
            If daystate <> NULL Then Delete daystate 
            daystate=New(Int,cDayState) 
            'example of setting the 6th and 26th day 
            'of each month to bold 
            For y = 0 To cDayState-1 
               #<Int>daystate[y]=#<Int>daystate[y]|WHICHBITS 
            Next y 
            #<NMDAYSTATE>p.prgDayState=daystate 
         EndIf 
      EndIf 
   Case @IDCreate 
      MyCalendar=CreateWindowExA(0x0,"SysMonthCal32","",WS_VISIBLE|WS_CHILD|MCS_WEEKNUMBERS|MCS_NOTODAY|MCS_DAYSTATE,0,0,0,0,cwin.hwnd,5,0,0)  
      If ControlExists(cwin,5) 
         SendMessage(cwin,MCM_GETMINREQRECT,0,crect,5) 
         If warray[1]=0 
            int x 
            For x = 1 To 4 
               warray[x]=(crect.right*x)+(6*x)-6 
               harray[x]=(crect.bottom*x)+(11+(6*x)) 
            Next x 
         EndIf 
      Else 
         MessageBox 0,"Error creating Month Control","Oh No" 
         CloseWindow win 
      EndIf 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_BACKGROUND,RGB(175,175,175)) 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_TEXT,RGB(0,0,225)) 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_TITLEBK,RGB(046,210,50)) 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_TITLETEXT,RGB(0,0,0)) 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_MONTHBK,RGB(248,245,225)) 
      SendMessage(MyCalendar,MCM_SETCOLOR,MCSC_TRAILINGTEXT,RGB(0,225,0)) 
      SetClientSize(win,warray[rows],harray[cols],1) 
      SetClientSize(cwin,warray[rows],harray[cols]) 
      SetWindowPos(MyCalendar,0,0,0,warray[rows],harray[cols],SWP_FRAMECHANGED) 
      CenterWindow win 
EndSelect 
Return 0
EndSub 

Sub checkDate() 
   Def nowTime:String 
   Def st:SYSTIME 
   SendMessage(MyCalendar,MCM_GETCURSEL,0,st)  
   nowTime=Str$(st.wDay) + "/"+ Str$(st.wMonth)+ "/" + Str$(st.wYear) 
   MessageBox win,nowTime,"Selected Date" 
EndSub 

Sub GetMonthRange(scope:Int),Int 
   If MonthRange <> NULL Then Delete MonthRange 
   Int ret 
   MonthRange=New(SYSTIME,2) 
   ret=SendMessage(MyCalendar,MCM_GETMONTHRANGE,GMR_DAYSTATE,MonthRange) 
Return ret 
EndSub 

Sub SetBold(cDayState:Int)
   int y 
   If daystate <> NULL Then Delete daystate 
   daystate=New(Int,cDayState) 
   For y = 0 To cDayState-1 
      #<Int>daystate[y]=#<Int>daystate[y]|WHICHBITS 
   Next y 
   SendMessage(MyCalendar,MCM_SETDAYSTATE,cDayState,daystate) 
EndSub 

' Set Client Size Code 
Declare Import,AdjustWindowRectEx(rec:Pointer,style:Int,mflag:Int,ExStyle:Int),Int  
Declare Import,GetWindowLongA(hwin:Int,nIndex:Int),Int 
Declare Import,SetRect(pRect:Pointer,x1:Int,y1:Int,x2:Int,y2:Int),Int 
Const GWL_STYLE = -16 
Const GWL_EXSTYLE=-20 
Const WS_OVERLAPPED = 0x0 

Sub SetClientSize(win:Window,w:Int,h:Int,Opt fmenu=0:Int),Int 
   WINRECT rec 
   Int style,exstyle,err 
   style=0:exstyle=0:err=0 
   style=GetWindowLongA(win.hwnd,GWL_STYLE) 
   If style 
      style=style & not(WS_OVERLAPPED) 
      exstyle=GetWindowLongA(win.hwnd,GWL_EXSTYLE) 
   EndIf 
   err=SetRect(rec,0,0,w,h) 
   If err 
      err=AdjustWindowRectEx(rec,style,fmenu,exstyle) 
   If err 
      err=SetWindowPos(win.hwnd,0,0,0,rec.right+Int(ABS(rec.left)),rec.bottom+Int(ABS(rec.top)),SWP_NOMOVE) 
   EndIf 
   EndIf 
Return err 
EndSub 

Sub Menus() 
   BEGINMENU win 
      MENUTITLE "&Matrix" 
      BEGINPOPUP "1x" 
         MENUITEM "1", 0, 11 
         MENUITEM "2", 0, 12 
         MENUITEM "3", 0, 13 
         MENUITEM "4", 0, 14 
      ENDPOPUP 
      BEGINPOPUP "2x" 
         MENUITEM "1", 0, 21 
         MENUITEM "2", 0, 22 
         MENUITEM "3", 0, 23 
         MENUITEM "4", 0, 24 
         ENDPOPUP 
      BEGINPOPUP "3x" 
         MENUITEM "1", 0, 31 
         MENUITEM "2", 0, 32 
         MENUITEM "3", 0, 33 
         MENUITEM "4", 0, 34 
      ENDPOPUP 
      BEGINPOPUP "4x" 
         MENUITEM "1", 0, 41 
         MENUITEM "2", 0, 42 
         MENUITEM "3", 0, 43 
      ENDPOPUP 
  
   MENUTITLE "&SetBold" 
         MENUITEM "SetBold", 0, 1 
   ENDMENU 
EndSub