Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/COLOR.ZIP/COLOR.PAS

Pascal/Delphi Source File | 1988-02-03 | 5.2 KB | 172 lines

{$R-}    {Range checking off}
{$B-}    {Boolean short circuiting off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N-}    {No numeric coprocessor}
{$V-}    {Var-String Checking off}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}

PROGRAM Color;
{ It uses Modify4 by Bob Tolz, CIS [70475,1071]
  Purpose: Allows User-Definable Color Setup.
  Written by: Juan M. Vegarra CIS [72770,247] }

  Uses CRT, QWIK, WNDWVars, WNDW, DER, TPString, TPDos;
{ You have to modify DER11.ARC, before compiling this demo }
{ Also: You must have a copy of TurboPower's TPro4  }

TYPE
  _FileName = STRING[64];

{ Your application should have this block of code }
Const
  HeadLength = 10;
  Head   : String[10] = 'Set Colors';
  Frame  : Byte = 14;
  Header : Byte = 14;
  Body   : Byte = 14;
  Select : Byte = 7;
  Hilite : Byte = 7;
  Help   : Byte = 7;
  Tail   : Byte = 0;

Selection : Array[1..6] of String[80] = (
'Frame',
'Header',
'Body',
'Select',
'Hilited',
'Help'
);

Var
  OK : Byte;
  ProgramName : _FileName;
  TC,Ch : Char;
  LL : Byte;
  Row,Col : Byte;

{ Copied from Bob Tolz's Modify4.pas }
FUNCTION Modify(FName : _FileName; VAR Head, Tail) : Byte;
  CONST filebufferlength = 1024;

  VAR
    filebuffer : ARRAY[1..filebufferlength] OF Byte;
    F : FILE;
    Data : ARRAY[1..256] OF Byte ABSOLUTE Head;
    Check : STRING[255] ABSOLUTE Head;
    Actual : STRING[255];
    checksize,
    DataSize, modresult,
    Result : Integer;
    fileoffset, sizeoffile, seekpos : longint;
    searchresult : word;
    foundmatch : Boolean;

  BEGIN
    Modresult := 0;           { Assume success }
    Assign(F, FName);
    Reset(F, 1);
    IF IOResult <> 0 THEN BEGIN
      Modresult := 1;         { File wasn't found or couldn't be opened }
    END
    ELSE BEGIN                {level 1}
      sizeoffile := FileSize(f);
      foundmatch := False;
      fileoffset := 0;
      searchresult := 0;
      seekpos := sizeoffile;
      WHILE NOT foundmatch AND NOT((seekpos-filebufferlength) < 0) DO
        BEGIN
          seekpos := seekpos-filebufferlength;
          Seek(f, seekpos);
          BlockRead(f, filebuffer, filebufferlength);
          searchresult := search(filebuffer, filebufferlength, head, headlength);

          IF NOT(searchresult = $FFFF) THEN
            BEGIN
              foundmatch := True;
              fileoffset := seekpos+searchresult;
            END;
        END;

      IF foundmatch THEN  Seek(F, fileoffset);
      IF IOResult <> 0 THEN
        Modresult := 2        { Error when trying to locate header }
      ELSE BEGIN              {level 2}
        CheckSize := Succ(Length(Check)); { Length of the header string + 1 }
        BlockRead(F, Actual, CheckSize, Result);
        IF (Result <> CheckSize) THEN BEGIN
          IF Result <> CheckSize THEN Modresult := 2 { Read error }
        END
        ELSE BEGIN            {level 3}
          DataSize := Ofs(Tail)-(Ofs(Head)+CheckSize);
          BlockWrite(F, Data[Succ(CheckSize)], DataSize, Result);
          IF (Result <> DataSize) THEN Modresult := 3; { Disk write error }
        END;                  {level 3}
      END;                    {level 2}
    END;                      {level 1}
    Close(F);
    modify := modresult;
  END;


BEGIN
  ClrScr;
  If ParamCount <> 1 Then
  Begin
    Writeln('Usage: COLOR filename');
    Halt(1);
  End;
  ProgramName := ParamStr(1);
  ProgramName := StUpcase(ProgramName);
  ProgramName := ForceExtension(ProgramName,'EXE');
  If ExistFile(ProgramName) Then
  Begin
    MakeWindow(1,1,25,80,-1,-1,SingleBrdr,aWindow);
    TitleWindow(Top,Right,'Press Esc to update EXE file');

    MakeWindow(5,5,8,20,-1,-1,SingleBrdr,aWindow);
    TitleWindow(Top,Left,' Items ');
    For LL := 1 to 6 Do QWrite(LL + 5,6,-1,Selection[LL]);

    Row := 6; Col := 6;
    Repeat
      GotoRC(Row,Col);
      QAttr(Row,Col,1,18,ReverseAtt);
      TC := ReadChar;
      QAttr(Row,Col,1,18,NormalAtt);
      Case TC Of
        CursorDown: Begin
                      If Row = 11 Then Row := 6
                      Else Inc(Row);
                    End;
        CursorUp:   Begin
                      If Row = 6 Then Row := 11
                      Else Dec(Row);
                    End;
           Return : Case Row Of
                       6 : Frame  := SelectColor( 7,25, 2,16);
                       7 : Header := SelectColor( 8,25, 2,16);
                       8 : Body   := SelectColor( 9,25, 2,15);
                       9 : Select := SelectColor(10,25, 6,15);
                      10 : Hilite := SelectColor(11,25, 2,12);
                      11 : Help   := SelectColor(12,25, 1, 1);
                    End;
      End;
    Until TC = Escape;
    RemoveWindow;
    RemoveWindow;

    Ok := Modify(ProgramName, Head, Tail);
    Case Ok Of
      0 : Writeln(ProgramName,' was modified successfully.');
      1 : Writeln('Unable to open ',ProgramName);
      2 : Writeln('Error reading ',ProgramName);
      3 : Writeln('Error writing to ',ProgramName);
      5 : Writeln('Wrong .EXE file.');
    End;
  End
  Else Writeln(ProgramName,' cannot be found');
End.