home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / maj / 4437 / demo / demo08.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  8KB  |  226 lines
  1. Program Demo08;
  2.  
  3. { SPX library - GUI demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. {$X+ }  { Enable extended syntax }
  6.  
  7. Uses crt,spx_vga,spx_gui,spx_fnc,spx_txt,mouse;
  8.  
  9. var
  10.   i      : Tobjlist;           { Data structure to hold objects }
  11.   cradio : integer;            { variable to keep track of which }
  12.                                { radio button is enabled }
  13.  
  14. { Initalize variables and create buttons, scrollers, etc }
  15. procedure setbuttons;
  16. var
  17.   p : pbutton;
  18. begin
  19.   i.init;      { init object structure }
  20.   cradio := 5; { Set radios to Default }
  21.   with i do
  22.     begin
  23.      { create buttons }
  24.       addobject(new(pbutton,init(20,20,65,20,1,#27,false,'|ESC| Quit')));
  25.       addobject(new(pbutton,init(20,40,65,20,2,'2',false,'Button 2')));
  26.      { create radio and check buttons }
  27.       addobject(new(pradio,init(90,20,65,20,5,1,'5',false,'Default |5|',cradio=5)));
  28.       addobject(new(pradio,init(90,40,65,20,6,1,'6',false,'Sienna |6|',cradio=6)));
  29.       addobject(new(pradio,init(90,60,65,20,7,1,'7',false,'Random |7|',cradio=7)));
  30.       addobject(new(pcheck,init(20,60,65,20,4,'4',false,'Chk box |4|',false)));
  31.      { create scrollers }
  32.       addobject(new(pscroll,init(20,100,100,15,8,1,100,1,50,true)));
  33.       addobject(new(pscroll,init(160,20,15,100,9,1,100,2,50,false)));
  34.      { create pick box }
  35.       addobject(new(ppbox,init(180,20,100,10,10,'Pick Box')));
  36.      { create string input boxes }
  37.       addobject(new(pstring,init(20,80,100,20,3,'3',false,'String','Scott',10)));
  38.       p := addobject(new(pstring,init(20,120,40,18,11,#0,false,'','50',3)));
  39.      { modify horizontal placement of string in object }
  40.       pstring(p)^.objectx := center;
  41.     end;
  42. end;
  43.  
  44.  
  45. { Setup program }
  46. procedure setup;
  47. begin
  48.   openmode(2);   { open graphics mode with 1 virtual page }
  49.   randomize;     { set random seed }
  50.   cls(cl[1]);    { clear screen to desktop color }
  51.   setbuttons;    { set object buttons }
  52.   mousereset;    { init mouse routines }
  53.   normalizemx;   { adjust horizontal resolution.  NOTE: Some mouse }
  54.                  {  drivers set the mouse range to 0..639 instead }
  55.                  {  of 0..319 in mode 13h }
  56.   setdefptr;     { Set the default mouse pointer shape }
  57.   mouseon;       { Make the mouse pointer visible }
  58. end;
  59.  
  60.  
  61. { Redraw the screen and objects: Draw on page 2 then update to }
  62. { reduce redrawing flicker }
  63. procedure redrawscreen;
  64. begin
  65.   setpageactive(2);     { set to page 2 }
  66.   cls(cl[1]);           { clear the screen }
  67.   i.showall;            { draw all objects }
  68.   mouseoff;             { hide the mouse }
  69.   pcopy(2,1);           { update the visual page }
  70.   mouseon;              { turn the mouse back on }
  71.   setpageactive(1);     { set page 1 as the active page }
  72. end;
  73.  
  74.  
  75. { Check the return handle values and does the button's functions }
  76. procedure CheckButtons(pr:integer;p:pbutton);
  77. { pr:integer;  Handle number of the object that was activated }
  78. { p:pbutton;   pointer to the activated object }
  79. var
  80.   s            : string;
  81.   randomcolors : wcolortypes;
  82.   t            : integer;
  83. begin
  84.   with i do
  85.     case pr of
  86.      { button - call disk dialog box }
  87.       2 : begin
  88.             s := diskdo(24,10,'','*','Enter file name to load',true);
  89.             if s<>''
  90.               then message('File is '+s,true);
  91.           end;
  92.      { check box - add an item to the pick box if the box is checked }
  93.       4 : if pcheck(p)^.tchk
  94.             then
  95.               begin
  96.                { get a pointer to the pick box object }
  97.                 p := retobject(10);
  98.                { add a string to the pick box }
  99.                 ppbox(p)^.additem('scott '+lz(ppbox(p)^.getcount+1,3),0,true);
  100.                { clear keyboard buffer and mouse presses }
  101.                 clearbuffer;
  102.               end;
  103.      { radio buttons - changes color only if random radio is selected or }
  104.      {  the radio was not selected }
  105.       5,6,7 : if (cradio<>pr) or (pr=7)
  106.                 then
  107.                   begin
  108.                     cradio := pr; { set the new radio button as selected }
  109.                     case pr of
  110.                       5 : menucolors := defaultcolors; { set default colors }
  111.                       6 : menucolors := burntsienna;   { set burnt color }
  112.                       7 : begin                        { set random colors }
  113.                             for t := 0 to 7 do
  114.                               with randomcolors[t] do
  115.                                 begin
  116.                                   red := random(63);
  117.                                   green := random(63);
  118.                                   blue := random(63);
  119.                                 end;
  120.                             menucolors := randomcolors;
  121.                           end;
  122.                     end;
  123.                     adjustmenupalette; { try to match sys colors with the }
  124.                                        {  current palette }
  125.                     redrawscreen;      { Redraw the screen with the new }
  126.                                        {  colors }
  127.                   end;
  128.      { Vertical scroller - update the string object }
  129.       9 : begin
  130.             t := pscroll(p)^.bpos; { grab the scroller position }
  131.             p := retobject(11);    { get a pointer to the string object }
  132.            { change the string value if the scroller value has changed }
  133.             if vl(pstring(p)^.tstr)<>t
  134.               then
  135.                 begin
  136.                   pstring(p)^.tstr := st(t); { change the string data to the }
  137.                                              {  scroller value }
  138.                   mouseoff;                  { hide mouse }
  139.                   p^.drawitemobject;         { redraw string object }
  140.                   mouseon;                   { display mouse }
  141.                 end;
  142.           end;
  143.      { pick box - display string picked }
  144.       10 : message('"Pick Box": '+ppbox(p)^.lhstr,true);
  145.      { string object - validate text entry, and update scroller }
  146.       11 : begin
  147.              t := vl(pstring(p)^.tstr);  { grab text string }
  148.              if not between(t,1,100)     { check for legal values }
  149.                then
  150.                  begin
  151.                   { bad value? Set the string to the current scroller pos }
  152.                    pstring(p)^.tstr := st(pscroll(retobject(9))^.bpos);
  153.                    mouseoff;
  154.                    p^.drawitemobject; { draw string object }
  155.                    mouseon;
  156.                  end
  157.               else
  158.                  begin
  159.                   { good value. }
  160.                    p := retobject(9); { get a pointer to the scroller }
  161.                    pscroll(p)^.bpos := t; { change the scroller position }
  162.                    mouseoff;
  163.                    p^.drawitemobject;     { redraw the scroller }
  164.                    mouseon;
  165.                  end;
  166.            end;
  167.     end;
  168. end;
  169.  
  170.  
  171. { Event loop }
  172. procedure eventloop;
  173. var
  174.   pr : integer; { keeps track of return handles }
  175.   p  : pbutton; { pointer to any activated objects }
  176. begin
  177.   redrawscreen; { draw screen }
  178.   with i do
  179.     repeat
  180.       inkey;                 { grab, keyboard and mouse values }
  181.       pr := CheckPress(p);   { scan, objects for actvation }
  182.       if pr<>0               { if CHECKPRESS returns a non-zero val, }
  183.                              { then an object was pressed or activated }
  184.         then CheckButtons(pr,p); { handle object }
  185.     until (pr=1) and yes('Quit SPXGUI test?'); { ask if want to quit. }
  186. end;
  187.  
  188.  
  189. { do some clean up }
  190. procedure cleanup;
  191. begin
  192.   i.done;    { deallocate object variables }
  193.   closemode; { close graphics mode }
  194. end;
  195.  
  196.  
  197. procedure showit;
  198. var
  199.   i : tObjList;
  200. begin
  201.   clrscr;
  202.   writeln('SPX library - GUI demo');
  203.   writeln('Copyright 1993 Scott D. Ramsay');
  204.   writeln;
  205.   writeln('Use mouse or keyboard to pick selections');
  206.   writeln(' Press the ESC or Click on Quit button to exit');
  207.   writeln;
  208.   write('Press SPACE to continue.');
  209.   i.init;
  210.   with i.io^ do
  211.     begin
  212.       clearbuffer;
  213.       repeat
  214.         inkey;
  215.       until (ch=' ') and not funct;
  216.     end;
  217.   i.done;
  218. end;
  219.  
  220.  
  221. begin
  222.   showit;
  223.   setup;
  224.   eventloop;
  225.   cleanup;
  226. end.