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