home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SETCOL.ZIP / TSTCOLOR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-04-30  |  3.3 KB  |  115 lines
  1. Program TstColor;
  2. {----------------------------------------------------------------------------}
  3. {  Program:         TestColor                                                }
  4. {  Programmer:      Jeffrey S. Kline                                         }
  5. {  Start Date:      April 28, 1990         Completion: April 29, 1990        }
  6. {  Synopsis:                                                                 }
  7. {  Test and develop a smart means of color selection for both the forground  }
  8. {  and the background with just a moving block.                              }
  9. {----------------------------------------------------------------------------}
  10. Uses
  11.     DOS, CRT, COLORSET;
  12.  
  13. Const
  14.      MainFGcolor   : Integer = LightGray;
  15.      MainBGcolor   : Integer = Black;
  16.      MainColors    : Word = $07;
  17.  
  18. Var
  19.    Ch          : Char;
  20.    Changed     : Boolean;
  21.    Finished    : Boolean;
  22.    Curs1,Curs2 : Byte;       { old cursor stats storage }
  23.    DummyStr       : String;
  24.  
  25. Procedure FindCursor;
  26. Var
  27.    Reg : Registers;
  28. Begin
  29.   Reg.Ax := $0F00;
  30.   Intr($10,Reg);
  31.   Reg.Ax := $0300;
  32.   Intr($10,Reg);
  33.   With Reg do
  34.   Begin
  35.     Curs1 := Hi(Cx) and $0F;
  36.     Curs2 := Lo(Cx) and $0F;
  37.   End;
  38. End;
  39.  
  40.  
  41. Procedure SetCursor(Top, Bot:Byte);
  42. Var
  43.    Reg : Registers;
  44. Begin
  45.     with Reg do
  46.     Begin
  47.         ax := 1 shl 8;
  48.         cx := Top shl 8 + Bot;
  49.         INTR($10,Reg);
  50.     End;
  51. End;
  52.  
  53.  
  54. Function IntToStr(Number:longint):string;
  55. var Temp : string;
  56. begin
  57.     Str(Number,temp);
  58.     IntToStr := temp;
  59. end;
  60.  
  61. function RealToStr(Number:real;Decimals:byte):string;
  62. var Temp : string;
  63. begin
  64.     Str(Number:20:Decimals,Temp);
  65.     repeat
  66.          If copy(Temp,1,1) = ' ' then
  67.              delete(Temp,1,1);
  68.     until copy(temp,1,1) <> ' ';
  69.     RealToStr := Temp;
  70. end;
  71.  
  72. Begin
  73.     Finished := False;
  74.     FindCursor; { GET OLD CURSOR STATS }
  75.     Repeat
  76.         SetCursor(6,7);
  77.         TextColor(MainFGcolor);
  78.         TextBackGround(MainBGcolor);
  79.         ClrScr;
  80.         Writeln('Beginning color selections test and evaluation. ');
  81.         Writeln;
  82.         Writeln('This is using the "COLORSET" TPU/QPU. Copyright '+CopyrightName);
  83.         Writeln('See the documentation for access to the source code to this unit');
  84.         Writeln('and about the usage of this module.');
  85.         GotoXY(5,8);
  86.         Writeln('Main FG................: ',IntToStr(MainFGcolor),' ',ColorNames[MainFGcolor]);
  87.         GotoXY(5,9);
  88.         Writeln('Main BG................: ',IntToStr(MainBGcolor),' ',ColorNames[MainBGcolor]);
  89.         GotoXY(5,10);
  90.         Writeln('Main in WORD form is...: ',RealToStr(Attr(MainFGcolor,MainBGcolor),0),' Decimal.');
  91.         GotoXY(1,23);
  92.         TextColor(White);
  93.         Write('Press ALT-C to set colors or ALT-X to exit!');
  94.         Ch := Readkey;
  95.         If Ch = #0 then
  96.         Begin
  97.            Ch := Readkey;
  98.            If Ch = #45 then Finished := True;
  99.            If Ch = #46 then Changed := Select_Colors(Attr(MainFGColor,MainBGcolor));
  100.         End;
  101.         If Changed then
  102.         Begin           { get changed colors into our vars }
  103.             MainFGcolor := ChosenFG;
  104.             MainBGcolor := ChosenBG;
  105.             MainColors := ChosenColors;
  106.         End;
  107.     Until Finished;
  108.     TextAttr := Attr(7,0);
  109.     SetCursor(Curs1,Curs2);
  110.     ClrScr;
  111. End.
  112.  
  113.  
  114.  
  115.