home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / kpwdemo.zip / DESOBJ.SRC < prev    next >
Text File  |  1990-06-28  |  11KB  |  361 lines

  1. (*================ OBJECT CLASS DESCRIPTION AND METHODS =================== *)
  2.  
  3. topic Object.
  4.   HandleList gets ?handle.
  5.   ObjectList gets concat (Object,?Number).
  6.   Number is ?Number+1.
  7.   current is ?handle.
  8.   set_focus (?handle).   
  9.  
  10.   topic EventTopic (i,e,h,ins).
  11.      if ?e is sys_char_event
  12.          then sys_char_event ()
  13.          else current is ?h and
  14.                  (if one_of (['Horizontal Scroll','Vertical Scroll'],?type)
  15.               then set_focus (?h) ).
  16.  
  17.     topic sys_char_event.
  18.        if ?i is 'CTRL Home'
  19.            then column is (?column+0.5) DIV 1and
  20.                     row is (?row +0.5) DIV 1 and
  21.                     (if ?type is 'Edit Line' then row is ?row - 0.2) and
  22.                    move_window (?h,?column,?row) 
  23.            else ins is element ([ [column,-1],[column,1],[row,1],[row,-1],
  24.                                               [column,-0.25],[column,0.25],[row,0.25],[row,-0.25] ],
  25.                         where (['CTRL left','CTRL Right','CTRL Down','CTRL Up',
  26.                              'CTRL SHIFT Left','CTRL SHIFT RIght','CTRL SHIFT Down','CTRL SHIFT Up'],?i)) and
  27.                     (if ?ins <> []
  28.                 then first (?ins) is ?first (?ins) + Last (?ins) and
  29.                         move_window (?h,?column,?row) ).
  30.     end.                 
  31.  
  32.   end. (* EventTopic *)
  33.  
  34.   topic newPosition (item).
  35.     item is TwoEdLn ('
  36.   Column:
  37.    
  38.   Row: ',?column,?row).
  39.     setPosition (first (?item),last (?item)).
  40.   end.
  41.  
  42.   topic setPosition (c,r).
  43.     move_window (?handle,?c,?r).
  44.     column is ?c.
  45.     row is ?r.
  46.     set_focus (?handle).
  47.   end.
  48.  
  49.   topic newSize (item).
  50.     item is TwoEdLn ('
  51.   Width:
  52.    
  53.   Height: ',?width,?height).
  54.     width is first (?item).
  55.     height is last (?item).
  56.     resize_window (?handle,?width,?height).
  57.   end.
  58.  
  59. end. (* Object *)
  60.  
  61.  
  62. (* ======================= END OF OBJECT DESCRIPTION ================== *)
  63.  
  64.  
  65. (* %%%%%%%%%%%%%%%%%%%%%% SUB-CLASSES OF OBJECTS %%%%%%%%%%%%%%%%%%%%%% *)
  66.  
  67. topic &Button.
  68.   :name is OneEdLn ('
  69.   Name:').
  70.   if ?name is '' then name is text.
  71.   :width is  string_length (?name + 3).
  72.   [:handle, :type, :column, :row, :width] is_c [ , Button, 1, 1].
  73.   CreateNew ().
  74.   im_a (Object).
  75.  
  76.   topic CreateNew.
  77.     handle is button (?name,concat (Object,?Number,':EventTopic'),?column,?row,?width,,[select_event,sys_char_event]).
  78.   end.   
  79.  
  80.   topic MakeCode.
  81.     code gets concat ('button (',list_to_string (?name,,,,''''),',(* eventTopic *),',?column,',',?row,',',?width,').').
  82.   end.
  83.  
  84.   topic newName.
  85.     name is OneEdLn ('
  86.   Name:',?name).
  87.     set_text (?handle,?name).
  88.     if string_length (?name) + 3 > ?width
  89.        then width is string_length (?name) + 3 and
  90.                resize_window (?handle,?width,2).
  91.   end.
  92.  
  93.   topic newSize.
  94.      width is OneEdLn ('
  95.   Width:',?width).  
  96.      resize_window (?handle,?width,2).
  97.   end.
  98.  
  99. end. (* Button *)
  100.  
  101. topic '&Check Box'.
  102.   :name is OneEdLn ('
  103.   Name:').
  104.   if ?name is '' then name is text.
  105.   [ :handle, :type, :column, :row]  is_c [ , 'Check Box', 1, 1] .
  106.   CreateNew ().
  107.   im_a (Object).
  108.  
  109.   topic CreateNew.
  110.     handle is check_box (?name,concat (Object,?Number,':EventTopic'),?column,?row,,[select_event,sys_char_event]).
  111.   end.   
  112.  
  113.   topic MakeCode.
  114.     code gets concat ('check_box (',list_to_string (?name,,,,''''),',(* eventTopic *),',?column,',',?row,').').
  115.   end.
  116.  
  117.   topic newName.
  118.     name is OneEdLn ('
  119.   Name:',?name).
  120.     set_text (?handle,?name).
  121.     width is string_length (?name) + 3 and
  122.                resize_window (?handle,?width,1.1).
  123.   end.
  124.  
  125.   topic newSize.
  126.     message ( '
  127.     The size of  check boxes
  128.         cannot  be changed.
  129.  ').  
  130.   end.
  131.  
  132. end. (* check box *)
  133.  
  134. topic '&Radio Button' .
  135.   [ :name, :width, :radioList, :handle, :column, :row, :orient, :space, : type] is_c
  136.                  [ , , , , 1, 1, vertical, 1.5, 'Radio Button'].
  137.   getSetup (,vertical,1.5).
  138.   CreateNew (?Number).
  139.   im_a (Object).
  140.  
  141.   topic getSetup (n,o,s,ed1,ed2,v,h).
  142.     window (,40,13,40,13,,[Popupwindow,TitleBar]).
  143.     text ('
  144.   Names:#x20Orientation:
  145.  
  146.  
  147.  
  148.  
  149. #x20Spacing:').
  150.     ed1 is edit_box (?n,,3,3.5,15,5).
  151.     if ?o is vertical then v is t and h is false
  152.                              else v is f and h is true.
  153.     radio_button ([[Vertical,22,3.5,?v],[Horizontal,22,5,?h]],orient).
  154.     ed2 is edit_line (?s,,30,6.8,6).
  155.     button (Continue,continue,17,9.5).
  156.     show_window ().
  157.     set_focus (?ed1).
  158.     wait (). 
  159.     name is replace (get_text (?ed1),'',,100).
  160.     if ?name is ''
  161.        then name is [radio1,radio2,radio3].
  162.     space is get_text (?ed2).
  163.     hide_window ().
  164.     close_window ().
  165.     MakeList (?name,1,1). 
  166.   end. (* setup radio buttons *)
  167.  
  168.   topic MakeList (n,c,r).
  169.      radioList is [].
  170.      while ?n <> []
  171.         then radioList gets [[first (?n),?c,?r]] and
  172.                (if ?orient is vertical then r is string_copy (?r+?space,1,5) else c is string_copy (?c+3+string_length (first (?n))+?space,1,5)) and
  173.                n is rest (?n).
  174.     if ?orient is vertical
  175.         then width is last (numeric_sort (string_length (?name)))+4
  176.         else width is ?c-?space.
  177.   end.
  178.  
  179.   topic orient (item).
  180.     orient is ?item.
  181.   end.
  182.  
  183.   topic CreateNew (N,lastbutton).
  184.     lastButton is last (?radioList).
  185.     handle is window (concat (Object,?N,':EventTopic'),?column,?row,?width,last (?lastButton) + 1,,
  186.                    [child,showChildren,Siblings,visible],?WindowHandle,,,[sys_char_event,get_focus_event]).
  187.     radio_button (?radioList,concat (Object,?N,':RadioEvent'),[select_event,get_focus_event,sys_char_event,char_event]).
  188.     set_display_window (?WindowHandle).
  189.   end.   
  190.  
  191.   topic RadioEvent (i,e).
  192.     RadioEvent is t.
  193.     EventTopic (?i,?e,?handle).
  194.   end.
  195.  
  196.   topic MakeCode (n,c,r).
  197.      [n,c,r] is_c [?name,?column,?row].
  198.      rList is [].
  199.      
  200.      while ?n <> []
  201.         then rList gets [[first (?n),?c,?r]] and
  202.                (if ?orient is vertical then r is string_copy (?r+?space,1,5) else c is string_copy (?c+3+string_length (first (?n))+?space,1,5)) and
  203.                n is rest (?n).
  204.     if ?orient is vertical
  205.         then w is last (numeric_sort (string_length (?name)))+3
  206.         else w is ?c-?space.
  207.     code gets concat ('radio_button (',list_to_string (?rList,',','[',']',''''),', (* eventTopic *)).').
  208.   end.
  209.  
  210.   topic newName.
  211.      newSize ().
  212.   end.
  213.  
  214.   topic newSize (oldHandle).
  215.     getSetup (?name,?orient,?space).
  216.     oldHandle is ?handle.
  217.     close_window (?handle).
  218.     CreateNew (where (?handleList,?oldHandle)).
  219.     handleList is replace (?HandleList,?oldHandle,?Handle).    
  220.     current is ?handle.
  221.   end.
  222.  
  223. end. (* radio button *)
  224.  
  225. topic '&Edit Line'.
  226.   :width is OneEdLn ('
  227.   Width:',12).
  228.   [ :handle, :type, :name, :column, :row]  is_c  [ , 'Edit Line', , 1, 1.5].
  229.   CreateNew ().
  230.   im_a (Object).
  231.  
  232.   topic CreateNew.
  233.     handle is edit_line (?name,concat (Object,?Number,':EventTopic'),
  234.             ?column,?row,?width,[get_focus_event,sys_char_event]).
  235.   end.   
  236.  
  237.   topic MakeCode.
  238.     code gets concat ('edit_line (',list_to_string (?name,,,,''''),',(* eventTopic *),',?column,',',?row,',',?width,').').
  239.   end.
  240.  
  241.   topic newName.
  242.     name is OneEdLn ('
  243.   Text:').
  244.     set_text (?handle,?name).
  245.   end.
  246.  
  247.   topic newSize.
  248.     width is OneEdLn ('
  249.   Width:',?width).
  250.      resize_window (?handle,?width,1.5).
  251.   end.
  252.  
  253. end. (* Edit Line *)
  254.  
  255. topic 'Edit Bo&x' (item).
  256.   item is TwoEdLn ('
  257.   Width:
  258.  
  259.   Height:',12,5).
  260.   :width is first (?item).
  261.   :height is last (?item).
  262.   [:handle, :type, :name, :column, :row] is_c [ , 'Edit Box', , 1, 1].
  263.   CreateNew ().
  264.   im_a (Object).
  265.  
  266.   topic CreateNew.
  267.     handle is edit_box (?name,concat (Object,?Number,':EventTopic'),?column,?row,?width,?height,,
  268.         [get_focus_event,sys_char_event]).
  269.   end.   
  270.  
  271.   topic MakeCode.
  272.     code gets concat ('edit_box (',list_to_string (?name,,,,''''),',(* eventTopic *),',?column,',',?row,',',?width,',',?height,').').
  273.   end.
  274.  
  275.   topic newName.
  276.     name is OneEdBx ('
  277.   Text:',?name).
  278.     set_text (?handle,?name).
  279.   end.
  280.  
  281. end. (* Edit Box *)
  282.  
  283. topic '&List Box'.
  284.   :name is OneEdBx ('
  285.   Items:').
  286.   if ?name is ''
  287.      then name is [item1,item2,item3,item4]
  288.      else name is replace (?name,'',,100).
  289.   :width is last (numeric_sort (string_length (?name)))+3.
  290.   :height is list_length (?name).
  291.   [ :handle, :type, :column, :row]  is_c [ , 'List Box', 1, 1].
  292.   CreateNew ().
  293.   im_a (Object).
  294.  
  295.   topic CreateNew.
  296.     handle is list_box (?name,concat (Object,?Number,':EventTopic'),?column,?row,?width,?height,,,
  297.           [get_focus_event,sys_char_event]).
  298.   end.   
  299.  
  300.   topic MakeCode.
  301.     code gets concat ('list_box (',list_to_string (?name,',','[',']',''''),',(* eventTopic *),',?column,',',?row,',',?width,',',?height,').').
  302.   end.
  303.  
  304.   topic newName.
  305.     name is OneEdBx ('
  306.   Items:',?name).
  307.     set_text (?handle,?name).
  308.     if list_length (?name) < ?height
  309.         then height = list_length (?name)  and
  310.                 resize_window (?handle,?width,?height).
  311.   end.
  312.  
  313. end. (* list box *)
  314.  
  315. topic '&Horizontal Scroll Bar'.
  316.   :width is OneEdLn ('
  317.   Width:',15).
  318.   [ :handle, :type, :name, :column, :row, :height]  is_c [ , 'Horz Scroll Bar', , 1, 1, 1].
  319.   CreateNew ().
  320.   im_a (Object).
  321.  
  322.   topic CreateNew.
  323.     handle is horz_scroll_bar (concat (Object,?Number,':EventTopic'),?column,?row,?width,?height,,,[get_focus_event,sys_char_event,scroll_event]).
  324.   end.   
  325.  
  326.   topic MakeCode.
  327.     code gets concat ('horz_scroll_bar ((* eventTopic *),',?column,',',?row,',',?width,',',?height,',0,100).').
  328.   end.
  329.  
  330.   topic newName.
  331.     message ( '
  332.        There is no name on
  333.               scroll bars. ').  
  334.   end.
  335.  
  336. end. (* horz scroll *)
  337.  
  338. topic '&Vertical Scroll Bar'.
  339.   :height is OneEdLn ('
  340.   Height:',7).
  341.   [ :handle, :type, :name, :column, :row, :width]  is_c [ ,'Vert Scroll Bar',  , 1,1, 2].
  342.   CreateNew ().
  343.   im_a (Object).
  344.  
  345.   topic CreateNew.
  346.     handle is vert_scroll_bar (concat (Object,?Number,':EventTopic'),?column,?row,?width,?height,,,[sys_char_event,scroll_event,get_focus_event]).
  347.   end.   
  348.  
  349.   topic MakeCode.
  350.     code gets concat ('vert_scroll_bar ((* eventTopic *),',?column,',',?row,',',?width,',',?height,',0,100).').
  351.   end.
  352.  
  353.   topic newName.
  354.     message ( '
  355.        There is no name on
  356.               scroll bars. ').  
  357.   end.
  358.  
  359. end. (* vertical scroll *)
  360.  
  361. (* %%%%%%%%%%%%%%%%%%%%%% END OF SUB-CLASSES %%%%%%%%%%%%%%%%%%%%%%%%%% *)