Module SigCJMonthCalendar.sl

     1Use DfAllEnt.pkg
     2
     3Use cSigCjMonthCalendar.pkg
     4
     5Object oSigCJMonthCalendar_Lookup is a dbModalPanel
     6    //Properties
     7    Property Integer piInvokingItem     0   
     8    Property Integer piY                0   
     9    Property Handle  phoInvokingObject  0  
    10    Property Handle  phoMonthCalendar   0
    11    Property Boolean pbShowButtons      True
    12    Property Boolean pbHideBorder       True
    13    Property Date    pdDate             0    
    14      
    15    //Settings...
    16    Set Size to 122 177
    17    Set Location     to 4 5
    18    Set Border_Style to Border_Normal
    19    Set Sysmenu_Icon to True
    20    Set Locate_Mode to Popup_Locate
    21    Set Label to "Select Date"
    22    Set button_height to 12
    23    Set button_width  to 12
    24
    25    Object oSigCJMonthCalendar is a cSigCJMonthCalendar
    26        Set Size to 100 100
    27        Set Location to 4 4
    28        Set peAnchors to anAll
    29        Set phoMonthCalendar to Self
    30                
    31        Procedure OnComSelChange DateTime llStartDate DateTime llEndDate Boolean ByRef llCancel
    32            Set pdDate to llStartDate
    33        End_Procedure
    34        
    35        Procedure OnComDblClick
    36            Send mOK
    37        End_Procedure 
    38
    39        Procedure onComMouseDown Short llButton Short llShift OLE_XPOS_PIXELS llx OLE_YPOS_PIXELS lly
    40            Set piY to lly
    41        End_Procedure
    42
    43        Procedure OnSetSize Integer iHeight Integer iWidth
    44            Integer iHt_Adj iWt_Adj 
    45
    46            // Adjust the border size 
    47            Move 12 to iHt_Adj
    48            Move 12 to iWt_Adj
    49            
    50            Set GuiSize of oSigCJMonthCalendar_Lookup to (iHeight+iHt_Adj) (iWidth+iWt_Adj)
    51            Send Position_Child_Objects
    52        End_Procedure
    53    End_Object
    54
    55    Procedure PopUp
    56        Handle  hoInvokingObject hoCalendar
    57        Integer iItem
    58        Date    dOld dNew
    59        Boolean bIsDeoControl
    60        
    61        //Get current focus object and item. If this is invoked from an object
    62        //that does not support current_item or value then this will fail
    63        Get focus to hoInvokingObject
    64        If (hoInvokingObject = 0) Begin
    65            Procedure_Return
    66        End
    67        Get Current_Item of hoInvokingObject to iItem
    68        Get value of hoInvokingObject item iItem to dOld
    69        If (not(dOld)) Begin
    70            Sysdate dOld
    71        End
    72        //Set invoking object, item and current date property values
    73        Set phoInvokingObject to hoInvokingObject
    74        Set piInvokingItem to iItem
    75        Set pdDate to dOld
    76   
    77        Set pdValue    of (phoMonthCalendar(Self)) to (pdDate(Self)) 
    78        Set pdSelEnd   of (phoMonthCalendar(Self)) to (pdDate(Self)) 
    79        Set pdSelStart of (phoMonthCalendar(Self)) to (pdDate(Self))             
    80        
    81        If (pbHideBorder(Self)) Set Caption_Bar to False
    82        Else Set Caption_Bar to True
    83     
    84        Forward Send Popup
    85    End_Procedure
    86
    87    Procedure Page_Object Boolean bPage
    88        Forward Send Page_Object bPage
    89        If (bPage) Begin     
    90            Set Icon to 'calendar_16.ico'
    91        End
    92    End_Procedure
    93    
    94    Procedure mOK
    95        Date    dNew
    96        Handle  hoInvokingObject
    97        Integer iItem
    98        Boolean bIsDeoControl
    99        
   100        Get pdDate            to dNew
   101        Get phoInvokingObject to hoInvokingObject
   102        Get piInvokingItem    to iItem
   103        Set value of hoInvokingObject item iItem to dNew
   104        Get Is_Function Get_DEO_Control_Object hoInvokingObject False to bIsDeoControl
   105        If (bIsDeoControl) Begin
   106            Set Item_Changed_State of hoInvokingObject item iItem to True             
   107        End
   108        Send close_panel
   109    End_Procedure        
   110
   111    Procedure mCancel
   112        Send Close_panel
   113    End_Procedure        
   114    
   115    Send Add_Button "O" Msg_mOk
   116    Send Add_Button "C" Msg_mCancel
   117    
   118    On_Key Key_Alt+Key_O Send mOk
   119    On_Key Key_Alt+Key_C Send mCancel
   120    On_Key Key_Enter     Send mOk
   121    On_Key Key_Escape    Send mCancel
   122
   123    Procedure Position_Child_Objects
   124        Integer iPanel_Sz 
   125        Integer iRmrgn iNo_Bn iHt iWd iCol iSpace
   126        Integer iBn_Obj iObj 
   127        Integer iWt_Adj 
   128        Boolean bShowButtons
   129        
   130        Move 0 to iSpace  // Adjustment
   131
   132        Get pbShowButtons to bShowButtons 
   133        Move (Button_ids(Current_Object)) to iObj
   134        Get Button_count to iNo_Bn
   135        Decrement iNo_Bn
   136        While (iNo_Bn >= 0)
   137            Get Integer_value of iObj item iNo_Bn to iBn_Obj
   138            Set Visible_State of iBn_Obj to bShowButtons
   139            Decrement iNo_Bn
   140        Loop            
   141
   142        Get GUISize of oSigCJMonthCalendar to iPanel_Sz
   143
   144        Move (low(iPanel_Sz)-0) to iRmrgn
   145
   146        Get Button_count to iNo_Bn
   147    
   148        If (iNo_Bn = 0) Begin
   149            Move (Hi(iPanel_Sz)) to iHt
   150        End
   151        Else Begin
   152            Move (Button_ids(Current_Object)) to iObj
   153            Get Integer_Value of iObj item 0 to iBn_Obj
   154            Get GUIsize of iBn_Obj to iHt
   155            Move (low(iHt)) to iWd
   156            Move ( hi(iHt)) to iHt
   157            
   158            If ((iRmrgn -((iWd)*iNo_Bn)) < 0 ) Begin
   159                Move 2 to iSpace
   160            End
   161            Move ( hi(iPanel_Sz) - iHt) to iHt
   162            
   163            Move (iRmrgn-iWd) to iCol
   164            Decrement iNo_Bn
   165            While (iNo_Bn >= 0)
   166                Get Integer_value of iObj item iNo_Bn to iBn_Obj
   167                If (iNo_Bn = 1) Begin
   168                    Set Bitmap of iBn_Obj to "btn-cancel_16.bmp"
   169                End
   170                If (iNo_Bn = 0) Begin
   171                    Set Bitmap of iBn_Obj to "btn-ok_16.bmp"
   172                End
   173                Set Border_Style of iBn_Obj to Border_None
   174                Set FlatState of iBn_Obj to True
   175                Set Color        of iBn_Obj to clWhite 
   176                Set GUIlocation  of iBn_Obj to iHt iCol
   177                Send Adjust_Logicals of iBn_Obj
   178                Move (iCol - iSpace - iWd)  to iCol
   179                Decrement iNo_Bn
   180            End
   181        End
   182    End_Procedure
   183    
   184End_Object
   185
   186