home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / colors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  7.5 KB  |  289 lines
  1. unit Colors;
  2.  
  3. interface
  4. uses Crt,      SetAttU,    ColorDef, DrawSqar, FastWr, CPaU, GetKeU,
  5.      TestFile, RenFile;
  6. var TempFile:      string;
  7. procedure GetColors;
  8. procedure PutColors;
  9. procedure ColorSet;
  10.  
  11. implementation
  12.  
  13. procedure GetColors;
  14. var  Continue:            boolean;
  15.      Err:                 integer;
  16.      ColorFile:           file of AttrRecord;
  17.      OldFile,
  18.      TempFile:            string;
  19. begin
  20.  
  21. Continue := true;
  22. OldFile  := 'MailColr';
  23. TempFile := 'ColorUse';
  24. if TestFileExist(OldFile) then ReNameFile( OldFile, TempFile);
  25. assign(ColorFile,TempFile);
  26. {$i-}
  27. reset(ColorFile);
  28. {$i+}  Err := ioresult;
  29. if Err <> 0 then Continue := false;
  30.  
  31. {$i-}
  32. Inputs.FG := white;
  33. Inputs.BG := black;
  34. Inputs.Blink := false;
  35. Inputs.Intense := false;
  36. Inputs.Attr := SetAttr(Inputs.Blink,Inputs.Intense,Inputs.FG,Inputs.BG);
  37. if Continue then
  38.    read(ColorFile,Inputs);
  39. {$i+}  Err := ioresult;
  40. if Err <> 0 then Continue := false;
  41.  
  42. {$i-}
  43. Headings.FG := white;
  44. Headings.BG := black;
  45. Headings.Blink := false;
  46. Headings.Intense := false;
  47. Headings.Attr := SetAttr(Headings.Blink,Headings.Intense,Headings.FG,Headings.BG);
  48. if Continue then
  49.    read(ColorFile,Headings);
  50. {$i+}  Err := ioresult;
  51. if Err <> 0 then Continue := false;
  52.  
  53. {$i-}
  54. Displays.FG := white;
  55. Displays.BG := black;
  56. Displays.Blink := false;
  57. Displays.Intense := false;
  58. Displays.Attr := SetAttr(Displays.Blink,Displays.Intense,Displays.FG,Displays.BG);
  59. if Continue then
  60.    read(ColorFile,Displays);
  61. {$i+}  Err := ioresult;
  62. if Err <> 0 then Continue := false;
  63.  
  64. {$i-}
  65. Msgs.FG := white;
  66. Msgs.BG := black;
  67. Msgs.Blink := false;
  68. Msgs.Intense := false;
  69. Msgs.Attr := SetAttr(Msgs.Blink,Msgs.Intense,Msgs.FG,Msgs.BG);
  70. if Continue then
  71.    read(ColorFile,Msgs);
  72. {$i+}  Err := ioresult;
  73. if Err <> 0 then Continue := false;
  74.  
  75. {$i-}
  76. Menus.FG := white;
  77. Menus.BG := black;
  78. Menus.Blink := false;
  79. Menus.Intense := false;
  80. Menus.Attr := SetAttr(Menus.Blink,Menus.Intense,Menus.FG,Menus.BG);
  81. if Continue then
  82.    read(ColorFile,Menus);
  83. {$i+}  Err := ioresult;
  84. if Err <> 0 then Continue := false;
  85.  
  86. {$i-}
  87. close(ColorFile);
  88. {$i+}  Err := ioresult;
  89. if Err <> 0 then Continue := false;
  90.  
  91. end;
  92.  
  93.  
  94. procedure PutColors;
  95. var  ColorFile:           file of AttrRecord;
  96. begin
  97.  
  98. TempFile := 'ColorUse';
  99. assign(ColorFile,TempFile);
  100. rewrite(ColorFile);
  101.  
  102. write(ColorFile,Inputs);
  103. write(ColorFile,Headings);
  104. write(ColorFile,Displays);
  105. write(ColorFile,Msgs);
  106. write(ColorFile,Menus);
  107.  
  108. close(ColorFile);
  109. end;
  110.  
  111. procedure ColorSet;
  112. var Inpts,
  113.     Head,
  114.     Dsply,
  115.     Msg,
  116.     Menu,
  117.     Blink:                 string;
  118.     OffSet,
  119.     Normal:                byte;
  120.  
  121.  
  122.     procedure ShowColorMenu( X: byte);
  123.     var Point:                             byte;
  124.     begin
  125.     Point := X * 4 + 1;
  126.     case X of
  127.         1:  begin
  128.             DrawSquare( OffSet, Point, OffSet+40, Point+3,
  129.                          (Inputs.Attr or $0008), true);
  130.             FastWrite( Inpts, Point+1, succ(OffSet), Inputs.Attr);
  131.             FastWrite( CPad('[F1] = FG   [F2] = BG',38),
  132.                        Point+2, succ(OffSet), Inputs.Attr);
  133.             end;
  134.         2:  begin
  135.             DrawSquare( OffSet, Point, OffSet+40, Point+3,
  136.                          (Displays.Attr or $0008), true);
  137.             FastWrite( Dsply, Point+1, succ(OffSet), Displays.Attr);
  138.             FastWrite( CPad('[F3] = FG   [F4] = BG',38),
  139.                        Point+2, succ(OffSet),Displays.Attr);
  140.             end;
  141.         3:  begin
  142.             DrawSquare( OffSet, Point, OffSet+40, Point+3,
  143.                          (Msgs.Attr or $0008), true);
  144.             FastWrite(Msg,succ(Point), succ(OffSet),Msgs.Attr);
  145.             FastWrite( CPad('[F5] = FG   [F6] = BG',38),
  146.                        Point+2, succ(OffSet),Msgs.Attr);
  147.             end;
  148.         4:  begin
  149.             DrawSquare( OffSet, Point, OffSet+40, Point+3,
  150.                          (Headings.Attr or $0008), true);
  151.             FastWrite(Head,succ(Point), succ(OffSet),Headings.Attr);
  152.             FastWrite( CPad('[F7] = FG   [F8] = BG',38),
  153.                        Point+2, succ(OffSet), Headings.Attr);
  154.             end;
  155.         5:  begin
  156.             DrawSquare( OffSet, Point, OffSet+40, Point+3,
  157.                          (Menus.Attr or $0008), true);
  158.             FastWrite(Menu,succ(Point), succ(OffSet),Menus.Attr);
  159.             FastWrite( CPad('[F9] = FG   [F10]= BG',38),
  160.                        Point+2, succ(OffSet), Menus.Attr);
  161.             end;
  162.         end;
  163.     end;
  164.  
  165.  
  166.     procedure IncBG( var X: AttrRecord; Show: integer);
  167.     begin
  168.     X.Blink := false;
  169.     inc(X.BG);
  170.     if X.BG > 7 then
  171.        begin
  172.        X.BG := 0;
  173.        end;
  174.     X.Attr := SetAttr( X.Blink, X.Intense, X.FG, X.BG);
  175.     ShowColorMenu(Show);
  176.     end;
  177.  
  178.  
  179.     procedure IncFG( var X: AttrRecord; Show: integer);
  180.     begin
  181.     X.Blink := false;
  182.     inc(X.FG);
  183.     if X.FG > 7 then
  184.        begin
  185.        X.FG := 0;
  186.        X.Intense := not X.Intense;
  187.        end;
  188.     X.Attr := SetAttr( X.Blink, X.Intense, X.FG, X.BG);
  189.     ShowColorMenu(Show);
  190.     end;
  191.  
  192.  
  193.     procedure DecBG( var X: AttrRecord; Show: integer);
  194.     begin
  195.     X.Blink := false;
  196.     dec(X.BG);
  197.     if X.BG < 0 then
  198.        begin
  199.        X.BG := 7;
  200.        end;
  201.     X.Attr := SetAttr( X.Blink, X.Intense, X.FG, X.BG);
  202.     ShowColorMenu(Show);
  203.     end;
  204.  
  205.  
  206.     procedure DecFG( var X: AttrRecord; Show: integer);
  207.     begin
  208.     X.Blink := false;
  209.     dec(X.FG);
  210.     if X.FG < 0 then
  211.        begin
  212.        X.FG := 7;
  213.        X.Intense := not X.Intense;
  214.        end;
  215.     X.Attr := SetAttr( X.Blink, X.Intense, X.FG, X.BG);
  216.     ShowColorMenu(Show);
  217.     end;
  218.  
  219.  
  220.     procedure ColorControl;
  221.     var I:                  integer;
  222.         FunctionKey,
  223.         Continue:           boolean;
  224.         Ch:                 char;
  225.     begin
  226.     for I := 1 to 5 do ShowColorMenu(I);
  227.     FastWrite(CPad('[Function key] - rolls forward 1 color',78), 1, 2, Normal);
  228.     FastWrite(CPad('[SHIFT] and [Function key] - rolls backward 1 color',78),2,2,Normal);
  229.     FastWrite(CPad('FG = foreground color   BG = background color',78), 3, 2, Normal);
  230.     FastWrite(CPad('[ESC] to exit',78), 4, 2, Normal);
  231.     Continue := true;
  232.     while Continue do
  233.         begin
  234.         GetKey(Ch,FunctionKey);
  235.         if not FunctionKey then
  236.            begin
  237.            if Ch = #27 then Continue := false;
  238.            end
  239.           else
  240.            begin
  241.            case ord(Ch) of
  242.                59: IncFG(Inputs,1);
  243.                60: IncBG(Inputs,1);
  244.                61: IncFG(Displays,2);
  245.                62: IncBG(Displays,2);
  246.                63: IncFG(Msgs,3);
  247.                64: IncBG(Msgs,3);
  248.                65: IncFG(Headings,4);
  249.                66: IncBG(Headings,4);
  250.                67: IncFG(Menus,5);
  251.                68: IncBG(Menus,5);
  252.                84: DecFG(Inputs,1);
  253.                85: DecBG(Inputs,1);
  254.                86: DecFG(Displays,2);
  255.                87: DecBG(Displays,2);
  256.                88: DecFG(Msgs,3);
  257.                89: DecBG(Msgs,3);
  258.                90: DecFG(Headings,4);
  259.                91: DecBG(Headings,4);
  260.                92: DecFG(Menus,5);
  261.                93: DecBG(Menus,5);
  262.                end;
  263.            end;
  264.         end;
  265.     end;
  266.  
  267.  
  268. begin
  269. GetColors;
  270. textcolor(7);
  271. textbackground(0);
  272. clrscr;
  273. OffSet := 20;
  274. Normal := SetAttr(false,true,7,0);
  275.  
  276. Inpts   := CPad('  All Input Fields  ',38);
  277. Head    := CPad('    All Headings    ',38);
  278. Dsply   := CPad('   Major Displays   ',38);
  279. Msg     := CPad('  Control Messages  ',38);
  280. Menu    := CPad('     All Menus      ',38);
  281.  
  282. ColorControl;
  283. PutColors;
  284.  
  285. end;
  286.  
  287. end.
  288. 
  289.