home *** CD-ROM | disk | FTP | other *** search
- {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
- { - COLOR - }
- {--------------------------------------------------------------------------}
- { Version 1.0 02/01/90 }
- {--------------------------------------------------------------------------}
- { This program demonstrates a mouse driven unit that returns selected }
- { foreground and background colors to the following variables: }
- { }
- { forecolor : interger - foreground color }
- { backcolor : integer - background color }
- { }
- { The unit also returns the following: }
- { forecolorsel : string - foreground color in English as a string }
- { backcolorsel : string - background color in English as a string }
- { }
- { The TPU source code as shareware is available from: }
- { }
- { The Final Frontier BBS }
- { 1200, 2400, 9600 Baud }
- { (518) 761-0869 }
- {--------------------------------------------------------------------------}
- { Written By : William W. Miller, Jr. Final Frontier Software }
- { 524 Rock Avenue All rights reserved }
- { Chestertown, NY 12817 }
- {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
- PROGRAM dcolor;
-
- USES crt, fastttt5, strnttt5, keyttt5, winttt5,
- miscttt5, color55, nestttt5;
-
- VAR
- ch : CHAR;
-
- BEGIN
- IF numon THEN set_num(FALSE);
- offcursor;
- clrscr;
- color(forecolorsel, backcolorsel, forecolor, backcolor);
- gotoxy(1, 5);
- mkwin(10, 2, 70, 12, forecolor, backcolor, 1);
- writebetween(11, 69, 2, forecolor, backcolor, ' NESTTTT5 Color Attributes ');
- writeat(12, 3, forecolor, backcolor,
- ' The foreground attribute is: '
- + '(' + int_to_str(forecolor) + ')');
-
- writeat(12, 4, forecolor, backcolor,
- ' The background attribute is: '
- + '(' + int_to_str(backcolor) + ')');
-
- writeat(12, 5, nttt.boxfcol, backcolor,
- ' The Border foreground attribute is: '
- + '(' + int_to_str(nttt.boxfcol) + ')');
-
- writeat(12, 6, forecolor, nttt.boxbcol,
- ' The Border background attribute is: '
- + '(' + int_to_str(nttt.boxbcol) + ')');
-
- writeat(12, 7, nttt.capfcol, backcolor,
- ' First Capital letter foreground attribute is: '
- + '(' + int_to_str(nttt.capfcol) + ')');
-
- writeat(12, 8, nttt.norfcol, backcolor,
- ' Normal menu topics foreground attribute is: '
- + '(' + int_to_str(nttt.norfcol) + ')');
-
- writeat(12, 9, nttt.lofcol, backcolor,
- ' Non-selected menu topic foreground attribute is: '
- + '(' + int_to_str(nttt.lofcol) + ')');
-
- writeat(12, 10, nttt.hifcol, backcolor,
- ' Selected menu topic foreground attribute is: '
- + '(' + int_to_str(nttt.hifcol) + ')');
-
- writeat(12, 11, forecolor, nttt.hibcol,
- ' Selected menu topic background attribute is: '
- + '(' + int_to_str(nttt.hibcol) + ')');
-
- IF moused THEN writeAT(20, 25, white, black, 'Press a key, a mousekey, or move the mouse');
- IF NOT moused THEN writeAT(34, 25, white, black, 'Press a key ...');
- delay(500);
- ch := getkey;
- IF windowcounter = 1 THEN rmwin;
- reset_startup_mode;
- mkwin(1,1,80,8,white,blue,1);
- writecenter(2, White, blue,'FFSPAS Color Unit');
- writecenter(3, white, blue, '(c) Copyright 1990 Final Frontier Software');
- writecenter(4, white, blue, 'William W. Miller, Jr.');
- writecenter(5, white, blue, '524 Rock Avenue, Chestertown, New York 12817');
- writecenter(6, white, blue, 'Telephone (518) 494-4097');
- writecenter(7, white, blue, 'Please Register Your Procedures at the Final Frontier BBS (518) 761-0869');
- gotoxy(1, 9);
- oncursor;
- beep;
- END.
-