Module Dfdbmdpn.pkg

     1//
     2//  dbModalPanel with automatic button support
     3// The actual class is in dfClient.pkg (this could never be compiled without it)
     4//
     5// 11/09/95 - Modifed for a more win95 like style (not bold and
     6//            right justified).
     7
     8//
     9//  Pointer buttons used by selection-lists.
    10//    Augmented to:
    11//      1. be pointer only
    12//      2. redirect message to focus (only object is specified)
    13//      3. Set to bold font.
    14//
    15Use Windows.pkg
    16
    17{ Visibility=Private }
    18Class PointerButton is a Button
    19
    20   Procedure Construct_Object
    21     Forward Send Construct_Object
    22     set focus_mode to pointer_Only
    23   End_Procedure // Construct_Object
    24
    25   Procedure Command integer i1 integer i2
    26      Send Redirect_Message
    27   End_Procedure // Command
    28
    29   Procedure Redirect_Message returns integer
    30     integer msg obj rval
    31     Get message 0 to Msg
    32     Get Aux_Value 0 to obj
    33     if Msg get Msg of ( if(obj, obj, Focus(desktop)) ) to rval
    34     procedure_return rval
    35   End_Procedure // Redirect_Message
    36
    37End_Class
    38
    39
    40//
    41// Modal Panels that allow for resizable buttons and
    42// resizable lists. This will create buttons at the button of the client
    43// that are of equal size and equally spaced. If the list is resized the
    44// buttons are re-spaced and the list is resized to fit properly within
    45// the new bounds.
    46//
    47// To use this you must:
    48//      1. define which child object is the list_object (for resizing)
    49//      2. Create you button objects with message Add_Button:
    50//
    51//      Set List_Object to (lst_name(self))
    52//      Send Add_Button Button_text Button_Message {object id}
    53//
    54//      Properties of use:
    55//         Button_height   - height of all buttons (15)
    56//         Button_width    - width of all buttons (46)
    57//                           Note the width may be changed if the
    58//                           text will not fit. All button width's are
    59//                           raised so the buttons are always the same size.
    60//
    61//  Sample usage:
    62//
    63//  ObjecT Cust_Lkup IS A EntryModalPanel
    64//
    65//     Set Location TO 70 66
    66//     Set Size     TO 138 297  // height will get sized
    67//     Set Object_Color   TO 8192 8192
    68//     Set Value  0   TO 'Customer List'
    69//
    70//     Object sl IS A EntryLookup MAIN_FILE CUSTOMER
    71//       :
    72//     End_object
    73//
    74//     Set List_Object to (Sl(self))
    75//     Send Add_Button "OK"            MSG_Ok
    76//     Send Add_Button "Cancel"        MSG_Cancel
    77//     Send Add_Button "Help"          MSG_Help
    78//     Send Add_Button "Next Column"   MSG_Next
    79//  End_object
    80//
    81
    82
    83//  EntryModalPanel
    84
    85//{ DDOHost=True }
    86//{ DataAware=True }
    87//{ DesignerClass=cDTModalPanel }
    88//Class dbModalPanel is a dbViewFloatingPanel
    89//  Procedure Construct_Object
    90//     Forward Send Construct_Object No_Image
    91
    92//     Set Extended_Window_Style To WS_EX_DLGMODALFRAME True
    93//     Set Modal_State to TRUE
    94
    95//     { Obsolete=True }
    96//     Property Integer List_Object  0
    97
    98//     { Obsolete=True }
    99//     Property Integer button_height     14
   100//     { Obsolete=True }
   101//     Property Integer button_width      50
   102
   103//     { Visibility=Private Obsolete=True }
   104//     Property Integer Max_Text_Extent   0
   105
   106//     Object Button_Ids is an array
   107//     End_Object // Button_Ids
   108//  End_Procedure // Construct_Object
   109
   110//  { MethodType=Property Visibility=Private Obsolete=True }
   111//  Function Button_Count returns integer
   112//     Function_Return (Item_count(Button_Ids))
   113//  End_Function // Button_Count
   114
   115//  { Obsolete=True }
   116//  Procedure Add_Button string sLabel integer hMsg integer hoTo
   117//     integer hoBtn tx
   118//      8.2 - use newer syntax for creating dynamic objects
   119//     Get Create U_PointerButton to hoBtn
   120//     set peAnchors of hoBtn to anBottomRight
   121//     Set Value of hoBtn 0 to sLabel
   122//     Set Message of hoBtn 0 to hMsg
   123//     If (Num_Arguments>2) ;
   124//         Set aux_value of hoBtn 0 to hoTo
   125//     get Text_Extent of hoBtn sLabel to tx
   126//     Move (low(tx)) to tx
   127//     Set Array_Value of Button_Ids (Button_Count(self)) to hoBtn
   128//     if (tx > Max_Text_Extent(self));
   129//          Set Max_Text_Extent to tx
   130//  End_Procedure // Add_Button
   131
   132//  { Visibility=Private Obsolete=True }
   133//  Procedure Size_Buttons
   134//     integer bheight bwidth nb obj Bobj bt mt gsiz gwd
   135
   136//     Get button_height to bheight
   137//     Get button_width  to bwidth
   138//     Get Button_count to nb
   139//     decrement nb
   140
   141//     Move Button_ids to obj
   142
   143//     For bt from 0 to nb
   144//         Get integer_value of obj bt to bobj // button id
   145//         Set Size of bobj to bheight bwidth       // set dflt size
   146//         If bt eq 0 Begin
   147//            get Max_Text_Extent to mt
   148//            Add 8 to mt
   149//            get guisize of bobj to gsiz
   150//            Move (low(gsiz)) to gwd
   151//            if gwd lt mt Begin
   152//               set guisize of bobj to (hi(gsiz)) mt
   153//               send adjust_logicals to bobj
   154//               Move (low(size(bobj))) to bwidth
   155//               Set Button_width to bwidth
   156//            end
   157//         end
   158//     Loop
   159//  End_Procedure // Size_Buttons
   160
   161//  { Visibility=Private Obsolete=True }
   162//  Procedure Position_Child_Objects
   163//     integer lsz psz wd pwd ht llc nb mt bobj obj cht col bt list_obj
   164//     integer rmrgn swd
   165
   166//     If (caption_bar(self)) ;
   167//        Move (Hi(Physical_fontsize(self))+4+6) to cht
   168//     Else move 0 to cht
   169
   170//     get GUISize to psz               // size of panel
   171//     Get List_Object to List_obj      // id of the list object
   172//     If list_obj Begin
   173//        get GUISize of list_obj to lSz
   174//        get GUIlocation of list_obj to llc
   175//        Move (low(llc)+low(lsz)+2) to rmrgn
   176//     End
   177//     else Move (low(psz)-8) to rmrgn
   178
   179//     Get Button_count to nb        // number of buttons
   180
   181//     if nb eq 0 ;
   182//        Move ( hi(psz) - 4 - cht - 8) to ht
   183//     Else Begin
   184//        Move Button_ids to obj
   185//        Get integer_value of obj 0 to bobj
   186//        get guisize of bobj to ht
   187//        Move (low(ht)) to wd
   188//        Move ( hi(ht)) to ht
   189//        Move 8 to swd // width of each space
   190//        if ( (rmrgn - ((wd+swd)*nb-swd)) < 0 ) ;
   191//           Move 2 to swd
   192//        Move ( hi(psz) - ht - 4 - cht - 8) to ht
   193
   194//        Move (rmrgn-wd) to col
   195//        decrement nb
   196//        While nb ge 0
   197//          Get integer_value of obj nb to bobj
   198//          Set GUIlocation of bobj to ht col
   199//          Send Adjust_Logicals to bobj
   200//          Move (col - swd - wd) to col
   201//          decrement nb
   202//        end
   203//     End
   204
   205//     If list_obj Begin
   206//        get GUISize of list_obj to lSz
   207//        **get fx_GUISize of list_obj to lSz
   208//        get GUIlocation of list_obj to llc
   209//        Move ( ht - Hi(llc) - 12 ) to ht
   210//        Set GUIsize of list_obj to ht (low(lsz))
   211//        Send Adjust_Logicals to list_obj
   212//     End
   213//  End_Procedure
   214
   215//  Procedure End_Construct_Object
   216//     Send Size_Buttons
   217//     Send Position_Child_Objects
   218//     Forward Send end_construct_object
   219//  end_Procedure
   220
   221//  { Obsolete=True }
   222//  Procedure Search
   223//     integer Obj#
   224//     Get List_Object to obj#
   225//     If Obj# Send Search to Obj#
   226//  End_Procedure // Search
   227//End_Class
   228
   229