home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TW200D.ZIP / TD200.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-09  |  17.6 KB  |  599 lines
  1. {
  2.  TW200 VIDEO, WINDOW AND MENU PROCEDURES AND FUNCTIONS
  3.  TURBO PASCAL VERSION 5.X DEMONSTRATION PROGRAM
  4.  COPYRIGHT (C) 1990, RICHARD D. FOTHERGILL  ALL RIGHTS RESERVED
  5. }
  6.  
  7. USES
  8.   Dos,
  9.   Crt,
  10.   TW200;
  11.  
  12. VAR
  13.   mmenu       : hmenurec;
  14.   smenu       : vmenurec;
  15.   emenu       : vmenurec;
  16.   done        : BOOLEAN;
  17.   menunoattr  : INTEGER;
  18.   curattr     : INTEGER;
  19.   x           : INTEGER;
  20.   msg,msg1    : STRING[80];
  21.   ch          : CHAR;
  22.  
  23. PROCEDURE Initmenus;
  24. BEGIN
  25.   menunoattr := Attr(8,7);
  26.   winspeed := 3500;
  27.   WITH mmenu DO
  28.   BEGIN
  29.     curntpos   := 0;
  30.     item[1]    := 'Frames';
  31.     item[2]    := 'Titles';
  32.     item[3]    := 'Shadows';
  33.     item[4]    := 'Demos';
  34.     item[5]    := 'Quit';
  35.     itemcount  := 5;
  36.     startpos   := 1;
  37.     hlattr     := Attr(7,0);
  38.     flattr     := Attr(15,7);
  39.     flon       := TRUE;
  40.     menuspaces := 8;
  41.     barloc     := 0;
  42.     subitem    :='00110';
  43.   END;
  44.   WITH smenu DO
  45.   BEGIN
  46.     startpos   := 0;
  47.     liveitem   := '11011011';
  48.     curntpos   := 0;
  49.     item[1]    := 'Flat         (   0)';
  50.     item[2]    := 'Reattribute  (1, 2)';
  51.     item[3]    := 'Solid        (3, 4)';
  52.     item[4]    := 'Light Hatch  (5, 6)';
  53.     item[5]    := 'Medium Hatch (7, 8)';
  54.     item[6]    := 'Heavy Hatch  (9,10)';
  55.     item[7]    := 'Activate Items 3,6 ';
  56.     item[8]    := 'Deact. Items   3,6 ';
  57.     itemcount  := 8;
  58.     hlattr     := Attr(7,0);
  59.     flattr     := Attr(15,7);
  60.     noattr     := menunoattr;
  61.     bartype    := 1;
  62.     flon       := TRUE;
  63.   END;
  64.   WITH emenu DO
  65.   BEGIN
  66.     startpos   := 0;
  67.     liveitem   := '11111';
  68.     curntpos   := 0;
  69.     item[1]    := 'Pop Windows       ';
  70.     item[2]    := 'Zoom Windows      ';
  71.     item[3]    := 'List / File Window';
  72.     item[4]    := 'DOS Utilities     ';
  73.     item[5]    := 'Field Input       ';
  74.     itemcount  := 5;
  75.     hlattr     := Attr(7,0);
  76.     flattr     := Attr(15,7);
  77.     noattr     := menunoattr;
  78.     bartype    := 1;
  79.     flon       := TRUE;
  80.   END;
  81. END;
  82.  
  83. PROCEDURE Continue;
  84. VAR
  85.   ch1,ch2 : CHAR;
  86. BEGIN
  87.   Sprintc(25,1,80,'             Press any key to continue...            ',Attr(15,3));
  88.   REPEAT
  89.     Getkey(ch1,ch2);
  90.   UNTIL ch1 <> #0;
  91.   Sprintc(25,1,80,'Use arrow keys to change selection - Return to select',Attr(0,3));
  92. END;
  93.  
  94. PROCEDURE Fdemo;
  95. BEGIN
  96.   Openwin(5,15,6,15,Attr(15,2),Attr(15,2),0,0,1,0);
  97.   Titlewin(2,Attr(14,2),'[ Style 0 ]');
  98.   Openwin(5,34,6,15,Attr(15,5),Attr(15,5),1,7,1,0);
  99.   Titlewin(2,Attr(14,5),'[ Style 1 ]');
  100.   Openwin(5,53,6,15,Attr(15,3),Attr(15,3),2,7,1,0);
  101.   Titlewin(2,Attr(14,3),'[ Style 2 ]');
  102.   Openwin(8,5,6,15,Attr(15,4),Attr(15,4),3,7,1,0);
  103.   Titlewin(2,Attr(14,4),'[ Style 3 ]');
  104.   Openwin(8,24,6,15,Attr(15,3),Attr(15,3),4,7,1,0);
  105.   Titlewin(2,Attr(14,3),'[ Style 4 ]');
  106.   Openwin(8,43,6,15,Attr(15,6),Attr(15,6),5,7,1,0);
  107.   Titlewin(2,Attr(14,6),'[ Style 5 ]');
  108.   Openwin(8,62,6,15,Attr(15,5),Attr(15,5),6,7,1,0);
  109.   Titlewin(2,Attr(14,5),'[ Style 6 ]');
  110.   Openwin(11,15,6,15,Attr(15,2),Attr(15,2),7,7,1,0);
  111.   Titlewin(2,Attr(14,2),'[ Style 7 ]');
  112.   Openwin(11,34,6,15,Attr(15,7),Attr(15,7),8,7,1,0);
  113.   Titlewin(2,Attr(14,7),'[ Style 8 ]');
  114.   Openwin(11,53,6,15,Attr(15,4),Attr(15,4),9,7,1,0);
  115.   Titlewin(2,Attr(14,4),'[ Style 9 ]');
  116.   Openwin(14,5,6,15,Attr(15,7),Attr(15,7),10,7,1,0);
  117.   Titlewin(2,Attr(14,7),'[ Style 10]');
  118.   Openwin(14,24,6,15,Attr(15,6),Attr(15,6),11,7,1,0);
  119.   Titlewin(2,Attr(14,6),'[ Style 11]');
  120.   Openwin(14,43,6,15,Attr(15,5),Attr(15,5),12,7,1,0);
  121.   Titlewin(2,Attr(14,5),'[ Style 12]');
  122.   Openwin(14,62,6,15,Attr(15,2),Attr(15,2),13,7,1,0);
  123.   Titlewin(2,Attr(14,2),'[ Style 13]');
  124.   Openwin(17,15,6,15,Attr(15,3),Attr(15,3),14,7,1,0);
  125.   Titlewin(2,Attr(14,3),'[ Style 14]');
  126.   Openwin(17,34,6,15,Attr(15,2),Attr(15,2),15,7,1,0);
  127.   Titlewin(2,Attr(14,2),'[ Style 15]');
  128.   Openwin(17,53,6,15,Attr(15,7),Attr(15,7),16,7,1,0);
  129.   Titlewin(2,Attr(14,7),'[ Style 16]');
  130.   Continue;
  131.   FOR x := 1 TO 17 DO Closewin;
  132. END;
  133.  
  134. PROCEDURE Tdemo;
  135. BEGIN
  136.   Openwin(8,8,10,68,Attr(15,5),Attr(15,5),2,0,1,0);
  137.   Printcwin(3,'Titles may be placed in any of six different locations');
  138.   Printcwin(4,'and in any color attribute!');
  139.   FOR x:=1 TO 6 DO
  140.   BEGIN
  141.     STR(x,msg);
  142.     msg := '[ LOCATION '+msg+' ]';
  143.     Titlewin(x,Attr(9+x,5),msg);
  144.     DELAY(1000);
  145.   END;
  146.   Continue;
  147.   Closewin;
  148. END;
  149.  
  150. PROCEDURE Sdemo;
  151. BEGIN
  152.   Openwin(2,32,10,23,Attr(0,7),Attr(0,7),1,8,1,0);
  153.   done := FALSE;
  154.   WITH smenu DO
  155.   BEGIN
  156.     WHILE NOT done DO
  157.     BEGIN
  158.       Makevmenu(smenu);
  159.       CASE curntpos OF
  160.         1 : BEGIN
  161.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  162.               Titlewin(2,Attr(15,5),' FLAT ');
  163.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),1,0,0,0);
  164.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),1,0,0,0);
  165.               Continue;
  166.               Closewin;
  167.               Closewin;
  168.               Closewin;
  169.             END;
  170.         2 : BEGIN
  171.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  172.               Titlewin(2,Attr(15,5),' REATTRIBUTE ');
  173.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,7,1,0);
  174.               Printcwin(7,'Left Shadow');
  175.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,7,2,0);
  176.               Printcwin(7,'Right Shadow');
  177.               Continue;
  178.               Closewin;
  179.               Closewin;
  180.               Closewin;
  181.             END;
  182.         3 : BEGIN
  183.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  184.               Titlewin(2,Attr(15,5),' SOLID ');
  185.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,0,3,0);
  186.               Printcwin(7,'Left Shadow');
  187.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,0,4,0);
  188.               Printcwin(7,'Right Shadow');
  189.               Continue;
  190.               Closewin;
  191.               Closewin;
  192.               Closewin;
  193.             END;
  194.         4 : BEGIN
  195.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  196.               Titlewin(2,Attr(15,5),' LT. HATCH ');
  197.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),5,0);
  198.               Printcwin(7,'Left Shadow');
  199.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),6,0);
  200.               Printcwin(7,'Right Shadow');
  201.               Continue;
  202.               Closewin;
  203.               Closewin;
  204.               Closewin;
  205.             END;
  206.         5 : BEGIN
  207.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  208.               Titlewin(2,Attr(15,5),' MED. HATCH ');
  209.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),7,0);
  210.               Printcwin(7,'Left Shadow');
  211.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),8,0);
  212.               Printcwin(7,'Right Shadow');
  213.               Continue;
  214.               Closewin;
  215.               Closewin;
  216.               Closewin;
  217.             END;
  218.         6 : BEGIN
  219.               Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
  220.               Titlewin(2,Attr(15,5),' HEAVY HATCH ');
  221.               Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),9,0);
  222.               Printcwin(7,'Left Shadow');
  223.               Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),10,0);
  224.               Printcwin(7,'Right Shadow');
  225.               Continue;
  226.               Closewin;
  227.               Closewin;
  228.               Closewin;
  229.             END;
  230.         7 : BEGIN
  231.               liveitem[3] := '1';
  232.               liveitem[6] := '1';
  233.             END;
  234.         8 : BEGIN
  235.               liveitem[3] := '0';
  236.               liveitem[6] := '0';
  237.             END;
  238.       ELSE
  239.         Closewin;
  240.         done := TRUE;
  241.       END;
  242.     END;
  243.     done := FALSE;
  244.   END;
  245. END;
  246.  
  247. PROCEDURE Showfile;
  248. VAR
  249.   sourcename  : PATHSTR;
  250.   source      : TEXT;
  251.   txtstr      : STRING;
  252.   txtarray    : Lstarray;
  253.   numoflns    : INTEGER;
  254.   retcode     : INTEGER;
  255.  
  256. PROCEDURE Addarec(s:STRING);
  257. BEGIN
  258.   Inc(numoflns);
  259.   NEW(txtarray[numoflns]);
  260.   txtarray[numoflns]^ := s;
  261. END;
  262.  
  263. BEGIN
  264.   numoflns := 0;
  265.   sourcename := '';
  266.   Openwin(10,20,7,41,Attr(0,7),Attr(1,7),2,Attr(7,0),1,0);
  267.   Titlewin(5,Attr(1,7),' Press Enter for Directory ');
  268.   Printcwin(2,'Enter a Text File Name to Display');
  269.   capson := TRUE;
  270.   Cursoron;
  271.   Getfield(4,10,sourcename,'S',20,0,retcode,Attr(15,1),Attr(0,7));
  272.   Cursoroff;
  273.   capson := FALSE;
  274.   Closewin;
  275.   IF retcode <> 0 THEN
  276.   BEGIN
  277.     IF sourcename[1] = #32 THEN
  278.       sourcename := Makefmenu('*.*',5,10,17,Attr(1,7),Attr(1,7),2,Attr(7,0),1,0,Attr(7,1));
  279.     IF sourcename <> '' THEN
  280.     BEGIN
  281.       IF Fexists(sourcename) THEN
  282.       BEGIN
  283.         ASSIGN(source,sourcename);
  284.         RESET(source);
  285.         MARK(heaptop);
  286.         REPEAT
  287.           {$I-} READLN(source,txtstr); {$I+}
  288.           IF IORESULT = 0 THEN
  289.           BEGIN
  290.             IF LENGTH(txtstr) > 76 THEN
  291.             BEGIN
  292.               msg := COPY(txtstr,1,76);
  293.               Addarec(msg);
  294.               msg := COPY(txtstr,77,LENGTH(txtstr)-76);
  295.               Addarec(msg);
  296.             END
  297.             ELSE Addarec(txtstr);
  298.           END;
  299.         UNTIL EOF(source);
  300.         CLOSE(source);
  301.         sourcename := Fexpand(sourcename);
  302.         Openwin(1,1,25,80,Attr(7,0),Attr(15,1),0,0,0,0);
  303.         Titlewin(1,Attr(15,1),'LIST DEMO');
  304.         Titlewin(3,Attr(15,1),sourcename);
  305.         Titlewin(5,Attr(15,1),'Direction Keys to Change Location - Esc or Return to End');
  306.         x := Makelmenu(txtarray,numoflns,1,Attr(0,7));
  307.         Closewin;
  308.         RELEASE(heaptop);
  309.       END
  310.       ELSE
  311.       BEGIN
  312.         Openwin(10,20,5,40,Attr(15,4),Attr(15,4),2,Attr(7,0),1,0);
  313.         Printcwin(2,'FILE NOT FOUND - PROCEDURE ABORTED!');
  314.         Continue;
  315.         Closewin;
  316.       END;
  317.     END;
  318.   END;
  319. END;
  320.  
  321. PROCEDURE Ddemo;
  322.   VAR
  323.     dirinfo : SEARCHREC;
  324. BEGIN
  325.  Openwin(1,1,24,80,Attr(7,1),Attr(7,1),0,0,0,0);
  326.  WRITELN;
  327.  WRITELN;
  328.  WRITELN;
  329.  WRITELN('      The following is a sampling of the DOS functions available');
  330.  WRITELN('      in TW200.  For a better understanding of how to use the');
  331.  WRITELN('      information returned by these functions consult any of the');
  332.  WRITELN('      reference books on DOS interrupts.  You must have a good');
  333.  WRITELN('      understanding of DOS interrupts to take full advantage of');
  334.  WRITELN('      these utilities.');
  335.  Continue;
  336.  CLRSCR;
  337.  GOTOXY(1,1);
  338.  WRITELN(' THE DEFAULT DRIVE IS ',Curdrive);
  339.  WRITELN;
  340.  WRITELN(' THE CURRENT DIRECTORY PATH IS ',Curdir);
  341.  WRITELN;
  342.  WRITELN(' FILES in THIS DIRECTORY ARE:');
  343.  WRITELN;
  344.  Findfirst('*.*'+#0,$20,dirinfo);
  345.  WRITE(Falign(dirinfo.name),' ');
  346.  WHILE doserror = 0 DO
  347.  BEGIN
  348.    Findnext(dirinfo);
  349.    WRITE(Falign(dirinfo.name),' ');
  350.  END;
  351.  WRITELN;
  352.  WRITELN;
  353.  WRITELN(' THE CURRENT DOS VERSION IS ',LO(Dosversion),'.',HI(Dosversion));
  354.  WRITELN(' CURRENT DISK SIZE    ',Disksize(0):20);
  355.  WRITELN(' DISK SPACE AVAILABLE ',Diskfree(0):20);
  356.  WRITELN(' CONV MEMORY SIZE     ',Maxmem:20);
  357.  WRITELN(' AVAILABLE MEMORY     ',MEMAVAIL:20);
  358.  Continue;
  359.  Closewin;
  360. END;
  361.  
  362. PROCEDURE Idemo;
  363.  
  364. CONST
  365.   info : ARRAY[1..3] OF fldtype
  366.          = ('N0221092',
  367.             'N0324062',
  368.             'N0426040');
  369. VAR
  370.   done       : BOOLEAN;
  371.   loandata   : ARRAY[1..3] OF fldstr;
  372.   amount,
  373.   rate,
  374.   payment    : REAL;
  375.   wfield,
  376.   month,
  377.   returncode,
  378.   errcode    : INTEGER;
  379.  
  380. PROCEDURE Helpmessage(what:INTEGER);
  381. VAR
  382.   ch1,ch2 : CHAR;
  383. BEGIN
  384.   Openwin(6+what,38,8,36,Attr(0,2),Attr(0,2),2,8,1,0);
  385.   Sprint(6+what,38,#17,Attr(0,2));
  386.   CASE what OF
  387.     1 : BEGIN
  388.           Titlewin(2,Attr(15,2),'[ Principal Amount ]');
  389.           Printwin(1,2,'Enter the amount of the loan you');
  390.           Printwin(2,2,'wish to calulate.  The format is');
  391.           Printwin(3,2,'######.##.  do not enter a');
  392.           Printwin(4,2,'negative number.');
  393.         END;
  394.     2 : BEGIN
  395.           Titlewin(2,Attr(15,2),'[ Interest Rate ]');
  396.           Printwin(1,2,'Enter the interest rate for the');
  397.           Printwin(2,2,'the loan you wish to calculate.');
  398.           Printwin(3,2,'The format is ##.##.  Where 11%');
  399.           Printwin(4,2,'would be entered as 11.00.  do');
  400.           Printwin(5,2,'not enter a negative number.');
  401.         END;
  402.     3 : BEGIN
  403.           Titlewin(2,Attr(15,2),'[ No. of Payments ]');
  404.           Printwin(1,2,'Enter the number of payments for');
  405.           Printwin(2,2,'the loan you wish to calulate.');
  406.           Printwin(3,2,'The format is ####.  Enter the');
  407.           Printwin(4,2,'actual number of payments not the');
  408.           Printwin(5,2,'number of years.  do not enter a');
  409.           Printwin(6,2,'negative number.');
  410.         END;
  411.   END;
  412.   Titlewin(5,Attr(15,2),' Press any key to continue ');
  413.   Getkey(ch1,ch2);
  414.   Closewin;
  415. END;
  416.  
  417. PROCEDURE Errmsg(what:INTEGER);
  418. VAR
  419.   ch1,ch2 : CHAR;
  420. BEGIN
  421.   Openwin(13,44,5,32,Attr(15,4),Attr(15,4),1,8,1,0);
  422.   CASE what OF
  423.     3 : BEGIN
  424.           Printcwin(1,'YOU MUST PROVIDE INPUT');
  425.           Printcwin(2,'FOR ALL THREE FIELDS');
  426.           Printcwin(3,'Press any key to continue ');
  427.         END;
  428.   END;
  429.   Getkey(ch1,ch2);
  430.   Closewin;
  431. END;
  432.  
  433. PROCEDURE Computepayment(amt,rt:REAL;mo:INTEGER);
  434.  VAR
  435.    hold : REAL;
  436. BEGIN
  437.  IF (amt > 0.0) AND (mo > 0) AND (rt > 0.0) THEN
  438.  BEGIN
  439.    hold := Powerof(1.0 + rt / 1200.0, mo);
  440.    payment := ((rt / 1200.0) * hold * amt) / (hold - 1.0);
  441.    payment := payment + 0.005;
  442.    hold := FRAC(payment * 100.0);
  443.    payment := ((payment * 100.0)-hold)/100.0;
  444.    GOTOXY(21,5);
  445.    WRITE(payment:9:2);
  446.  END
  447.  ELSE Errmsg(3);
  448. END;
  449.  
  450. BEGIN
  451.   FILLCHAR(loandata,SIZEOF(loandata),#0);
  452.   month  := 0;
  453.   rate   := 0;
  454.   amount := 0;
  455.   Openwin(5,7,14,32,Attr(0,3),Attr(0,3),2,8,1,0);
  456.   Titlewin(2,Attr(15,3),'[ Payment Calculator ]');
  457.   Titlewin(5,Attr(15,3),'[ Esc - Exit ]');
  458.   Printwin(2,2,'Principal Amount:');
  459.   Printwin(3,2,'   Interest Rate:');
  460.   Printwin(4,2,' No. of Payments:');
  461.   Printwin(5,2,'         Payment:');
  462.   Printcwin(7, 'F1 - Help             ');
  463.   Printcwin(8, 'F2 - Calculate Payment');
  464.   Printcwin(9, 'F5 - Pop-up Calculator');
  465.   done := FALSE;
  466.   wfield := 1;
  467.   WHILE NOT done DO
  468.   BEGIN
  469.     IF amount = 0 THEN loandata[1] := '' ELSE STR(amount:9:2,loandata[1]);
  470.     IF rate   = 0 THEN loandata[2] := '' ELSE STR(rate:9:2,loandata[2]);
  471.     IF month  = 0 THEN loandata[3] := '' ELSE STR(month:4,loandata[3]);
  472.     Cursoron;
  473.     REPEAT
  474.       Getrec(info,loandata,3,returncode,wfield,TRUE,Attr(3,0),Attr(0,3))
  475.     UNTIL returncode IN [0,59,60,63];
  476.     Cursoroff;
  477.    VAL(loandata[1],amount,errcode);
  478.    VAL(loandata[2],rate,errcode);
  479.    VAL(loandata[3],month,errcode);
  480.    CASE returncode OF
  481.      0   :  done := TRUE;
  482.      59  :  Helpmessage(wfield);
  483.      60  :  Computepayment(amount,rate,month);
  484.      63  :  Calculator(5,49,Attr(15,5),1);
  485.    END;
  486.  END;
  487.  Closewin;
  488. END;
  489.  
  490. PROCEDURE Edemo;
  491. BEGIN
  492.   Openwin(2,46,7,22,Attr(0,7),Attr(0,7),1,8,1,0);
  493.   done := FALSE;
  494.   WITH emenu DO
  495.   BEGIN
  496.     WHILE NOT done DO
  497.     BEGIN
  498.       Makevmenu(emenu);
  499.       CASE curntpos OF
  500.         1 : BEGIN
  501.               Openwin(8,8,10,65,Attr(15,5),Attr(15,5),2,0,1,0);
  502.               Printcwin(3,'Windows can be popped');
  503.               Printcwin(4,'onto the screen.');
  504.               DELAY(2000);
  505.               Openwin(5,5,10,50,Attr(0,2),Attr(14,2),2,7,1,0);
  506.               DELAY(2000);
  507.               Openwin(13,15,10,60,Attr(1,3),Attr(15,3),3,7,1,0);
  508.               DELAY(2000);
  509.               Openwin(7,33,10,45,Attr(14,5),Attr(14,5),1,7,1,0);
  510.               Continue;
  511.               FOR x := 1 TO 4 DO
  512.               BEGIN
  513.                 Closewin;
  514.               END;
  515.             END;
  516.         2 : BEGIN
  517.               Openwin(8,8,10,65,Attr(15,5),Attr(15,5),2,0,1,0);
  518.               Printcwin(3,'Windows can be zoomed');
  519.               Printcwin(4,'onto the screen.');
  520.               DELAY(2000);
  521.               Openwin(5,5,10,50,Attr(0,2),Attr(14,2),2,7,1,1);
  522.               DELAY(2000);
  523.               Openwin(13,15,10,60,Attr(1,3),Attr(15,3),3,7,1,1);
  524.               DELAY(2000);
  525.               Openwin(7,33,10,45,Attr(14,5),Attr(14,5),1,7,1,1);
  526.               DELAY(2000);
  527.               Openwin(7,20,12,40,Attr(15,4),Attr(14,4),2,7,1,1);
  528.               Printcwin(5,'HOW ABOUT THAT !!!');
  529.               Continue;
  530.               FOR x := 1 TO 5 DO
  531.               BEGIN
  532.                 Closewin;
  533.               END;
  534.             END;
  535.          3: Showfile;
  536.          4: Ddemo;
  537.          5: Idemo;
  538.       ELSE
  539.         Closewin;
  540.         done := TRUE;
  541.       END;
  542.     END;
  543.     done := FALSE;
  544.   END;
  545. END;
  546.  
  547. BEGIN
  548.   curattr := Textattr;
  549.   Cursoroff;
  550.   Initmenus;
  551.   Openwin(1,1,25,80,Attr(0,7),Attr(0,7),0,0,0,0);
  552.   Fakewin(2,1,23,80,Attr(7,1),Attr(7,1),1,0,0,0);
  553.   Openwin(5,20,11,40,Attr(0,7),Attr(1,7),2,8,1,0);
  554.   Printcwin(2,'TW200');
  555.   CASE Curdisplay OF
  556.     0 : msg := 'MONO';
  557.     1 : msg := 'CGA';
  558.     2 : msg := 'EGA';
  559.     3 : msg := 'MCGA';
  560.     4 : msg := 'VGA';
  561.   END;
  562.   STR(lastmode:3,msg1);
  563.   msg := msg + ' monitor in video mode'+msg1;
  564.   Printcwin(3,msg);
  565.   IF Mousehere THEN msg := 'Mouse present and active.' ELSE msg := 'No mouse present';
  566.   Printcwin(4,msg);
  567.   Printcwin(5,'Copyright (C) 1990');
  568.   Printcwin(6,'by Richard D. Fothergill');
  569.   Printcwin(7,'All Rights Reserved');
  570.   x := 0;
  571.   WHILE NOT KEYPRESSED AND (x < 25000) DO Inc(x);
  572.   Closewin;
  573.   IF KEYPRESSED THEN ch := Readkey;
  574.   Sprint(25,1,'             Use arrow keys to change selection - Return to select              ',Attr(0,3));
  575.   done := FALSE;
  576.   WITH mmenu DO
  577.   BEGIN
  578.     WHILE NOT done DO
  579.     BEGIN
  580.       Makehmenu(mmenu);
  581.       CASE curntpos OF
  582.         1 : Fdemo;
  583.         2 : Tdemo;
  584.         3 : Sdemo;
  585.         4 : Edemo;
  586.       ELSE
  587.         Closewin;
  588.         Openwin(9,16,8,52,Attr(0,7),Attr(1,7),2,8,1,0);
  589.         Printcwin(3,' T W ');
  590.         Printcwin(4,'2 0 0');
  591.         DELAY(3000);
  592.         Closewin;
  593.         done := TRUE;
  594.       END;
  595.     END;
  596.   END;
  597.   Cursoron;
  598. END.
  599.