home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / COLOR.ZIP / COLOR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-02-03  |  5.2 KB  |  172 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean short circuiting off}
  3. {$S-}    {Stack checking off}
  4. {$I-}    {I/O checking off}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}    {Var-String Checking off}
  7. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  8.  
  9. PROGRAM Color;
  10. { It uses Modify4 by Bob Tolz, CIS [70475,1071]
  11.   Purpose: Allows User-Definable Color Setup.
  12.   Written by: Juan M. Vegarra CIS [72770,247] }
  13.  
  14.   Uses CRT, QWIK, WNDWVars, WNDW, DER, TPString, TPDos;
  15. { You have to modify DER11.ARC, before compiling this demo }
  16. { Also: You must have a copy of TurboPower's TPro4  }
  17.  
  18. TYPE
  19.   _FileName = STRING[64];
  20.  
  21. { Your application should have this block of code }
  22. Const
  23.   HeadLength = 10;
  24.   Head   : String[10] = 'Set Colors';
  25.   Frame  : Byte = 14;
  26.   Header : Byte = 14;
  27.   Body   : Byte = 14;
  28.   Select : Byte = 7;
  29.   Hilite : Byte = 7;
  30.   Help   : Byte = 7;
  31.   Tail   : Byte = 0;
  32.  
  33. Selection : Array[1..6] of String[80] = (
  34. 'Frame',
  35. 'Header',
  36. 'Body',
  37. 'Select',
  38. 'Hilited',
  39. 'Help'
  40. );
  41.  
  42. Var
  43.   OK : Byte;
  44.   ProgramName : _FileName;
  45.   TC,Ch : Char;
  46.   LL : Byte;
  47.   Row,Col : Byte;
  48.  
  49. { Copied from Bob Tolz's Modify4.pas }
  50. FUNCTION Modify(FName : _FileName; VAR Head, Tail) : Byte;
  51.   CONST filebufferlength = 1024;
  52.  
  53.   VAR
  54.     filebuffer : ARRAY[1..filebufferlength] OF Byte;
  55.     F : FILE;
  56.     Data : ARRAY[1..256] OF Byte ABSOLUTE Head;
  57.     Check : STRING[255] ABSOLUTE Head;
  58.     Actual : STRING[255];
  59.     checksize,
  60.     DataSize, modresult,
  61.     Result : Integer;
  62.     fileoffset, sizeoffile, seekpos : longint;
  63.     searchresult : word;
  64.     foundmatch : Boolean;
  65.  
  66.   BEGIN
  67.     Modresult := 0;           { Assume success }
  68.     Assign(F, FName);
  69.     Reset(F, 1);
  70.     IF IOResult <> 0 THEN BEGIN
  71.       Modresult := 1;         { File wasn't found or couldn't be opened }
  72.     END
  73.     ELSE BEGIN                {level 1}
  74.       sizeoffile := FileSize(f);
  75.       foundmatch := False;
  76.       fileoffset := 0;
  77.       searchresult := 0;
  78.       seekpos := sizeoffile;
  79.       WHILE NOT foundmatch AND NOT((seekpos-filebufferlength) < 0) DO
  80.         BEGIN
  81.           seekpos := seekpos-filebufferlength;
  82.           Seek(f, seekpos);
  83.           BlockRead(f, filebuffer, filebufferlength);
  84.           searchresult := search(filebuffer, filebufferlength, head, headlength);
  85.  
  86.           IF NOT(searchresult = $FFFF) THEN
  87.             BEGIN
  88.               foundmatch := True;
  89.               fileoffset := seekpos+searchresult;
  90.             END;
  91.         END;
  92.  
  93.       IF foundmatch THEN  Seek(F, fileoffset);
  94.       IF IOResult <> 0 THEN
  95.         Modresult := 2        { Error when trying to locate header }
  96.       ELSE BEGIN              {level 2}
  97.         CheckSize := Succ(Length(Check)); { Length of the header string + 1 }
  98.         BlockRead(F, Actual, CheckSize, Result);
  99.         IF (Result <> CheckSize) THEN BEGIN
  100.           IF Result <> CheckSize THEN Modresult := 2 { Read error }
  101.         END
  102.         ELSE BEGIN            {level 3}
  103.           DataSize := Ofs(Tail)-(Ofs(Head)+CheckSize);
  104.           BlockWrite(F, Data[Succ(CheckSize)], DataSize, Result);
  105.           IF (Result <> DataSize) THEN Modresult := 3; { Disk write error }
  106.         END;                  {level 3}
  107.       END;                    {level 2}
  108.     END;                      {level 1}
  109.     Close(F);
  110.     modify := modresult;
  111.   END;
  112.  
  113.  
  114. BEGIN
  115.   ClrScr;
  116.   If ParamCount <> 1 Then
  117.   Begin
  118.     Writeln('Usage: COLOR filename');
  119.     Halt(1);
  120.   End;
  121.   ProgramName := ParamStr(1);
  122.   ProgramName := StUpcase(ProgramName);
  123.   ProgramName := ForceExtension(ProgramName,'EXE');
  124.   If ExistFile(ProgramName) Then
  125.   Begin
  126.     MakeWindow(1,1,25,80,-1,-1,SingleBrdr,aWindow);
  127.     TitleWindow(Top,Right,'Press Esc to update EXE file');
  128.  
  129.     MakeWindow(5,5,8,20,-1,-1,SingleBrdr,aWindow);
  130.     TitleWindow(Top,Left,' Items ');
  131.     For LL := 1 to 6 Do QWrite(LL + 5,6,-1,Selection[LL]);
  132.  
  133.     Row := 6; Col := 6;
  134.     Repeat
  135.       GotoRC(Row,Col);
  136.       QAttr(Row,Col,1,18,ReverseAtt);
  137.       TC := ReadChar;
  138.       QAttr(Row,Col,1,18,NormalAtt);
  139.       Case TC Of
  140.         CursorDown: Begin
  141.                       If Row = 11 Then Row := 6
  142.                       Else Inc(Row);
  143.                     End;
  144.         CursorUp:   Begin
  145.                       If Row = 6 Then Row := 11
  146.                       Else Dec(Row);
  147.                     End;
  148.            Return : Case Row Of
  149.                        6 : Frame  := SelectColor( 7,25, 2,16);
  150.                        7 : Header := SelectColor( 8,25, 2,16);
  151.                        8 : Body   := SelectColor( 9,25, 2,15);
  152.                        9 : Select := SelectColor(10,25, 6,15);
  153.                       10 : Hilite := SelectColor(11,25, 2,12);
  154.                       11 : Help   := SelectColor(12,25, 1, 1);
  155.                     End;
  156.       End;
  157.     Until TC = Escape;
  158.     RemoveWindow;
  159.     RemoveWindow;
  160.  
  161.     Ok := Modify(ProgramName, Head, Tail);
  162.     Case Ok Of
  163.       0 : Writeln(ProgramName,' was modified successfully.');
  164.       1 : Writeln('Unable to open ',ProgramName);
  165.       2 : Writeln('Error reading ',ProgramName);
  166.       3 : Writeln('Error writing to ',ProgramName);
  167.       5 : Writeln('Wrong .EXE file.');
  168.     End;
  169.   End
  170.   Else Writeln(ProgramName,' cannot be found');
  171. End.
  172.