home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / pdial / demos / modelss2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-10  |  8.3 KB  |  334 lines
  1. program modeless;
  2.  
  3. uses gem, geminit, newobs, pform, tools;
  4.  
  5. (*$I modelss2.i*)
  6.  
  7. type
  8.     FORMULAR    =    record
  9.                         w_handle    :    integer;
  10.                         tree        :    AESTreePtr;
  11.                         editobj    :    integer;
  12.                         idx        :    integer;
  13.                     end;    
  14.  
  15. var
  16.     menuptr            :    AESTreePtr;
  17.     leave                :    boolean;
  18.     buffer            :    ARRAY_8;
  19.     ret                :    integer;
  20.     oldtxt            :    string;
  21.     events            :    EVENT;
  22.     which                :    integer;
  23.     form_about,
  24.     form_test    :    FORMULAR;
  25.     
  26. (***********************************************************************)
  27. (* unmodale Fenster-Dialoge                                            *)
  28. (***********************************************************************)
  29. function rc_intersect(var p1, p2: GRECT): boolean;
  30. var
  31.    tw, th, tx, ty :  integer;
  32. begin
  33.    tw := min(p1.g_x + p1.g_w, p2.g_x + p2.g_w);
  34.    th := min(p1.g_y + p1.g_h, p2.g_y + p2.g_h);
  35.    tx := max(p1.g_x, p2.g_x);
  36.    ty := max(p1.g_y, p2.g_y);
  37.  
  38.    p2.g_x := tx;
  39.    p2.g_y := ty;
  40.    p2.g_w := tw - tx;
  41.    p2.g_h := th - ty;
  42.    rc_intersect := (tw > tx) and (th > ty);
  43. end;
  44.  
  45. procedure do_redraw(wh: integer; area: GRECT; tree: AESTreePtr);
  46. var
  47.    box, full: GRECT;
  48. begin
  49.    graf_mouse(M_OFF, NIL);
  50.    wind_update(BEG_UPDATE);
  51.    with full do
  52.       wind_get(0, WF_WORKXYWH, g_x, g_y, g_w, g_h);
  53.     with box do
  54.       wind_get(wh, WF_FIRSTXYWH, g_x, g_y, g_w, g_h);      
  55.    while (box.g_w > 0) and (box.g_h > 0) do
  56.    begin
  57.       if rc_intersect(full, box) then
  58.           if rc_intersect(area, box) then
  59.           begin
  60.               with box do
  61.                   objc_draw(tree, ROOT, MAX_DEPTH, g_x, g_y, g_w, g_h);
  62.           end;        
  63.       with box do
  64.          wind_get(wh, WF_NEXTXYWH, g_x, g_y, g_w, g_h);
  65.    end;
  66.    wind_update(END_UPDATE);
  67.    graf_mouse(M_ON, NIL);
  68. end;
  69.  
  70. function open_winddial(var form: FORMULAR; title: pchar): boolean;
  71. var
  72.     elements :    integer;
  73.     inside, outside    :    GRECT;
  74. begin
  75.     if title^ <> #0 then
  76.         elements    :=    NAME + MOVER
  77.     else
  78.         elements := MOVER;
  79.     open_winddial := TRUE;    
  80.     with inside do 
  81.         pform_center(form.tree, g_x, g_y, g_w, g_h);
  82.     with outside do
  83.     begin
  84.         wind_get(0, WF_WORKXYWH, g_x, g_y, g_w, g_h);
  85.         form.w_handle := wind_create(elements, g_x, g_y, g_w, g_h);
  86.     end;
  87.     if title^ <> #0 then    
  88.         wind_set(form.w_handle, WF_NAME, hiword(longint(title)), 
  89.                  loword(longint(title)), 0, 0);
  90.     if form.w_handle < 0 then
  91.     begin
  92.         open_winddial := FALSE;
  93.         exit;
  94.     end;
  95.     with outside do
  96.         wind_calc(WC_BORDER, elements, form.tree^[ROOT].ob_x, 
  97.                      form.tree^[ROOT].ob_y, form.tree^[ROOT].ob_width,
  98.                      form.tree^[ROOT].ob_height, 
  99.                   g_x, g_y, g_w, g_h);
  100.     with outside do    
  101.         if wind_open(form.w_handle, g_x, g_y, g_w, g_h) = 0 then
  102.         begin
  103.             open_winddial := FALSE;
  104.             exit;
  105.         end;    
  106.     form.editobj := ini_field(form.tree, form.editobj);
  107.     if form.editobj <> 0 then
  108.         objc_ed(form.tree, form.editobj, 0, form.idx, EDINIT);    
  109. end;    
  110.  
  111. function pform_win(var form: FORMULAR): integer;
  112. var
  113.     topwind    :    integer;    
  114.     dummy        :    integer;
  115.     box        :    GRECT;
  116.     pipe        :    ARRAY_8;
  117. begin 
  118.     pipe[1] := AES_pb.global^[2];    
  119.  
  120.     if (which and MU_MESAG) <> 0 then 
  121.         with events do
  122.         begin
  123.             box.g_x := ev_mmgpbuf[4];
  124.             box.g_y := ev_mmgpbuf[5];
  125.             box.g_w := ev_mmgpbuf[6];
  126.             box.g_h := ev_mmgpbuf[7];
  127.             case events.ev_mmgpbuf[0] of
  128.                 WM_MOVED:
  129.                     if form.w_handle = ev_mmgpbuf[3] then
  130.                     begin
  131.                         wind_set(form.w_handle, WF_CURRXYWH, ev_mmgpbuf[4], 
  132.                             ev_mmgpbuf[5], ev_mmgpbuf[6], ev_mmgpbuf[7]);
  133.                         with form.tree^[ROOT] do
  134.                             wind_get(form.w_handle, WF_WORKXYWH, ob_x, ob_y,
  135.                                 ob_width, ob_height);
  136.                     end;                                
  137.                 WM_REDRAW:
  138.                     if form.w_handle = ev_mmgpbuf[3] then
  139.                         begin
  140.                             wind_get(0, WF_TOP, topwind, dummy, dummy, dummy);
  141.                             if (form.editobj <> 0) and 
  142.                                 (topwind = form.w_handle) then
  143.                             begin
  144.                                 with form.tree^[ROOT] do
  145.                                     objc_draw(form.tree, ROOT, MAX_DEPTH, 
  146.                                               ob_x, ob_y, ob_width, ob_height);
  147.                                 objc_ed(form.tree, form.editobj, 0, 
  148.                                         form.idx, EDINIT);
  149.                             end
  150.                             else    
  151.                                 do_redraw(ev_mmgpbuf[3], box, form.tree);
  152.                         end;        
  153.                         
  154.                      
  155.                 WM_TOPPED:
  156.                     if form.w_handle = ev_mmgpbuf[3] then
  157.                     begin
  158.                         wind_set(form.w_handle, WF_TOP, 0, 0, 0, 0);
  159.                         wind_get(0, WF_TOP, topwind, dummy, dummy, dummy);
  160.                         pipe[0] := WM_REDRAW;
  161.                    pipe[2] := 0;
  162.                       pipe[3] := form.w_handle;
  163.                      pipe[4] := form.tree^[ROOT].ob_x;
  164.                       pipe[5] := form.tree^[ROOT].ob_y;
  165.                      pipe[6] := form.tree^[ROOT].ob_width;
  166.                       pipe[7] := form.tree^[ROOT].ob_height;
  167.                       appl_write(pipe[1], 16, @pipe);
  168.                     end;    
  169.                 end;
  170.             end;
  171.     ret := -1;
  172.     wind_get(0, WF_TOP, topwind, dummy, dummy, dummy);
  173.                          
  174.                                 
  175.     if (form.tree <> NIL) and (form.w_handle > 0) and
  176.         (topwind = form.w_handle) then        
  177.         ret := pform_thru(form.tree, which, events, form.editobj, form.idx);
  178.     pform_win := ret;         
  179. end;                     
  180.  
  181. procedure close_winddial(var form: FORMULAR);
  182. begin
  183.     if form.editobj <> 0 then
  184.         objc_ed(form.tree, form.editobj, 0, form.idx, EDEND);             
  185.     wind_close(form.w_handle);
  186.     wind_delete(form.w_handle);
  187.     form.w_handle := -1;
  188. end;
  189.     
  190. (***********************************************************************)
  191.     
  192. function spec_chars: integer;
  193. var
  194.     tree    :    AESTreePtr;
  195.     ret    :    integer;
  196. begin
  197.     rsrc_gaddr(R_TREE, POPASCII, pointer(tree));    
  198.     with tree^[ROOT] do
  199.     begin
  200.         graf_mkstate(ob_x, ob_y, ret, ret);
  201.         dec(ob_x, ob_width div 2);
  202.         ob_x := max(ob_x, 0);
  203.         dec(ob_y, ob_height div 2);
  204.         ob_y := max(ob_y, 0);
  205.     end;
  206.     ret := pop_up(tree);        
  207.     if ret = - 1 then
  208.         spec_chars := S_INSERT
  209.     else    
  210.     begin
  211.         spec_chars := integer(pchar(tree^[ret].ob_spec.free_string)^);
  212.     end;
  213. end;    
  214.     
  215. begin
  216.     if not initgem then
  217.         exit;
  218.     if rsrc_load('modelss2.rsc') = 0 then
  219.     begin
  220.         exitgem;
  221.         exit;
  222.     end;    
  223.     graf_mouse(ARROW, NIL);
  224.     init_pform(vdihandle, FALSE);    
  225.     init_newobs(vdihandle);
  226.     set_insert(spec_chars);
  227.     fix_all(TRUE);
  228.     rsrc_gaddr(R_TREE, MENU, pointer(menuptr));
  229.     menu_bar(menuptr, 1);
  230.     leave := FALSE;
  231.     
  232.     with events do
  233.     begin
  234.         ev_mflags := MU_KEYBD or MU_BUTTON or MU_MESAG; 
  235.         ev_mbclicks := 2;
  236.         ev_bmask := 1;
  237.         ev_mbstate := 1;
  238.         ev_mm1flags := 0;
  239.         ev_mm1x := 0;
  240.         ev_mm1y := 0;
  241.         ev_mm1width := 0;
  242.         ev_mm1height := 0;
  243.         ev_mm2flags := 0;
  244.         ev_mm2x := 0;
  245.         ev_mm2y := 0;
  246.         ev_mm2width := 0;
  247.         ev_mm2height := 0;
  248.         ev_mtlocount := 10;
  249.         ev_mthicount := 0;
  250.     end;
  251.     
  252.     with form_test do
  253.     begin
  254.         tree := NIL;
  255.         w_handle := -1;
  256.         editobj    := 0;
  257.     end;
  258.     with form_about do
  259.     begin
  260.         tree := NIL;
  261.         w_handle := -1;
  262.         editobj    := 0;
  263.     end;    
  264.     
  265.     repeat
  266.         which := EvntMulti(events);
  267.         
  268.         ret := pform_win(form_about);
  269.         if ret >= 0 then
  270.         begin
  271.             if is_flag(form_about.tree^[ret], TOUCHEXIT) or
  272.                 (is_flag(form_about.tree^[ret], F_EXIT) and
  273.                  is_flag(form_about.tree^[ret], SELECTABLE)) then
  274.             begin     
  275.                 close_winddial(form_about);    
  276.                 deselect(form_about.tree^[ret]);     
  277.                 menu_ienable(menuptr, ABOUT_MODELESS, 1);
  278.             end;    
  279.         end
  280.         else
  281.         begin
  282.             ret := pform_win(form_test);
  283.             if ret >= 0 then
  284.             begin
  285.                 if is_flag(form_test.tree^[ret], TOUCHEXIT) or
  286.                     (is_flag(form_test.tree^[ret], F_EXIT) and
  287.                      is_flag(form_test.tree^[ret], SELECTABLE)) then
  288.                 begin 
  289.                     close_winddial(form_test);         
  290.                     deselect(form_test.tree^[ret]);
  291.                     if ret = CANCEL then
  292.                         setptext(form_test.tree, FIELD, oldtxt);
  293.                     menu_ienable(menuptr, OPEN_DIAL, 1);
  294.                 end;    
  295.             end;
  296.         end;    
  297.         
  298.         if (which and MU_MESAG) <> 0 then 
  299.         begin
  300.             if events.ev_mmgpbuf[0] = MN_SELECTED then
  301.             begin
  302.                 case events.ev_mmgpbuf[4] of
  303.                     ABOUT_MODELESS:
  304.                     begin
  305.                         rsrc_gaddr(R_TREE, ABOUT, pointer(form_about.tree));
  306.                         open_winddial(form_about, 'MODAL');
  307.                         menu_ienable(menuptr, ABOUT_MODELESS, 0);
  308.                     end;
  309.                      
  310.                     OPEN_DIAL: 
  311.                     begin
  312.                         rsrc_gaddr(R_TREE, FORM, pointer(form_test.tree));
  313.                         getptext(form_test.tree, FIELD, oldtxt);
  314.                         open_winddial(form_test, 'MODAL');
  315.                         menu_ienable(menuptr, OPEN_DIAL, 0);
  316.                     end;
  317.                     
  318.                     QUIT:    
  319.                         leave := TRUE;
  320.                 end;
  321.                 menu_tnormal(menuptr, events.ev_mmgpbuf[3], 1);
  322.             end;
  323.         end;    
  324.     until leave;    
  325.     if form_test.w_handle <> -1 then
  326.         close_winddial(form_test);
  327.     if form_about.w_handle <> -1 then
  328.         close_winddial(form_about);    
  329.     menu_bar(menuptr, 0);
  330.     fix_all(FALSE);
  331.     exit_pform;
  332.     rsrc_free;
  333.     exitgem;            
  334. end.