home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPW60.ZIP / TPD60.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-03-15  |  10.6 KB  |  362 lines
  1. uses
  2.   crt,
  3.   tpw60;
  4.  
  5.  
  6. var
  7.   m,i,j,k,f,b,x:integer;
  8.   msg:string[80];
  9.   menu:menurec;
  10.   curntpos,oldcurntpos:integer;
  11.   done : boolean;
  12.   ch:char;
  13.  
  14. procedure fdemo;
  15. begin
  16.   makewindow(4,6,6,25,attr(15,3),attr(15,3),1,0,0,0);
  17.   titlewindow(1,attr(14,3),'[ Frame Style 1 ]');
  18.   makewindow(6,10,6,25,attr(15,5),attr(15,5),2,0,0,0);
  19.   titlewindow(2,attr(14,5),'[ Frame Style 2 ]');
  20.   makewindow(8,14,6,25,attr(15,4),attr(15,4),3,0,0,0);
  21.   titlewindow(3,attr(14,4),'[ Frame Style 3 ]');
  22.   makewindow(10,18,6,25,attr(15,6),attr(15,6),4,0,0,0);
  23.   titlewindow(1,attr(14,6),'[ Frame Style 4 ]');
  24.   makewindow(12,22,6,25,attr(15,2),attr(15,2),5,0,0,0);
  25.   titlewindow(3,attr(14,2),'[ Frame Style 5 ]');
  26.   makewindow(14,26,6,25,attr(15,3),attr(15,3),6,0,0,0);
  27.   titlewindow(1,attr(14,3),'[ Frame Style 6 ]');
  28.   makewindow(16,30,6,25,attr(15,5),attr(15,5),7,0,0,0);
  29.   titlewindow(2,attr(14,5),'[ Frame Style 7 ]');
  30.   makewindow(18,34,6,25,attr(15,4),attr(15,4),8,0,0,0);
  31.   titlewindow(3,attr(14,4),'[ Frame Style 8 ]');
  32.   makewindow(6,44,3,30,attr(15,2),attr(0,2),2,attr(8,7),7,0);
  33.   prtwindow(1,2,'Press and key to return...');
  34.   ch := readkey;
  35.   for x := 1 to 9 do
  36.   begin
  37.     removewindow;
  38.   end;
  39. end;
  40.  
  41. procedure tdemo;
  42. begin
  43.   makewindow(13,5,10,70,attr(15,5),attr(15,5),2,attr(8,7),7,0);
  44.   prtcwindow(5,'Titles may be placed in any of six different locations.');
  45.   for x:=1 to 6 do
  46.   begin
  47.     str(x,msg);
  48.     msg := '[ LOCATION '+MSG+' ]';
  49.     titlewindow(x,attr(11,5),msg);
  50.     delay(1000);
  51.   end;
  52.   makewindow(6,44,3,30,attr(15,2),attr(0,2),2,attr(8,7),7,0);
  53.   prtwindow(1,2,'Press and key to return...');
  54.   ch := readkey;
  55.   removewindow;
  56.   removewindow;
  57. end;
  58.  
  59. procedure sdemo;
  60. begin
  61.   makewindow(13,5,10,70,attr(15,5),attr(15,5),2,attr(8,7),7,0);
  62.   prtcwindow(5,'The window itself can be presented in many');
  63.   prtcwindow(6,'different ways. It can be flat...');
  64.   delay(3000);
  65.   makewindow(7,10,10,30,attr(15,3),attr(0,3),1,0,0,0);
  66.   makewindow(7,45,10,30,attr(15,2),attr(0,2),1,0,0,0);
  67.   delay(3000);
  68.   removewindow;
  69.   removewindow;
  70.   clearwindow;
  71.   prtcwindow(4,'it can have one of many types of shadow underneath');
  72.   prtcwindow(6,'this is SOLID black - type 3 left and 4 right');
  73.   delay(3000);
  74.   makewindow(7,10,10,30,attr(15,3),attr(0,3),2,0,3,0);
  75.   prtcwindow(7,'Left Shadow');
  76.   delay(2000);
  77.   makewindow(7,45,10,30,attr(15,2),attr(0,2),2,0,4,0);
  78.   prtcwindow(7,'Right Shadow');
  79.   delay(2000);
  80.   removewindow;
  81.   removewindow;
  82.   clearwindow;
  83.   prtcwindow(6,'this is SHADOW black - type 1 left and 2 right');
  84.   delay(3000);
  85.   makewindow(7,10,10,30,attr(15,3),attr(0,3),2,8,1,0);
  86.   prtcwindow(7,'Left Shadow');
  87.   delay(2000);
  88.   makewindow(7,45,10,30,attr(15,2),attr(0,2),2,8,2,0);
  89.   prtcwindow(7,'Right Shadow');
  90.   delay(2000);
  91.   removewindow;
  92.   removewindow;
  93.   clearwindow ;
  94.   prtcwindow(6,'this is LT. HATCH - type 5 left and 6 right');
  95.   delay(3000);
  96.   makewindow(7,10,10,30,attr(15,3),attr(0,3),2,attr(0,7),5,0);
  97.   prtcwindow(7,'Left Shadow');
  98.   delay(2000);
  99.   makewindow(7,45,10,30,attr(15,2),attr(0,2),2,attr(0,7),6,0);
  100.   prtcwindow(7,'Right Shadow');
  101.   delay(2000);
  102.   removewindow;
  103.   removewindow;
  104.   clearwindow ;
  105.   prtcwindow(6,'this is MED. HATCH - type 7 left and 8 right');
  106.   delay(3000);
  107.   makewindow(7,10,10,30,attr(15,3),attr(0,3),2,attr(0,7),7,0);
  108.   prtcwindow(7,'Left Shadow');
  109.   delay(2000);
  110.   makewindow(7,45,10,30,attr(15,2),attr(0,2),2,attr(0,7),8,0);
  111.   prtcwindow(7,'Right Shadow');
  112.   delay(2000);
  113.   removewindow;
  114.   removewindow;
  115.   clearwindow ;
  116.   prtcwindow(6,'this is HEAVY HATCH - type 9 left and 10 right');
  117.   delay(3000);
  118.   makewindow(7,10,10,30,attr(15,3),attr(0,3),2,attr(0,7),9,0);
  119.   prtcwindow(7,'Left Shadow');
  120.   delay(2000);
  121.   makewindow(7,45,10,30,attr(15,2),attr(0,2),2,attr(0,7),10,0);
  122.   prtcwindow(7,'Right Shadow');
  123.   delay(2000);
  124.   removewindow;
  125.   removewindow;
  126.   clearwindow ;
  127.   prtcwindow(3,'Any combination of attributes and types');
  128.   prtcwindow(4,'can be used.');
  129.   makewindow(6,44,3,30,attr(15,2),attr(0,2),2,attr(8,7),7,0);
  130.   prtwindow(1,2,'Press and key to return...');
  131.   ch := readkey;
  132.   removewindow;
  133.   removewindow;
  134. end;
  135.  
  136. procedure edemo;
  137. begin
  138.   makewindow(13,5,10,70,attr(15,5),attr(15,5),2,attr(8,7),7,0);
  139.   prtcwindow(3,'Windows can be popped');
  140.   prtcwindow(4,'onto the screen.');
  141.   delay(2000);
  142.   makewindow(2,2,15,60,attr(0,2),attr(14,2),2,0,0,0);
  143.   delay(2000);
  144.   makewindow(13,10,10,60,attr(1,3),attr(15,3),3,0,0,0);
  145.   delay(2000);
  146.   makewindow(7,33,10,45,attr(14,5),attr(14,5),1,0,0,0);
  147.   delay(2000);
  148.   delay(3000);
  149.   for x := 1 to 3 do
  150.   begin
  151.     removewindow;
  152.   end;
  153.   clearwindow;
  154.   prtcwindow(3,'Windows can be zoomed');
  155.   prtcwindow(4,'onto the screen.');
  156.   delay(2000);
  157.   makewindow(2,2,15,60,attr(0,2),attr(14,2),2,0,0,1);
  158.   delay(2000);
  159.   makewindow(13,10,10,60,attr(1,3),attr(15,3),3,0,0,1);
  160.   delay(2000);
  161.   makewindow(7,33,10,45,attr(14,5),attr(14,5),1,0,0,1);
  162.   delay(2000);
  163.   makewindow(7,10,12,63,attr(15,4),attr(14,4),2,0,2,1);
  164.   prtcwindow(5,'HOW ABOUT THAT !!!');
  165.   delay(3000);
  166.   for x := 1 to 4 do
  167.   begin
  168.     removewindow;
  169.   end;
  170.   makewindow(6,44,3,30,attr(15,2),attr(0,2),2,attr(8,7),7,0);
  171.   prtwindow(1,2,'Press and key to return...');
  172.   ch := readkey;
  173.   removewindow;
  174.   removewindow;
  175. end;
  176.  
  177. procedure flhelp;
  178. begin
  179.   makewindow(14,10,9,55,attr(0,2),attr(0,2),2,attr(8,7),7,1);
  180.   titlewindow(2,attr(14,2),'[ FIRST LETTER ]');
  181.   prtwindow(1,2,'To activate First Letter control you must set two');
  182.   prtwindow(2,2,'variables.  FLOn must be set to true and you can');
  183.   prtwindow(3,2,'set FLattr to the desired color you wish.  Thats');
  184.   prtwindow(4,2,'all there is to it.  Just be sure all strings begin');
  185.   prtwindow(5,2,'with a different letter.');
  186.   prtwindow(7,2,'Press enter to return...');
  187.   ch := readkey;
  188.   removewindow;
  189. end;
  190.  
  191. procedure barhelp;
  192. begin
  193.   makewindow(14,10,9,55,attr(0,2),attr(0,2),2,attr(8,7),7,1);
  194.   titlewindow(2,attr(14,2),'[ MENUBARS ]');
  195.   prtwindow(1,2,'There are currently four menu bar types:');
  196.   prtwindow(2,2,'  0 - No visible bar    1 - Full width bar');
  197.   prtwindow(3,2,'  2 - String width bar  3 - Pointer');
  198.   prtwindow(4,2,'You control what type is active by setting BarType');
  199.   prtwindow(5,2,'equal to the type desired.');
  200.   prtwindow(7,2,'Press enter to return...');
  201.   ch := readkey;
  202.   removewindow;
  203. end;
  204.  
  205. procedure generalhelp;
  206. begin
  207.   makewindow(14,10,9,55,attr(0,2),attr(0,2),2,attr(8,7),7,1);
  208.   titlewindow(2,attr(14,2),'[ GENERAL ]');
  209.   prtwindow(1,2,'Remember MakeMenu is only a procedure executed in a');
  210.   prtwindow(2,2,'predefined window so all window effects can be used');
  211.   prtwindow(3,2,'to enhance your menu.  Including border and shadow,');
  212.   prtwindow(4,2,'as well as growing and all various color attribute');
  213.   prtwindow(5,2,'combinations.  The choices are almost endless!');
  214.   prtwindow(7,2,'Press enter to return...');
  215.   ch := readkey;
  216.   removewindow;
  217. end;
  218.  
  219. procedure mdemo;
  220. begin
  221.   makewindow(6,50,6,17,attr(14,5),attr(14,5),2,attr(8,7),7,0);
  222.   titlewindow(2,attr(15,5),'[ MENUS ]');
  223.   done := false;
  224.   with menu do
  225.   begin
  226.     oldcurntpos := curntpos;
  227.     curntpos := 0;
  228.     while not done do
  229.     begin
  230.       item[1] := 'First Letter';
  231.       item[2] := 'Menu Bars   ';
  232.       item[3] := 'General     ';
  233.       item[4] := 'Return      ';
  234.       itemcount := 4;
  235.       startpos := 1;
  236.       hlattr := attr(0,7);
  237.       flattr := attr(15,5);
  238.       flon := true;
  239.       bartype := 1;
  240.       makemenu(menu);
  241.       case curntpos of
  242.         1 : flhelp;
  243.         2 : barhelp;
  244.         3 : generalhelp;
  245.       else
  246.         removewindow;
  247.         curntpos := oldcurntpos;
  248.         done := true;
  249.       end;
  250.     end;
  251.     done := false;
  252.   end;
  253. end;
  254.  
  255.  
  256. begin
  257.   textmode(1);
  258.   cursorchange(hidecursor,oldcursor);
  259.   randomize;
  260.   TPWborder(7);
  261.   tpwfill(1,1,25,40,' ',attr(0,7));
  262.  
  263.   makewindow(2,4,7,15,attr(0,2),attr(10,2),2,attr(8,0),7,1);
  264.   tpwprint(5,9,'T',attr(15,2));
  265.   tpwprint(5,10,'URBO',attr(10,2));
  266.   delay(2000);
  267.   makewindow(7,10,7,15,attr(15,4),attr(12,4),2,attr(8,0),7,1);
  268.   tpwprint(10,15,'P',attr(15,4));
  269.   tpwprint(10,16,'ASCAL',attr(12,4));
  270.   delay(2000);
  271.   makewindow(12,16,7,15,attr(0,3),attr(11,3),2,attr(8,0),7,1);
  272.   tpwprint(15,20,'W',attr(15,3));
  273.   tpwprint(15,21,'INDOWS',attr(11,3));
  274.   delay(2000);
  275.   makewindow(17,22,7,15,attr(15,1),attr(9,1),2,attr(8,0),7,1);
  276.   prtcwindow(3,'6.0');
  277.   delay(4000);
  278.   removewindow;
  279.   delay(1000);
  280.   removewindow;
  281.   delay(1000);
  282.   removewindow;
  283.   delay(1000);
  284.   removewindow;
  285.   textmode(3);
  286.   cursorchange(hidecursor,oldcursor);
  287.   randomize;
  288.   tpwborder(1);
  289.   tpwfill(1,1,25,80,' ',attr(7,1));
  290.   makewindow(4,15,10,30,attr(4,3),attr(4,3),4,attr(8,0),1,1);
  291.   makewindow(3,36,13,40,attr(15,2),attr(15,2),3,attr(8,0),1,1);
  292.   makewindow(9,10,13,40,attr(0,5),attr(0,5),2,attr(8,0),1,1);
  293.   makewindow(12,42,11,36,attr(3,4),attr(3,4),1,attr(8,0),1,1);
  294.   makewindow(3,5,7,40,attr(0,7),attr(1,7),2,attr(8,0),1,1);
  295.   prtcwindow(3,'Presenting...');
  296.   delay(4000);
  297.   makewindow(8,20,7,40,attr(0,7),attr(1,7),2,attr(8,0),1,1);
  298.   prtcwindow(1,'T P W');
  299.   prtcwindow(2,'6.0');
  300.   prtcwindow(4,'Windowing Routines for the');
  301.   prtcwindow(5,'Borland Turbo PASCAL Ver. 4 Compiler');
  302.   delay(3000);
  303.   makewindow(17,55,7,24,attr(0,2),attr(10,2),1,attr(8,0),1,1);
  304.   prtwindow(1,2,'By:');
  305.   prtcwindow(3,'Rick Fothergill');
  306.   prtcwindow(4,'141 Oak Hill Road');
  307.   prtcwindow(5,'Pittsfield, MA 01201');
  308.   delay(4000);
  309.   for x := 1 to 7 do
  310.   begin
  311.     removewindow;
  312.   end;
  313.   tpwfill(1,1,25,80,' ',attr(0,7));
  314.   tpwborder(7);
  315.   done := false;
  316.   makebox(2,40,3,35,attr(11,4),attr(12,4),3,0,0,0);
  317.   tpwprintc(3,41,75,'TPW60 Demo',attr(15,4));
  318.   makewindow(3,5,8,15,attr(15,1),attr(15,1),2,ATTR(8,7),7,0);
  319.   titlewindow(2,attr(15,1),'[ MAIN MENU ]');
  320.   with menu do
  321.   begin
  322.     curntpos := 0;
  323.     while not done do
  324.     begin
  325.       item[1] := 'Frames ';
  326.       item[2] := 'Titles ';
  327.       item[3] := 'Shadows';
  328.       item[4] := 'Effects';
  329.       item[5] := 'Menus  ';
  330.       item[6] := 'Quit   ';
  331.       itemcount := 6;
  332.       startpos := 1;
  333.       hlattr  := attr(15,1);
  334.       flattr  := attr(14,1);
  335.       flon := true;
  336.       bartype := 3;
  337.       makemenu(menu);
  338.       case curntpos of
  339.         1 : fdemo;
  340.         2 : tdemo;
  341.         3 : sdemo;
  342.         4 : edemo;
  343.         5 : mdemo;
  344.       else
  345.         removewindow;
  346.         curntpos := oldcurntpos;
  347.         tpwborder(1);
  348.         tpwfill(1,1,43,80,' ',attr(15,1));
  349.         makewindow(9,16,8,52,attr(0,7),attr(1,7),2,0,0,0);
  350.         prtcwindow(3,'T P W');
  351.         prtcwindow(4,'6.0');
  352.         delay(3000);
  353.         removewindow;
  354.         done := true;
  355.       end;
  356.     end;
  357.   end;
  358. cursorchange(oldcursor,hidecursor);
  359. tpwborder(0);
  360. clrscr;
  361. end.
  362.