Module Spnfrmmx.pkg

     1//************************************************************************
     2// Confidential Trade Secret.
     3// Copyright (c) 1997 Data Access Corporation, Miami Florida
     4// as an unpublished work.  All rights reserved.
     5// DataFlex is a registered trademark of Data Access Corporation.
     6//
     7//************************************************************************
     8//
     9// 01/13/96 JJT
    10// 07/17/96 JJT - rewritten for internal button class
    11// 10/14/97 JJT - Fixed bug where spinners did not work with masked dates
    12//***************************************************************************
    13Use VDFBase.pkg
    14use Commctrl.pkg
    15
    16Class SpinForm_Mixin is a Mixin
    17
    18    { MethodType=Event Visibility=Private }
    19    Procedure Define_SpinForm_Mixin
    20        { Category=Behavior }
    21        Property Integer Minimum_Position  -32767
    22        { Category=Behavior }
    23        Property Integer Maximum_Position   32767
    24        Property Integer Current_Position   0
    25        { Visibility=Private }
    26        Property Integer Private.Wrap_State FALSE
    27        Set Form_DataType Item 0 To 0 // default to an integer form
    28        Set Wrap_State to False
    29        On_Key kUpArrow   Send DoScrollUp
    30        On_Key kDownArrow Send DoScrollDown
    31    End_procedure
    32
    33    { MethodType=Property }
    34    Function Wrap_State returns Integer
    35        Function_Return (Private.Wrap_State(self))
    36    End_Function
    37
    38    { MethodType=Property }
    39    { Category=Behavior }
    40    { PropertyType=Boolean }
    41    Procedure Set Wrap_State Integer iState
    42       Set Private.Wrap_state to iState
    43       Set Form_Button item 0 to ;
    44           ( if( iState, FORM_BUTTON_SPIN_WRAP, FORM_BUTTON_SPIN ))
    45    End_Procedure // Set Wrap_state
    46
    47    { MethodType=event Visibility=Private }
    48    Procedure Value_Spinned Integer iValue
    49        Integer iRval
    50        // First make sure this is a allowed. Attempt to give the
    51        // object the focus. Next check
    52        // shadow state. If any of these fail, do nothing.
    53        // If success, set spin value which provides ability to
    54        // translate.
    55        If (Focus(Desktop)<>self) Begin
    56           Get Msg_Activate to iRval
    57            // We check focus again. If the object is not the focus then
    58            // activation failed so we do not anything with the spinner!
    59           if (iRval OR Focus(desktop)<>self) ;
    60                 Procedure_Return
    61        End
    62        If (Shadow_State(self,0) ) ;
    63           Procedure_Return
    64        Set Spin_Value to iValue
    65        Set item_changed_State item 0 to True
    66    End_Procedure
    67
    68    // We will check for the unlikely case of a two year date.
    69    // If the data value is 2 year-ish we will assume that
    70    // we want a two year date
    71    { Visibility=Private }
    72    Function Base_Date returns Date
    73       Date dt
    74       Get Value item 0 to dt // get current date value
    75       If (dt>0 AND dt<="01/01/1000") ;
    76          sysdate dt
    77       else ;
    78          sysdate4 dt
    79       function_return dt
    80    End_Function
    81
    82    { MethodType=Property }
    83    { DesignTime=False }
    84    Procedure Set Spin_Value integer iValue
    85        Date dDate
    86        Integer iType
    87        Get form_datatype item 0 to iType
    88        If (iType=Date_Window or iType=Mask_Date_Window) Begin
    89           Get Base_Date to dDate
    90           Move (dDate +iValue) to dDate
    91           Set Value item 0 to dDate
    92        End
    93        Else Set Value Item 0 To iValue
    94    End_Procedure
    95
    96    { MethodType=Property }
    97    Function Spin_Value returns integer
    98       Integer iRval
    99       Integer dt
   100       Integer iType
   101       Get form_datatype item 0 to iType
   102       Get Value item 0 to iRval
   103       // date support. We will make all dates relative from today
   104       If (iType=Date_Window or iType=Mask_Date_Window) Begin
   105           Get Base_Date to dt
   106           If iRval ne 0 ;
   107              Move (iRval-dt) to iRval
   108       end
   109       Function_Return iRval
   110    End_function
   111
   112    { MethodType=Event Visibility=Private }
   113    Procedure Form_Button_Mouse_Down Integer Item# integer Counter
   114        Integer iValue
   115        Integer iMin
   116        Integer iMax
   117        Handle hHand
   118        Integer iStyle
   119        Integer rVal
   120        Get Minimum_Position to iMin
   121        Get Maximum_Position to iMax
   122        Get Spin_Value To iValue
   123        Set Current_Position To iValue
   124        Get Form_Button_Window_Handle item 0 to hHand
   125        if hHand Begin
   126           Move (SendMessage(hHand, UDM_SETRANGE32, iMin, iMax)) to Rval
   127           Move (SendMessage(hHand, UDM_SETPOS32, 0, iValue)) to rVal
   128        End
   129    End_Procedure
   130
   131    { MethodType=Event Visibility=Private }
   132    Procedure Form_Button_Notification integer Item# integer iPos
   133        Handle hWnd
   134        Integer iVal
   135        Get Form_Button_Window_Handle item 0 to hWnd
   136        Move (SendMessage(hWnd, UDM_GETPOS32, 0, 0) ) To iPos
   137        Get Current_Position To iVal
   138        If (iVal <> iPos) Begin
   139           Set Current_Position To iPos
   140           Send Value_Spinned iPos
   141        End
   142
   143    End_Procedure
   144
   145    // private: Used by keys. bUp means add
   146    { Visibility=Private }
   147    Procedure DoSpinOne integer bUp
   148        Integer iCurrentValue
   149        Get Spin_Value To iCurrentValue
   150        If bUp Begin
   151            Increment iCurrentValue
   152            If (iCurrentValue>Maximum_Position(self)) Begin
   153                If not (Wrap_State(self)) Procedure_return
   154                Get Minimum_Position To iCurrentValue
   155            End
   156        End
   157        Else Begin
   158            Decrement iCurrentValue
   159            If (iCurrentValue<Minimum_Position(self)) Begin
   160                If not (Wrap_State(self)) Procedure_return
   161                Get Maximum_Position To iCurrentValue
   162            End
   163        End
   164        Send Value_Spinned iCurrentValue
   165    End_Procedure // DoSpinOne
   166
   167    Procedure DoScrollDown
   168        Send DoSpinOne False
   169    End_Procedure // DoScrollDown
   170
   171    Procedure DoScrollUp
   172        Send DoSpinOne True
   173    End_Procedure // DoScrollUp
   174
   175End_Class
   176