Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TURBCOMM.ZIP/REDEFINE.INC

Text File | 1989-06-30 | 8.5 KB | 232 lines

   Const
      Redefinables : set of FunKeyCode =
                    [Help,KDo,Interrupt,Resume,Cancel,Main,KExit,
                     Options,F17,F18,F19,F20,Find,Insert,Remove,
                     Select,Prev,Next,PF1,PF2,PF3,PF4];

   Var
      FunctionKeyChanged : Boolean;

   Function MakeDisplayable(InputStr : STR80) : STR80;
      { Return a screen displayable version of the input string }
      Var
         CharCount : Byte;
         TempString : STR80;
      Begin
         TempString := '';
         For CharCount := 1 to Length(InputStr) Do
            If InputStr[CharCount] < ' '
               Then TempString := TempString + '^'
                                     + Chr(Ord(InputStr[CharCount])+64)
               Else TempString := TempString + InputStr[CharCount];

         MakeDisplayable := TempString;
         End; { Function MakeDisplayable }


   Procedure RedefineKey(Key : FunKeyCode);
      { Append keyboard input to key definition until <F4> is pressed }
      Const
         DispOfs = 18;
      Var
         NewString : STR80;
         DisplayString,OldVideoLine : String[160];

      Begin
         FunctionKeyChanged := True;
         DisplayString := '';
         NewString := '';
         FunCode := DUM4;
         OldVideoLine := GetVidLine(24);  { Save what was on the 24th line }
         Write(SaveCursor);
         GotoXY(1,24);
         Write('Enter Definition:');
         ClrEol;

         While (FunCode <> F4) And (Length(DisplayString) < (80 - DispOfs)) Do
            Begin
               Repeat Until ReadKey;
               Case FunCode Of
                  DUM4:   If InString = Chr(127) { Delete Key }
                             Then Begin
                                NewString := Copy(NewString,1,
                                   Length(NewString) - 1);
                                DisplayString := MakeDisplayable(NewString);
                                End
                             Else NewString := NewString + InString;
                  F4:     InString := '';
                  Else    Begin
                             InString := GetInitFunkey(FunCode);
                             NewString := NewString + InString;
                             End;
                  End; { Case statement }

               GotoXY(Length(DisplayString) + DispOfs,24);
               If InString = Chr(127)
                  Then ClrEol
                  Else Begin
                     Write(MakeDisplayable(Instring));
                     DisplayString := DisplayString +
                        MakeDisplayable(InString);
                     End;

               End; { While statement }

         FunKeys[Key] := NewString;
         GotoXY(1,24);
         ClrEol;
         NormVideo;
         Write('Ok');
         LowVideo;
         GotoXY(1,24);
         Delay(1000);
         ClrEol;
         Write(OldVideoLine);  { Restore what was on the 24th line }
         Write(RestoreCursor);
         End; { Procedure RedefineKey }


   Procedure ReadKeyFile;
      { Read in function key redefinitions from the file }
      Label NoKeyFile;

      Type
         FunctionKeyRec = Record
                           KeyNum : FunKeyCode;
                           KeyLen : Byte;
                           KeyStr : String[80];
                           End;
      Var
         FileVar : File of FunctionKeyRec;
         FunKeyRec : FunctionKeyRec;
         FileLine : STR80;
         TempCode : FunKeyCode;
         I : Integer;
      Begin
         FunctionKeyChanged := False;  { Initialize as false }

           { Get Function key directory name from MS-DOS environmental variable }
         { FKey_Dir defined as typed constant in main program }
           GetEnvParam(FKey_Dir,FKey_Dir);
           If FKey_Dir > '' Then
              If FKey_Dir[Length(FKey_Dir)] <> '\'
                 Then FKey_Dir := FKey_Dir + '\';

         Assign(FileVar,FKey_Dir+KeyFileName+'.KEY');
         {$I-}  Reset(FileVar);  {$I+}

         If IOResult <> 0 Then
            Begin
               Goto NoKeyFile;
               End;

         While not Eof(FileVar) Do
            Begin
               Read(FileVar,FunKeyRec);
               With FunKeyRec Do
                  Begin
                     FileLine := '';
                     For I := 1 to KeyLen Do
                        FileLine := FileLine + KeyStr[I];
                     FunKeys[KeyNum] := FileLine;
                     End; { With statement }
               End; { While not end of the file }

         Close(FileVar);
         NoKeyFile:  { There was not key file to be read }
         End; { Procedure ReadKeyFile }


   Procedure WriteKeyFile;
      { Write out NON-DEFAULT function key definitions to file }
      Label NoKeyChanges;

      Const
         BadNewFileName : Boolean = True;

      Type
         FunctionKeyRec = Record
                           KeyNum : FunKeyCode;
                           KeyLen : Byte;
                           KeyStr : String[80];
                           End;
      Var
         NewFileName : STR80;
         FileExtPos : Byte;
         FileVar : File of FunctionKeyRec;
         FunKeyRec : FunctionKeyRec;
         SaveQuery : Char;
         FunCount : FunKeyCode;
         I : Integer;

      Begin
         SaveQuery := ' ';

         If FunctionKeyChanged  { Check if they want to save changes }
            Then
               Begin
                  NormVideo;
                  Writeln;
                  Write('Do you want to save the new function key ');
                  Write('definitions? [Y/N] <Y> ');
                  Repeat
                     Read(Kbd,SaveQuery);
                     Until SaveQuery In ['Y','y','N','n',^M];
                  Writeln;
                  If SaveQuery In ['N','n'] Then
                     Begin
                        Writeln('Not saving new definitions.');
                        Goto NoKeyChanges;
                        End { If they don't want to save }
                     Else
                        Begin
                           While BadNewFileName Do
                              Begin
                                 LowVideo;
                                 Write('Save to file <');
                                 NormVideo;
                                 Write(KeyFileName);
                                 LowVideo;
                                 Write('> :');
                                 Readln(NewFileName);
                                 Writeln;
                                 FileExtPos := Pos('.',NewFileName);
                                 If Length(NewFileName) > 0
                                    Then If FileExtPos > 0
                                       Then KeyFileName := Copy(NewFileName,
                                          1,FileExtPos - 1)
                                       Else KeyFileName := NewFileName;
   { Modification for V2.21 - FKey_Dir }
                                 Assign(FileVar,FKey_Dir+KeyFileName+'.KEY');
                                 {$I-} Rewrite(FileVar); {$I+}
                                 If IOResult <> 0
                                    Then Write('Bad file name! ',
                                            'No extension allowed!')
                                    Else BadNewFileName := False;
                                 End; { While the new filename was bad }
                              Writeln('Saving new definitions.');
                           End;
                  End { There were changes }
            Else Goto NoKeyChanges;  { There were no changes to save }

         For FunCount := Help to Break Do
            If FunCount In Redefinables
               Then If FunKeys[FunCount] <> GetInitFunkey(FunCount)
                     Then { The definition is not the default value }
                        Begin
                           With FunKeyRec Do
                              Begin
                                 KeyNum := FunCount;
                                 KeyLen := Length(FunKeys[FunCount]);
                                 KeyStr := FunKeys[FunCount];
                                 End;
                           Write(FileVar,FunKeyRec);
                           End; { If this definition should be written }

         Close(FileVar);
         NoKeyChanges: LowVideo;
         End; { Procedure WriteKeyFile }