home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED2.LZH / GEMDEMO / DEMOWIND.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-02  |  11KB  |  307 lines
  1. {---------------------------------------------------------------------
  2.                 GEM Window Interface for GEMDEMO
  3.  
  4.                 Copyright (c) 1990 D-House I ApS
  5.                        All rights reserved
  6.  
  7.                  Programmed by Martin Eskildsen
  8. ---------------------------------------------------------------------}
  9.  
  10. {$D+}
  11.  
  12. unit DemoWindows;
  13.  
  14. INTERFACE
  15.  
  16. uses GemDecl, GemAES, GemVDI, DemoInterface, DemoGraphs;
  17.  
  18. { Create and open graphics window }
  19. procedure OpenGraphicsWindow;
  20.  
  21. { Close and delete graphics window }
  22. procedure CloseGraphicsWindow;
  23.  
  24. { Create and open text window }
  25. procedure OpenTextWindow;
  26.  
  27. { Close and delete text window }
  28. procedure CloseTextWindow;
  29.  
  30. { Select one of the graphics demos }
  31. procedure SelectGraphicsDemo;
  32.  
  33. { Redraw a window.
  34.     handle         : window to redraw
  35.     x0, y0, w0, h0 : area to redraw
  36. }
  37. procedure RedrawWindow(handle, x0, y0, w0, h0 : Integer);
  38.  
  39. { Top the given window }
  40. procedure TopWindow(handle : Integer);
  41.  
  42. { Full the given window }
  43. procedure FullWindow(handle : Integer);
  44.  
  45. { Close and delete the given window }
  46. procedure CloseWindow(handle : Integer);
  47.  
  48. { Move the given window. New corner (x,y) coordinates are given }
  49. procedure MoveWindow(handle, toX, toY : Integer);
  50.  
  51. { Set the given windows size. New width and height are given }
  52. procedure SizeWindow(handle, newW, newH : Integer);
  53.  
  54. { Close the currently active window }
  55. procedure CloseTopWindow;
  56.  
  57. {$F+,D-,S-,R-}
  58.  
  59. IMPLEMENTATION
  60.  
  61. var
  62.   GrafName      : String;       { Graphics window name                  }
  63.   TextName      : String;       { Text window name                      }
  64.   TextLine      : String;       { The line written in the text window   }
  65.   GrafElements  : Integer;      { Graphics window border elements       }
  66.   TextElements  : Integer;      { Text window border elements           }
  67.   TextX         : Integer;      { Initial positions and sizes of the    }
  68.   TextY         : Integer;      { two windows. Y, W and H are the same  }
  69.   TextW         : Integer;      { for both, but are dublated in order   }
  70.   TextH         : Integer;      { to allow for easy modification and to }
  71.   GrafX         : Integer;      { clearify what's going on              }
  72.   GrafY         : Integer;
  73.   GrafW         : Integer;
  74.   GrafH         : Integer;
  75.  
  76. { This procedure calculates the correct sizes and positions of the windows
  77.   from the available desktop space }
  78. procedure CalcWindowPositions;
  79. begin
  80.   TextX := 8;
  81.   TextY := CharBoxHeight + CharBoxHeight DIV 2;
  82.   TextW := (MaxW - 2*TextX - 20) DIV 2;
  83.   TextH := MaxH - CharBoxHeight;
  84.   GrafX := TextX + TextW + 20;
  85.   GrafY := TextY;
  86.   GrafW := TextW;
  87.   GrafH := TextH
  88. end;
  89.  
  90. procedure OpenGraphicsWindow;
  91. begin
  92.   { create window : }
  93.   CalcWindowPositions;
  94.   grafwindow := wind_create(GrafElements, MinX, MinY, MaxW, MaxH);
  95.   if grafwindow >= 0 then begin   { created ok... }
  96.     wind_update(BEG_UPDATE);      { AES : leave us alone! }
  97.     
  98.     { set window name : }
  99.     wind_set(grafwindow, WF_NAME, HiPtr(GrafName[1]), LoPtr(GrafName[1]), 0, 0);
  100.     
  101.     { draw a nice expanding box and open window }
  102.     graf_growbox(GrafX + GrafW DIV 2 - 5, GrafY + GrafH DIV 2 - 5, 10, 10, GrafX, GrafY, GrafW, GrafH);
  103.     wind_open(grafwindow, GrafX, GrafY, GrafW, GrafH);
  104.     
  105.     { set WINMENU's state }
  106.     SetMenuState(s_enable, s_leave, s_leave, s_disable, s_enable);
  107.     wind_update(END_UPDATE)        { let the AES rule again }
  108.   end
  109. end;
  110.  
  111. procedure CloseGraphicsWindow;
  112. var x, y, w, h : Integer;       { window border area }
  113. begin
  114.   if grafwindow >= 0 then begin
  115.     wind_update(BEG_UPDATE);    { leave us alone }
  116.     
  117.     { get border size and draw a shrinking box : }
  118.     wind_get(grafwindow, WF_CURRXYWH, x, y, w, h);
  119.     graf_shrinkbox(x + w DIV 2 - 5, y + h DIV 2 - 5, 10, 10, x, y, w, h);
  120.     wind_close(grafwindow);     { remove window from screen }
  121.     wind_delete(grafwindow);    { and memory too            }
  122.     grafwindow := -1;           { set handle = -1 to prevent mistakes }
  123.     if textwindow >= 0 then     { update WINMENU            }
  124.       SetMenuState(s_leave, s_leave, s_leave, s_enable, s_disable)
  125.     else
  126.       SetMenuState(s_disable, s_leave, s_leave, s_enable, s_disable);
  127.     wind_update(END_UPDATE)     { let AES rule }
  128.   end
  129. end;
  130.  
  131. { Consult OpenGraphicsWindow - they're similar }
  132. procedure OpenTextWindow;
  133. begin
  134.   CalcWindowPositions;
  135.   textwindow := wind_create(TextElements, MinX, MinY, MaxW, MaxH);
  136.   if textwindow >= 0 then begin
  137.     wind_update(BEG_UPDATE);
  138.     wind_set(textwindow, WF_NAME, HiPtr(TextName[1]), LoPtr(TextName[1]), 0, 0);
  139.     graf_growbox(TextX + TextW DIV 2 - 5, TextY + TextH DIV 2 - 5, 10, 10, TextX, TextY, TextW, TextH);
  140.     wind_open(textwindow, TextX, TextY, TextW, TextH);
  141.     SetMenuState(s_enable, s_disable, s_enable, s_leave, s_leave);
  142.     wind_update(END_UPDATE)
  143.   end;
  144. end;
  145.  
  146. { Consult CloseGraphicsWindow - they're similar }
  147. procedure CloseTextWindow;
  148. var x, y, w, h : Integer;
  149. begin
  150.   if textwindow >= 0 then begin
  151.     wind_update(BEG_UPDATE);
  152.     wind_get(textwindow, WF_CURRXYWH, x, y, w, h);
  153.     graf_shrinkbox(x + w DIV 2 - 5, y + h DIV 2 - 5, 10, 10, x, y, w, h);
  154.     wind_close(textwindow);
  155.     wind_delete(textwindow);
  156.     textwindow := -1;
  157.     if grafwindow >= 0 then
  158.       SetMenuState(s_leave, s_enable, s_disable, s_leave, s_leave)
  159.     else
  160.       SetMenuState(s_disable, s_enable, s_disable, s_leave, s_leave);
  161.     wind_update(END_UPDATE)
  162.   end
  163. end;
  164.  
  165. procedure SelectGraphicsDemo;
  166. var
  167.   x, y, w, h : Integer;   { dialog border size       }
  168.   selected   : Integer;   { selected demo icon index }
  169. begin
  170.   form_center(selection, x, y, w, h);            { centre of screen }
  171.   form_dial(FMD_START,  0, 0, 0, 0, x, y, w, h); { reserve RAM      }
  172.   form_dial(FMD_GROW,   0, 0, 0, 0, x, y, w, h); { grow box         }
  173.   objc_draw(selection,  0, $7FFF,   x, y, w, h); { draw dialog box  }
  174.   selected := form_do(selection, -1);            { do the dialog    }
  175.   form_dial(FMD_SHRINK, 0, 0, 0, 0, x, y, w, h); { shrink box       }
  176.   form_dial(FMD_FINISH, 0, 0, 0, 0, x, y, w, h); { release RAM      }
  177.   case selected of                       { set currect demo state : }
  178.     BOXES    : demo := BoxesDemo;
  179.     LINES    : demo := LinesDemo;
  180.     ELLIPSES : demo := EllipsesDemo;
  181.     PIES     : demo := PiesDemo
  182.   end;
  183.   ForceGraphicsRedraw        { make sure graphics window is redrawn }
  184. end;
  185.  
  186. procedure RedrawWindow(handle, x0, y0, w0, h0 : Integer);
  187. var
  188.   R1, R2     : Grect;     { used for conversion purposes }
  189.   x, y, w, h : Integer;   { rectangle to redraw          }
  190.   a          : Array_4;   { used for conversion purposes }
  191.  
  192.   { Redraw text window }
  193.   procedure DoTextRedraw;
  194.   var
  195.     x, y, w, h : Integer;    { work area size }
  196.     i          : Integer;
  197.   begin
  198.     wind_get(textwindow, WF_WORKXYWH, x, y, w, h);
  199.     i := CharBoxHeight;         { y-offset to start writing at }
  200.     while i <= (y + h - 1 + CharBoxHeight) do begin
  201.       v_gtext(VDI_handle, x, y + i, TextLine);
  202.       inc(i, CharBoxHeight)     { one line written }
  203.     end
  204.   end;
  205.  
  206.   { Redraw graphics window }
  207.   procedure DoGraphicsRedraw;
  208.   begin
  209.     case demo of
  210.       BoxesDemo    : DoBoxes;
  211.       LinesDemo    : DoLines;
  212.       EllipsesDemo : DoEllipses;
  213.       PiesDemo     : DoPies
  214.     end
  215.   end;
  216.  
  217. begin { RedrawWindow }
  218.   R1.x := x0;  R1.y := y0;  R1.w := w0;  R1.h := h0; { set up R1 }
  219.   wind_update(BEG_UPDATE);            { we're updating!          }
  220.   graf_mouse(M_OFF, NIL);             { and want no mice around! }
  221.   
  222.   { get first rectangle from the window rectangle list : }
  223.   wind_get(handle, WF_FIRSTXYWH, x, y, w, h);
  224.   
  225.   while (w <> 0) and (h <> 0) do begin { there IS a rectangle :  }
  226.     R2.x := x;  R2.y := y;  R2.w := w;  R2.h := h; { set up R2   }
  227.     if intersect(R1, R2) then begin    { is area destroyed?      }
  228.       x    := R2.x;  y    := R2.y;  w    := R2.w;       h    := R2.h;
  229.       a[0] := x;     a[1] := y;     a[2] := x + w - 1;  a[3] := y + h - 1;
  230.       vs_clip(VDI_handle, 1, a);       { set clipping            }
  231.       vsf_color(VDI_handle, White);    { clear work area styles :}
  232.       vsf_interior(VDI_handle, SOLID); {   solid, white fill     }
  233.       v_bar(VDI_handle, a);            { and clear messy rect.   }
  234.       if handle = textwindow then DoTextRedraw else DoGraphicsRedraw
  235.     end;
  236.     
  237.     { one rectangle done, the rest to go! }
  238.     wind_get(handle, WF_NEXTXYWH, x, y, w, h)
  239.   end;
  240.   graf_mouse(M_ON, NIL);    { allright, let's see the mouse again }
  241.   wind_update(END_UPDATE)   { now we're through updating anyway...}
  242. end;
  243.  
  244. procedure TopWindow(handle : Integer);
  245. begin
  246.   wind_set(handle, WF_TOP, 0, 0, 0, 0)  { set handle to top window }
  247. end;
  248.  
  249. { The philosophy is : If window is fulled already, then set it to its
  250.   old size and position, else full it }
  251. procedure FullWindow(handle : Integer);
  252. var
  253.   x,  y,  w,  h  : Integer;   { current size      }
  254.   x0, y0, w0, h0 : Integer;   { max (fulled) size }
  255.   x1, y1, w1, h1 : Integer;   { old size          }
  256. begin
  257.   wind_get(handle, WF_CURRXYWH, x,  y,  w,  h);
  258.   wind_get(handle, WF_FULLXYWH, x0, y0, w0, h0);
  259.   wind_get(handle, WF_PREVXYWH, x1, y1, w1, h1);
  260.   if (x <> x0) or (y <> y0) or (w <> w0) or (h <> h0) then
  261.     wind_set(handle, WF_CURRXYWH, x0, y0, w0, h0)  { full it }
  262.   else
  263.     wind_set(handle, WF_CURRXYWH, x1, y1, w1, h1); { set to previous }
  264.   if handle = grafwindow then ForceGraphicsRedraw
  265. end;
  266.  
  267. procedure CloseWindow(handle : Integer);
  268. begin
  269.   if handle = textwindow then CloseTextWindow else CloseGraphicsWindow
  270. end;
  271.  
  272. procedure CloseTopWindow;
  273. var
  274.   tophandle, dummy : Integer;
  275. begin
  276.   wind_get(0, WF_TOP, tophandle, dummy, dummy, dummy); { get top window }
  277.   CloseWindow(tophandle)                               { close it       }
  278. end;
  279.  
  280. { This could easily be made smarter as GEM puts all four window size
  281.   parameters in the pipe, but for the sake of example... }
  282. procedure MoveWindow(handle, toX, toY : Integer);
  283. var x, y, w, h, dummy : Integer;   { border area size }
  284. begin
  285.   wind_get(handle, WF_CURRXYWH, x, y, w, h); { get x, y, w and h   }
  286.   graf_movebox(w, h, x, y, toX, toY);
  287.   wind_set(handle, WF_CURRXYWH, toX, toY, w, h);     { set new (x,y) }
  288.   if handle = grafwindow then ForceGraphicsRedraw
  289. end;
  290.  
  291. { As above, this also could be made smarter! }
  292. procedure SizeWindow(handle, newW, newH : Integer);
  293. var x, y, w, h : Integer;
  294. begin
  295.   wind_get(handle, WF_CURRXYWH, x, y, w, h);         { get x and y  }
  296.   wind_set(handle, WF_CURRXYWH, x, y, newW, newH);   { set new w, h }
  297.   if handle = grafwindow then ForceGraphicsRedraw
  298. end;
  299.  
  300. begin { of unit DemoWindows }
  301.   GrafName := ' HighSpeed graphics window '#00#00;   { Note! }
  302.   TextName := ' HighSpeed text window '#00#00;
  303.   TextLine := 'The Quick Brown Fox Jumps Over The Very Lazy Dog - a GEM text window'#00;
  304.   TextElements := NAME + CLOSER + FULLER + MOVER + SIZER;
  305.   GrafElements := NAME + CLOSER + FULLER + MOVER + SIZER
  306. end.
  307.