home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / pdial / showdial / windlib.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-07-09  |  32.5 KB  |  1,024 lines
  1. (*
  2.  * Bibliotheksfunktionen zur Fensterprogrammierung
  3.  * Jürgen Holtkamp, 1993
  4.  *)
  5. unit windlib;
  6.  
  7. interface
  8.  
  9. uses gem, tools;
  10.  
  11. const
  12.    WI_NOTYPE   =  0;
  13.    WI_DIAL     =  1;
  14.  
  15. type
  16.    WINDOWPtr   =  ^WINDOW;
  17.    WINDOWProc  =  procedure(windptr: WINDOWPtr);
  18.  
  19.    WINDOW   =
  20.       record
  21.          handle      :  integer; (* Window Handle                    *)
  22.          work        :  GRECT;   (* Arbeitsbereich                   *)
  23.          clip        :  GRECT;   (* Clipping-Bereich                 *)
  24.          elements    :  integer; (* Bestandteile des Fensters        *)
  25.          scroll_x    :  integer; (* Scroll-Wert für x-Achse          *)
  26.          scroll_y    :  integer; (* Scroll-Wert für y-Achse          *)
  27.          align       :  boolean;
  28.          doc_x       :  integer; (* x-Position des Dokuments         *)
  29.          doc_y       :  integer; (* y-Position des Dokuments         *)
  30.          doc_height  :  longint; (* Dokumentlänge                    *)
  31.          doc_width   :  longint; (* Dokumentbreite                   *)
  32.          redraw      :  WINDOWProc; (* Redraw-Funktion               *)
  33.          untopped    :  WINDOWProc; (* wird beim Untoppen aufgerufen *)
  34.          topped      :  WINDOWProc; (* wird beim Toppen aufgerufen   *)
  35.          moved       :  WINDOWProc; (*   "    "  Moven     "         *)
  36.          closed      :  WINDOWProc; (* wird beim Schließen aufg.     *)
  37.          next        :  WINDOWPtr;  (* nächstes Fenster              *)
  38.          prev        :  WINDOWPtr;
  39.          wind_spec   :  pointer;
  40.          wind_type   :  integer;
  41.       end;
  42.  
  43. procedure init_windows(vdihandle: integer);
  44. function  create_window(var wind: WINDOW; var coords: GRECT): integer;
  45. function  open_window(var wind: WINDOW; var coords: GRECT;
  46.           wind_name, wind_info: pchar): integer;
  47. function  close_window(var wind: WINDOW): integer;
  48. procedure handle_window(var buffer: ARRAY_8);
  49. function  find_window(w_handle: integer): WINDOWPtr;
  50. function  get_top: integer;
  51. function  rc_intersect(var p1, p2: GRECT): boolean;
  52. function  cycle_window(w_handle: integer): integer;
  53.  
  54. function search_menu(m_tree : AESTreePtr; kstate, key : integer; 
  55.                             var title, entry: integer): boolean;
  56.  
  57. implementation
  58.  
  59. uses tos, strings;
  60.  
  61. (*$X+*)
  62.  
  63. var
  64.    v_handle    :  integer;
  65.    firstwind   :  WINDOWPtr;
  66.    pxy         :  ARRAY_8;
  67.  
  68. (***********************************************************************)
  69. (* xywh2grect() und grect2array()                                      *)
  70. (***********************************************************************)
  71. procedure xywh2grect(x, y, w, h: integer; var g: GRECT);
  72. begin
  73.    with g do
  74.    begin
  75.       g_x := x;
  76.       g_y := y;
  77.       g_w := w;
  78.       g_h := h;
  79.    end;
  80. end;
  81.  
  82. procedure grect2array(g: GRECT; var xy: ARRAY_4);
  83. begin
  84.    with g do
  85.    begin
  86.       xy[0] := g_x;
  87.       xy[1] := g_y;
  88.       xy[2] := g_x + g_w - 1;
  89.       xy[3] := g_y + g_h - 1;
  90.    end;
  91. end;
  92.  
  93.  
  94. (***********************************************************************)
  95. (* rc_intersect()                                                      *)
  96. (* überprüft, ob sich p1 und p2 überlappen                             *)
  97. (***********************************************************************)
  98. function rc_intersect(var p1, p2: GRECT): boolean;
  99. var
  100.    tw, th, tx, ty :  integer;
  101. begin
  102.    tw := min(p1.g_x + p1.g_w, p2.g_x + p2.g_w);
  103.    th := min(p1.g_y + p1.g_h, p2.g_y + p2.g_h);
  104.    tx := max(p1.g_x, p2.g_x);
  105.    ty := max(p1.g_y, p2.g_y);
  106.  
  107.    p2.g_x := tx;
  108.    p2.g_y := ty;
  109.    p2.g_w := tw - tx;
  110.    p2.g_h := th - ty;
  111.    rc_intersect := (tw > tx) and (th > ty);
  112. end;
  113.  
  114. (***********************************************************************)
  115. (* rc_equal()                                                          *)
  116. (* vergleicht zwei GRECT-Strukturen auf Gleicheit                      *)
  117. (***********************************************************************)
  118. function rc_equal(p1, p2: GRECT): boolean;
  119. begin
  120.    if (p1.g_x <> p2.g_x) or (p1.g_y <> p2.g_y) or
  121.       (p1.g_w <> p2.g_w) or (p1.g_h <> p2.g_h) then
  122.       rc_equal := FALSE
  123.    else
  124.       rc_equal := TRUE;
  125. end;
  126.  
  127.  
  128. (***********************************************************************)
  129. (* get_top()                                                           *)
  130. (***********************************************************************)
  131. function get_top: integer;
  132. var
  133.    dummy, tw:  integer;
  134. begin
  135.    wind_get(0, WF_TOP, tw, dummy, dummy, dummy);
  136.    get_top := tw;
  137. end;
  138.  
  139. (***********************************************************************)
  140. (* find_window()                                                       *)
  141. (***********************************************************************)
  142. function find_window(w_handle: integer): WINDOWPtr;
  143. var
  144.    ret:  WINDOWPtr;
  145. begin
  146.    find_window := NIL;
  147.    ret := firstwind;
  148.    if (ret = NIL) then
  149.       exit;
  150.  
  151.    repeat
  152.       if ret^.handle = w_handle then
  153.          find_window := ret;
  154.       ret := ret^.next;
  155.    until ret = WINDOWPtr(NIL);
  156. end;
  157.  
  158. function cycle_window(w_handle: integer): integer;
  159. var
  160.    currwind    :  WINDOWPtr;
  161. begin
  162.    if w_handle <= 0 then
  163.    begin
  164.       cycle_window := -1;
  165.       exit;
  166.    end;
  167.    currwind := find_window(w_handle);
  168.    if currwind = NIL then
  169.    begin
  170.       cycle_window := -1;
  171.       exit;
  172.    end;
  173.    repeat
  174.       currwind := currwind^.next;
  175.       if currwind = NIL then
  176.          currwind := firstwind;
  177.    until currwind^.handle <> -1;
  178.    cycle_window := currwind^.handle;
  179. end;
  180.  
  181.  
  182. (***********************************************************************)
  183. (* remove_window()                                                     *)
  184. (* entfernt Eintrag aus der verketteten Liste.                         *)
  185. (***********************************************************************)
  186. function remove_window(wind: WINDOW): boolean;
  187. var
  188.    wptr1, prev :  WINDOWPtr;
  189. begin
  190.    wptr1 := firstwind;
  191.    if @wind = wptr1 then
  192.    begin
  193.       firstwind := wind.next;
  194.       remove_window := TRUE;
  195.    end
  196.    else
  197.    begin
  198.    repeat
  199.          prev := wptr1;
  200.          wptr1 := wptr1^.next;
  201.       until (wptr1 = @wind) or (wptr1 = WINDOWPtr(NIL));
  202.       if wptr1 <> WINDOWPtr(NIL) then
  203.       begin
  204.          prev^.next := wptr1^.next;
  205.          remove_window := TRUE;
  206.       end
  207.       else
  208.          remove_window := FALSE;
  209.    end;
  210. end;
  211.  
  212. (***********************************************************************)
  213. (* align_wwh()                                                         *)
  214. (***********************************************************************)
  215. procedure align_wh(w_handle: integer; var w, h:    integer);
  216. var
  217.    currwind :  WINDOWPtr;
  218.    border   :  GRECT;
  219. begin
  220.    currwind := find_window(w_handle);
  221.    if currwind = NIL then
  222.       exit;
  223.    with currwind^ do
  224.    begin
  225.       if align then
  226.       begin
  227.  
  228.          w := (w div scroll_x) * scroll_x;
  229.          h := (h div scroll_y) * scroll_y;
  230.  
  231.       end;
  232.    end;
  233. end;
  234.  
  235.  
  236. (***********************************************************************)
  237. (* calc_window                                                         *)
  238. (***********************************************************************)
  239. procedure calc_window(wctype, kind: integer; into: GRECT; var out: GRECT);
  240. begin
  241.    wind_calc(wctype, kind, into.g_x, into.g_y, into.g_w, into.g_h,
  242.              out.g_x, out.g_y, out.g_w, out.g_h);
  243. end;
  244.  
  245. (***********************************************************************)
  246. (* clear_window()                                                      *)
  247. (* löscht Fensterinhalt                                                *)
  248. (***********************************************************************)
  249. procedure clear_window(var wind: WINDOW);
  250. var
  251.    clip  :  ARRAY_4;
  252. begin
  253.    wind_get(wind.handle, WF_WORKXYWH, clip[0], clip[1], clip[2], clip[3]);
  254.    inc(clip[2], (clip[0] - 1));
  255.    inc(clip[3], (clip[1] - 1));
  256.    v_hide_c(v_handle);
  257.    vsf_color(v_handle, 0);
  258.    vs_clip(v_handle, 1, clip);
  259.    v_bar(v_handle, clip);
  260.    v_show_c(v_handle, 1);
  261. end;
  262.  
  263.  
  264. (***********************************************************************)
  265. (* slider_size()                                                       *)
  266. (* Setzen der Größe der Slider                                         *)
  267. (***********************************************************************)
  268. procedure slider_size(var wind: WINDOW);
  269. var
  270.    h_size, v_size :  longint;
  271.    old_size, d    :  integer;
  272. begin
  273.    with wind do begin
  274.       if (elements and VSLIDE) <> 0 then
  275.       begin
  276.          if doc_height = 0 then
  277.             v_size := 1000
  278.          else
  279.             v_size := min(1000, longint(work.g_h) * 1000
  280.                                 div longint(doc_height));
  281.          wind_get(handle, WF_VSLSIZE, old_size, d, d, d);
  282.          if old_size <> integer(v_size) then
  283.             wind_set(handle, WF_VSLSIZE, integer(v_size), 0, 0, 0);
  284.       end;
  285.       if (elements and HSLIDE) <> 0 then
  286.       begin
  287.          if doc_width = 0 then
  288.             h_size := 1000
  289.          else
  290.             h_size := min(1000, longint(work.g_w) * 1000
  291.                           div longint(doc_width));
  292.          wind_get(handle, WF_HSLSIZE, old_size, d, d, d);
  293.          if old_size <> integer(h_size) then
  294.             wind_set(handle, WF_HSLSIZE, integer(h_size), 0, 0, 0);
  295.       end;
  296.    end;
  297. end;
  298.  
  299. (***********************************************************************)
  300. (* slider_pos()                                                        *)
  301. (* Setzen der Position der Slider                                      *)
  302. (***********************************************************************)
  303. procedure slider_pos(var wind: WINDOW);
  304. var
  305.    x_pos, y_pos   :  longint;
  306.    old_pos, d     :  integer;
  307. begin
  308.    with wind do
  309.    begin
  310.       if (elements and HSLIDE) <> 0 then
  311.       begin
  312.          if wind.doc_width <= wind.work.g_w then
  313.             x_pos := 0
  314.          else
  315.             x_pos := longint(wind.doc_x) * 1000 div
  316.                      (wind.doc_width - wind.work.g_w);
  317.          wind_get(handle, WF_HSLIDE, old_pos, d, d, d);
  318.          if old_pos <> integer(x_pos) then
  319.             wind_set(wind.handle, WF_HSLIDE, integer(x_pos), 0, 0, 0);
  320.       end;
  321.  
  322.       if (elements and VSLIDE) <> 0 then
  323.       begin
  324.          if wind.doc_height <= wind.work.g_h then
  325.             y_pos := 0
  326.          else
  327.             y_pos := longint(wind.doc_y) * 1000 div
  328.                     (wind.doc_height - wind.work.g_h);
  329.          wind_get(handle, WF_VSLIDE, old_pos, d, d, d);
  330.          if old_pos <> integer(y_pos) then
  331.             wind_set(wind.handle, WF_VSLIDE, integer(y_pos), 0, 0, 0);
  332.       end;
  333.    end;
  334. end;
  335.  
  336. (***********************************************************************)
  337. (* create_window()                                                     *)
  338. (***********************************************************************)
  339. function create_window(var wind: WINDOW; var coords: GRECT): integer;
  340. var
  341.    maximum, inside   :  GRECT;
  342.    currwind          :  WINDOWPtr;
  343. begin
  344.    if firstwind = NIL then
  345.    begin
  346.       firstwind := @wind;
  347.       wind.prev := NIL
  348.    end
  349.    else
  350.    begin
  351.       currwind := firstwind;
  352.       while currwind^.next <> NIL do
  353.          currwind := currwind^.next;
  354.       currwind^.next := @wind;
  355.       wind.prev := currwind;
  356.    end;
  357.    wind.next := NIL;
  358.  
  359.    with maximum do
  360.       wind_get(0, WF_WORKXYWH, g_x, g_y, g_w, g_h);
  361.  
  362.    if coords.g_w > maximum.g_w then
  363.       coords.g_w := maximum.g_w;
  364.    if coords.g_h > maximum.g_h then
  365.       coords.g_h := maximum.g_h;
  366.  
  367.    if (coords.g_x + coords.g_w) > (maximum.g_x + maximum.g_w) then
  368.       coords.g_x := maximum.g_x + maximum.g_w - coords.g_w;
  369.    if (coords.g_y + coords.g_h) > (maximum.g_y + maximum.g_h) then
  370.       coords.g_y := maximum.g_y + maximum.g_h - coords.g_h;
  371.  
  372.    if coords.g_x < maximum.g_x then
  373.       coords.g_x := maximum.g_x;
  374.    if coords.g_y < maximum.g_y then
  375.       coords.g_y := maximum.g_y;
  376.  
  377.    with inside do
  378.    begin
  379.       wind_calc(WC_WORK, wind.elements, coords.g_x, coords.g_y,
  380.                 coords.g_w, coords.g_h, g_x, g_y, g_w, g_h);
  381.       align_wh(wind.handle, g_w, g_h);
  382.       wind_calc(WC_BORDER, wind.elements, g_x, g_y, g_w, g_h,
  383.                 coords.g_x, coords.g_y, coords.g_w, coords.g_h);
  384.    end;
  385.  
  386.    with coords do
  387.       wind.handle := wind_create(wind.elements, g_x, g_y, g_w, g_h);
  388.  
  389.    create_window := wind.handle;
  390. end;
  391.  
  392.  
  393. (***********************************************************************)
  394. (* open_window()                                                       *)
  395. (***********************************************************************)
  396. function open_window(var wind: WINDOW; var coords: GRECT;
  397.                      wind_name, wind_info: pchar): integer;
  398. var
  399.    maximum  :  GRECT;
  400.    currwind :  WINDOWPtr;
  401. begin
  402.    currwind := find_window(get_top);
  403.    if currwind <> WINDOWPtr(NIL) then
  404.       currwind^.untopped(currwind);
  405.  
  406.    with maximum do
  407.       wind_get(wind.handle, WF_FULLXYWH, g_x, g_y, g_w, g_h);
  408.  
  409.    if coords.g_w > maximum.g_w then
  410.       coords.g_w := maximum.g_w;
  411.    if coords.g_h > maximum.g_h then
  412.       coords.g_h := maximum.g_h;
  413.  
  414.    if (coords.g_x + coords.g_w) > (maximum.g_x + maximum.g_w) then
  415.       coords.g_x := maximum.g_x + maximum.g_w - coords.g_w;
  416.    if (coords.g_y + coords.g_h) > (maximum.g_y + maximum.g_h) then
  417.       coords.g_y := maximum.g_y + maximum.g_h - coords.g_h;
  418.  
  419.    if coords.g_x < maximum.g_x then
  420.       coords.g_x := maximum.g_x;
  421.    if coords.g_y < maximum.g_y then
  422.       coords.g_y := maximum.g_y;
  423.  
  424.    with wind do
  425.    begin
  426.       calc_window(WC_WORK, elements, coords, work);
  427.       align_wh(handle, work.g_w, work.g_h);
  428.       calc_window(WC_BORDER, elements, work, coords);
  429.    end;
  430.  
  431.    if ((wind.elements and NAME) <> 0) and (wind_name^ <> #0) then
  432.       wind_set(wind.handle, WF_NAME, longint(wind_name) shr 16,
  433.                longint(wind_name) and $ffff, 0, 0);
  434.    if ((wind.elements and INFO) <> 0) and (wind_info^ <> #0) then
  435.       wind_set(wind.handle, WF_INFO, longint(wind_info) shr 16,
  436.                longint(wind_info) and $ffff, 0, 0);
  437.    with coords do
  438.       open_window := wind_open(wind.handle, g_x, g_y, g_w, g_h);
  439.  
  440.    clear_window(wind);
  441.    slider_size(wind);
  442.    slider_pos(wind);
  443. end;
  444.  
  445. (***********************************************************************)
  446. (* handle_full()                                                       *)
  447. (***********************************************************************)
  448. procedure handle_full(var wind: WINDOW);
  449. var
  450.    prev, curr, full  :  GRECT;
  451. begin
  452.    with curr do
  453.       wind_get(wind.handle, WF_CURRXYWH, g_x, g_y, g_w, g_h);
  454.    with prev do
  455.       wind_get(wind.handle, WF_PREVXYWH, g_x, g_y, g_w, g_h);
  456.    with full do
  457.       wind_get(wind.handle, WF_FULLXYWH, g_x, g_y, g_w, g_h);
  458.  
  459.    if rc_equal(curr, full) then
  460.    begin
  461.       with prev do
  462.          wind_set(wind.handle, WF_CURRXYWH, g_x, g_y, g_w, g_h);
  463.       calc_window(WC_WORK, wind.elements, prev, wind.work);
  464.    end
  465.    else
  466.    begin
  467.       wind_set(wind.handle, WF_CURRXYWH,
  468.                full.g_x, full.g_y, full.g_w, full.g_h);
  469.       calc_window(WC_WORK, wind.elements, full, wind.work);
  470.    end;
  471. end;
  472.  
  473. (***********************************************************************)
  474. (* do_redraw()                                                         *)
  475. (* führt den Redraw eines Fensters aus                                 *)
  476. (***********************************************************************)
  477. procedure do_redraw(var wind: WINDOW; x, y, w, h: integer);
  478. var
  479.    p  :  GRECT;
  480.    xy :  ARRAY_4;
  481. begin
  482.    vsf_color(v_handle, WHITE);
  483.    graf_mouse(M_OFF, NIL);
  484.    wind_update(BEG_UPDATE);
  485.    with p do
  486.       wind_get(wind.handle, WF_FIRSTXYWH, g_x, g_y, g_w, g_h);
  487.    while (p.g_w > 0) and (p.g_h > 0) do
  488.    begin
  489.       wind.clip.g_x := x; (* x      *)
  490.       wind.clip.g_y := y; (* y      *)
  491.       wind.clip.g_w := w; (* width  *)
  492.       wind.clip.g_h := h; (* height *)
  493.       if rc_intersect(p, wind.clip) then
  494.       begin
  495.          grect2array(wind.clip, xy);
  496.          vs_clip(v_handle, 1, xy);
  497.          v_bar(v_handle, xy);
  498.          wind.redraw(@wind);
  499.       end;
  500.       with p do
  501.          wind_get(wind.handle, WF_NEXTXYWH, g_x, g_y, g_w, g_h);
  502.    end;
  503.    vs_clip(v_handle, 0, xy);
  504.    wind_update(END_UPDATE);
  505.    graf_mouse(M_ON, NIL);
  506. end;
  507.  
  508. (***********************************************************************)
  509. (* wind_hslide()                                                       *)
  510. (* Berechnen der horizontalen Dokumentsposition                        *)
  511. (***********************************************************************)
  512. function wind_hslide(var wind: WINDOW; newpos: integer): boolean;
  513. var
  514.    oldpos, dummy  :  integer;
  515.    old_doc_x      :  integer;
  516. begin
  517.    wind_hslide := FALSE;
  518.    wind_get(wind.handle, WF_HSLIDE, oldpos, dummy, dummy, dummy);
  519.    if ((wind.elements and HSLIDE) <> 0) and (oldpos <> newpos) then
  520.    begin
  521.       old_doc_x := wind.doc_x;
  522.       wind.doc_x := newpos * (wind.doc_width - wind.work.g_w) div 1000;
  523.       wind_set(wind.handle, WF_HSLIDE, newpos, 0, 0, 0);
  524.       if wind.align then
  525.       begin
  526.          wind.doc_x := (wind.doc_x div wind.scroll_x) * wind.scroll_x;
  527.          old_doc_x := (old_doc_x div wind.scroll_x) * old_doc_x;
  528.       end;
  529.       wind_hslide := (wind.doc_x <> old_doc_x);
  530.    end
  531. end;
  532.  
  533. (***********************************************************************)
  534. (* wind_vslide()                                                       *)
  535. (* Berechnen der vertikalen Dokumentsposition                          *)
  536. (***********************************************************************)
  537. function wind_vslide(var wind: WINDOW; newpos: integer): boolean;
  538. var
  539.    oldpos, dummy  :  integer;
  540.    old_doc_y      :  integer;
  541. begin
  542.    wind_vslide := FALSE;
  543.    wind_get(wind.handle, WF_VSLIDE, oldpos, dummy, dummy, dummy);
  544.    if ((wind.elements and VSLIDE) <> 0) and (oldpos <> newpos) then
  545.    begin
  546.       old_doc_y := wind.doc_y;
  547.       wind.doc_y := newpos * (wind.doc_height -  wind.work.g_h) div 1000;
  548.       if wind.align then
  549.       begin
  550.          wind.doc_y := (wind.doc_y div wind.scroll_y) * wind.scroll_y;
  551.          old_doc_y := (old_doc_y div wind.scroll_y) * old_doc_y;
  552.       end;
  553.       wind_set(wind.handle, WF_VSLIDE, newpos, 0, 0, 0);
  554.       wind_vslide := (wind.doc_y <> old_doc_y);
  555.    end
  556. end;
  557.  
  558. (***********************************************************************)
  559. (* scroll_wind()                                                       *)
  560. (* Slidermanager                                                       *)
  561. (***********************************************************************)
  562. function scroll_wind(var wind: WINDOW; what: integer): boolean;
  563. var
  564.    old_doc_x, old_doc_y :  integer;
  565. begin
  566.    with wind do
  567.    begin
  568.       old_doc_x := doc_x;
  569.       old_doc_y := doc_y;
  570.       case what of
  571.          WA_UPPAGE : dec(doc_y, work.g_h + scroll_y);
  572.          WA_DNPAGE : inc(doc_y, work.g_h - scroll_y);
  573.          WA_UPLINE : dec(doc_y, scroll_y);
  574.          WA_DNLINE : inc(doc_y, scroll_y);
  575.          WA_LFPAGE : dec(doc_x, work.g_w + scroll_x);
  576.          WA_RTPAGE :  inc(doc_x, work.g_w - scroll_x);
  577.          WA_LFLINE : dec(doc_x, scroll_x);
  578.          WA_RTLINE : inc(doc_x, scroll_x);
  579.       end;
  580.       if doc_y > doc_height - work.g_h then
  581.          doc_y := doc_height - work.g_h;
  582.       if doc_y < 0 then
  583.          doc_y := 0;
  584.       if doc_x > doc_width - work.g_w then
  585.          doc_x := doc_width - work.g_w;
  586.       if doc_x < 0 then
  587.          doc_x := 0;
  588.  
  589.       if (old_doc_x = doc_x) and (old_doc_y = doc_y) then
  590.          scroll_wind := FALSE
  591.       else
  592.     begin
  593.          scroll_wind := TRUE;
  594.          slider_pos(wind);
  595.       end;
  596.    end;
  597. end;
  598.  
  599. (***********************************************************************)
  600. (* scroll_redraw()                                                     *)
  601. (***********************************************************************)
  602. procedure scroll_redraw(var wind: WINDOW; what: integer);
  603. var
  604.    screen      :  MFDB;
  605.    x, y, w, h  :  integer;
  606.    clipxy      :  ARRAY_4;
  607.    box, p      :  GRECT;
  608. begin
  609.    with wind do
  610.    begin
  611.       x := work.g_x;
  612.       y := work.g_y;
  613.       w := work.g_w;
  614.       h := work.g_h;
  615.       if (what in [WA_UPPAGE, WA_DNPAGE, WA_LFPAGE, WA_RTPAGE]) or
  616.          (not align) then
  617.       begin
  618.          do_redraw(wind, x, y, w, h);
  619.          exit;
  620.       end;
  621.  
  622.       screen.fd_addr := NIL;
  623.       (* erstes rechteck holen *)
  624.       with p do
  625.          wind_get(wind.handle, WF_FIRSTXYWH, g_x, g_y, g_w, g_h);
  626.       (* while w und h > 0 *)
  627.       wind_update(BEG_UPDATE);
  628.       graf_mouse(M_OFF, NIL);
  629.  
  630.       while (p.g_w > 0) and (p.g_h > 0) do
  631.       begin
  632.          x := p.g_x;
  633.          y := p.g_y;
  634.          w := p.g_w;
  635.          h := p.g_h;
  636.          case what of
  637.             WA_RTLINE:
  638.                with p do
  639.                begin
  640.                   pxy[0] := g_x + scroll_x;
  641.                   pxy[1] := g_y;
  642.                   pxy[2] := g_x + g_w - 1;
  643.                   pxy[3] := g_y + g_h - 1;
  644.                   pxy[4] := g_x;
  645.                   pxy[5] := g_y;
  646.                   pxy[6] := g_x + g_w - 1 - scroll_x;
  647.                   pxy[7] := g_y + g_h - 1;
  648.                   if scroll_x < g_w then
  649.                   begin
  650.                      x := g_x + g_w - scroll_x;
  651.                      y := g_y;
  652.                      w := scroll_x;
  653.                      h := g_h;
  654.                   end;
  655.                end;
  656.             WA_LFLINE:
  657.                with p do
  658.                begin
  659.                   pxy[0] := g_x;
  660.                   pxy[1] := g_y;
  661.                   pxy[2] := g_x + g_w - 1 - scroll_x;
  662.                   pxy[3] := g_y + g_h - 1;
  663.                   pxy[4] := g_x + scroll_x;
  664.                   pxy[5] := g_y;
  665.                   pxy[6] := g_x + g_w - 1;
  666.                   pxy[7] := g_y + g_h - 1;
  667.                   if scroll_x < g_w then
  668.                   begin
  669.                      x := g_x;
  670.                      y := g_y;
  671.                      w := scroll_x;
  672.                      h := g_h;
  673.                   end;
  674.                end;
  675.             WA_DNLINE:
  676.                with p do
  677.                begin
  678.                   pxy[0] := g_x;
  679.                   pxy[1] := g_y + scroll_y;
  680.                   pxy[2] := g_x + g_w - 1;
  681.                   pxy[3] := g_y + g_h - 1;
  682.                   pxy[4] := g_x;
  683.                   pxy[5] := g_y;
  684.                   pxy[6] := g_x + g_w - 1;
  685.                   pxy[7] := g_y + g_h - 1 - scroll_y;
  686.                   if scroll_y < g_h then
  687.                   begin
  688.                      x := g_x;
  689.                      y := g_y + g_h - scroll_y;
  690.                      w := g_w;
  691.                      h := scroll_y;
  692.                   end;
  693.                end;
  694.             WA_UPLINE:
  695.                with p do
  696.                begin
  697.                   pxy[0] := g_x;
  698.                   pxy[1] := g_y;
  699.                   pxy[2] := g_x + g_w - 1;
  700.                   pxy[3] := g_y + g_h - 1 - scroll_y;
  701.                   pxy[4] := g_x;
  702.                   pxy[5] := g_y + scroll_y;
  703.                   pxy[6] := g_x + g_w - 1;
  704.                   pxy[7] := g_y + g_h - 1;
  705.                   if scroll_y < g_h then
  706.                   begin
  707.                      x := g_x;
  708.                      y := g_y;
  709.                      w := g_w;
  710.                      h := scroll_y;
  711.                   end;
  712.                end;
  713.          end; (* of case *)
  714.          if ((what in [WA_UPLINE, WA_DNLINE]) and
  715.             (p.g_h > scroll_y)) or
  716.             ((what in [WA_LFLINE, WA_RTLINE]) and
  717.             (p.g_w > scroll_x)) then
  718.             vro_cpyfm(v_handle, S_ONLY,  pxy, screen, screen);
  719.          wind.clip.g_x := x;
  720.          wind.clip.g_y := y;
  721.          wind.clip.g_w := w;
  722.          wind.clip.g_h := h;
  723.          with wind.clip do
  724.          begin
  725.             clipxy[0] := g_x;
  726.             clipxy[1] := g_y;
  727.             clipxy[2] := g_x + g_w - 1;
  728.             clipxy[3] := g_y + g_h - 1;
  729.          end;
  730.          vs_clip(v_handle, 1, clipxy);
  731.          vsf_color(v_handle, WHITE);
  732.          vr_recfl(v_handle, clipxy);
  733.          wind.redraw(@wind);
  734.          vs_clip(v_handle, 0, clipxy);
  735.          with p do
  736.             wind_get(wind.handle, WF_NEXTXYWH, g_x, g_y, g_w, g_h);
  737.       end;
  738.       graf_mouse(M_ON, NIL);
  739.       wind_update(END_UPDATE);
  740.    end;
  741. end;
  742.  
  743. (***********************************************************************)
  744. (* handle_window()                                                     *)
  745. (* allgemeine Fensterverwaltung                                        *)
  746. (***********************************************************************)
  747. procedure handle_window(var buffer: ARRAY_8);
  748. var
  749.    currwind    :  WINDOWPtr;
  750.    p           :  GRECT;
  751. begin
  752.    currwind := find_window(buffer[3]);
  753.    case buffer[0] of
  754.       WM_REDRAW:
  755.          do_redraw(currwind^, buffer[4], buffer[5], buffer[6], buffer[7]);
  756.       WM_TOPPED, WM_NEWTOP:
  757.          begin
  758.             currwind := find_window(get_top);
  759.             if currwind <> WINDOWPtr(NIL) then
  760.                currwind^.untopped(currwind);
  761.             currwind := find_window(buffer[3]);
  762.             wind_set(buffer[3], WF_TOP, buffer[3], 0, 0, 0);
  763.             currwind^.topped(currwind);
  764.          end;
  765.       WM_CLOSED:
  766.          close_window(currwind^);
  767.       WM_FULLED:
  768.       begin
  769.          handle_full(currwind^);
  770.          slider_size(currwind^);
  771.          slider_pos(currwind^);
  772.          with currwind^ do
  773.          begin
  774.             if work.g_w > (doc_width - doc_x) then
  775.                doc_x := doc_width - work.g_w;
  776.             if doc_x < 0 then
  777.                   doc_x := 0;
  778.             if work.g_h > (doc_height - doc_y) then
  779.                doc_y := doc_height - work.g_h;
  780.             if doc_y < 0 then
  781.                   doc_y := 0;
  782.          end;
  783.       end;
  784.       WM_ARROWED:
  785.          if scroll_wind(currwind^, buffer[4]) then
  786.             scroll_redraw(currwind^, buffer[4]);
  787.       WM_HSLID:
  788.       begin
  789.          if wind_hslide(currwind^, buffer[4]) then
  790.             do_redraw(currwind^, currwind^.work.g_x, currwind^.work.g_y,
  791.                      currwind^.work.g_w, currwind^.work.g_h);
  792.       end;
  793.       WM_VSLID:
  794.       begin
  795.          if wind_vslide(currwind^, buffer[4]) then
  796.             do_redraw(currwind^, currwind^.work.g_x, currwind^.work.g_y,
  797.                       currwind^.work.g_w, currwind^.work.g_h);
  798.       end;
  799.       WM_SIZED:
  800.       begin
  801.          if buffer[6] < 100 then
  802.             buffer[6] := 100;
  803.          if buffer[7] < 100 then
  804.             buffer[7] := 100;
  805.  
  806.          with currwind^.work do
  807.          begin
  808.             wind_calc(WC_WORK, currwind^.elements, buffer[4], buffer[5],
  809.                      buffer[6], buffer[7], g_x, g_y, g_w, g_h);
  810.             align_wh(buffer[3], g_w, g_h);
  811.             wind_calc(WC_BORDER, currwind^.elements, g_x, g_y, g_w, g_h,
  812.                       buffer[4], buffer[5], buffer[6],buffer[7]);
  813.             wind_set(buffer[3], WF_CURRXYWH, buffer[4], buffer[5],
  814.                      buffer[6],buffer[7]);
  815.          end;
  816.          slider_size(currwind^);
  817.          slider_pos(currwind^);
  818.          with currwind^ do
  819.          begin
  820.             if work.g_w > (doc_width - doc_x) then
  821.                doc_x := doc_width - work.g_w;
  822.             if doc_x < 0 then
  823.                doc_x := 0;
  824.             if work.g_h > (doc_height - doc_y) then
  825.                doc_y := doc_height - work.g_h;
  826.             if doc_y < 0 then
  827.                doc_y := 0;
  828.          end;
  829.       end;
  830.       WM_MOVED:
  831.       begin
  832.          with currwind^.work do
  833.          begin
  834.             wind_calc(WC_WORK, currwind^.elements, buffer[4], buffer[5],
  835.                      buffer[6], buffer[7], g_x, g_y, g_w, g_h);
  836.             align_wh(buffer[3], g_w, g_h);
  837.             wind_calc(WC_BORDER, currwind^.elements, g_x, g_y, g_w, g_h,
  838.                       buffer[4], buffer[5], buffer[6],buffer[7]);
  839.             wind_set(buffer[3], WF_CURRXYWH, buffer[4], buffer[5],
  840.                      buffer[6],buffer[7]);
  841.          end;
  842.          slider_size(currwind^);
  843.          currwind^.moved(currwind);
  844.        end;
  845.    end;
  846. end;
  847.  
  848. (***********************************************************************)
  849. (* close_window()                                                      *)
  850. (***********************************************************************)
  851. function close_window(var wind: WINDOW): integer;
  852. begin
  853.    wind.closed(@wind);
  854.    close_window := 1;
  855.    if wind_close(wind.handle) = 0 then
  856.       close_window := 0;
  857.    if wind_delete(wind.handle) = 0 then
  858.       close_window := 0;
  859.    wind.handle := -1;
  860.    (* remove_window(wind); *)
  861.    if wind.prev <> NIL then
  862.       (wind.prev)^.next := wind.next; (* Fenster aus Liste entfernen *)
  863.    if firstwind = @wind then
  864.       firstwind := wind.next;
  865. end;
  866.  
  867. procedure init_windows(vdihandle: integer);
  868. begin
  869.    v_handle := vdihandle;
  870. end;
  871.  
  872. (*********************************************************************)
  873.     
  874. function test_entry(specstr : pchar; bst : char; 
  875.                     scan, state : integer) : boolean;
  876. var
  877.     vchr                :    char;
  878.     ret                :    boolean;
  879.     zahl, i            :    integer; 
  880. begin
  881.     test_entry := FALSE;
  882.     i := strlen(specstr) - 1;
  883.     while specstr[i] = ' ' do
  884.         dec(i);
  885.     vchr := upcase(specstr[i]);
  886.     
  887.     if vchr = bst then
  888.     begin
  889.         dec(i);
  890.         if ((specstr[i] = '^') and (state = K_CTRL)) 
  891.             or ((specstr[i] = #7) and (state = K_ALT)) then
  892.         begin    
  893.             test_entry := TRUE;
  894.             exit;
  895.         end;    
  896.         if (specstr[i] = ' ') and ((state and K_CTRL) = 0) and 
  897.             ((state and K_ALT) = 0) then
  898.         begin    
  899.             test_entry := TRUE;
  900.             exit;
  901.         end;    
  902.     end;
  903.     
  904.     
  905.     if (specstr[i] = '''') and ((state and K_CTRL) = 0) and
  906.         ((state and K_ALT) = 0) then
  907.     begin
  908.         dec(i);
  909.         vchr := upcase(specstr[i]);
  910.         if (vchr = bst) and (specstr[i - 1] = '''') then
  911.         begin
  912.             test_entry := TRUE;
  913.             exit;
  914.         end;    
  915.     end;
  916.  
  917.     if (specstr[i] in ['0'..'9']) then
  918.     begin
  919.         zahl := ord(specstr[i]) - ord('0');
  920.         dec(i);
  921.         if specstr[i] in ['0'..'9'] then
  922.         begin
  923.             inc(zahl, (ord(specstr[i]) - ord(0)) * 10);
  924.             dec(i);
  925.         end;
  926.         if specstr[i] = 'F' then
  927.         begin
  928.             if specstr[i - 1] = #1 then
  929.                 inc(zahl, 10);
  930.             if zahl in [1..10] then
  931.                 if zahl = scan - $3b    + 1 then
  932.                 begin
  933.                    test_entry := TRUE;
  934.                    exit;
  935.                 end;   
  936.             if zahl in [11..20] then
  937.                 if zahl = scan - $54    + 11 then
  938.                 begin
  939.                    test_entry := TRUE;
  940.                    exit;
  941.                 end;       
  942.         end;
  943.     end;    
  944. end;
  945.  
  946. function search_menu(m_tree : AESTreePtr; kstate, key : integer; 
  947.                             var title, entry: integer): boolean;
  948. var
  949.     do_quit, desk                                        :    boolean;
  950.     pkeytbl                                                :    KEYTABPtr;
  951.     kbd_unshift, kbd_shift                            :    pchar;
  952.     bst                                                    :    char;
  953.     state, scan, mother_title, child_title, 
  954.     mother_entry, child_entry                        :    integer;
  955. begin
  956.     search_menu := FALSE;
  957.     state := 0;
  958.     do_quit := FALSE;
  959.     desk := TRUE;
  960.     pkeytbl := Keytbl(pointer(-1),pointer(-1),pointer(-1));
  961.     kbd_unshift := pkeytbl^.unshift;
  962.     kbd_shift := pkeytbl^.shift;
  963.     wind_update(BEG_UPDATE);
  964.     wind_update(END_UPDATE);
  965.     scan := hi(key); 
  966.     if (kstate and (K_LSHIFT or K_RSHIFT)) = 0 then
  967.         bst := kbd_unshift[scan]
  968.     else
  969.         bst := kbd_shift[scan];    
  970.     bst := upcase(bst);
  971.     if ((kstate and K_ALT) <> 0) and ((kstate and K_CTRL) = 0) then
  972.         state := K_ALT
  973.     else
  974.         if ((kstate and K_CTRL) <> 0) and ((kstate and K_ALT) = 0) then
  975.             state := K_CTRL
  976.         else
  977.             if ((kstate and K_CTRL) = 0) and ((kstate and K_ALT) = 0) then
  978.                 state := 0
  979.             else
  980.                 do_quit := TRUE;
  981.     mother_title := m_tree^[m_tree^[ROOT].ob_head].ob_head;
  982.     child_title     := m_tree^[mother_title].ob_head;
  983.     mother_entry := m_tree^[m_tree^[ROOT].ob_tail].ob_head;
  984.     child_entry  := m_tree^[mother_entry].ob_head;
  985.     
  986.     while not do_quit do
  987.     begin
  988.         if not is_state(m_tree^[child_title], DISABLED) then
  989.             while (not do_quit) and (child_entry <> mother_entry) and
  990.                   (child_entry <> -1) do
  991.             begin
  992.                 with m_tree^[child_entry] do
  993.                 begin
  994.                     if not is_state(m_tree^[child_entry], DISABLED) and
  995.                        (ob_type in [G_STRING, G_BUTTON]) then
  996.                         do_quit := test_entry(ob_spec.free_string,
  997.                                                bst, scan, state);
  998.                     if do_quit then
  999.                     begin
  1000.                         menu_tnormal(m_tree, child_title, 0);
  1001.                         title := child_title;
  1002.                         entry := child_entry;    
  1003.                         search_menu := TRUE;
  1004.                     end;
  1005.                     child_entry := ob_next;    
  1006.                     if desk then
  1007.                     begin
  1008.                         child_entry := mother_entry;
  1009.                         desk := FALSE;
  1010.                     end;
  1011.                 end;
  1012.             end;                            
  1013.         child_title  := m_tree^[child_title].ob_next;
  1014.         mother_entry := m_tree^[mother_entry].ob_next;
  1015.         child_entry  := m_tree^[mother_entry].ob_head;
  1016.         if child_title = mother_title then
  1017.             do_quit := TRUE;
  1018.     end;
  1019. end;    
  1020.                     
  1021.  
  1022. begin
  1023.    firstwind := NIL;
  1024. end.