home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB114 / redefine.inc < prev    next >
Text File  |  1995-05-28  |  8KB  |  226 lines
  1.  
  2.    Const
  3.       Redefinables : set of FunKeyCode =
  4.                     [Help,KDo,Interrupt,Resume,Cancel,Main,KExit,
  5.                      Options,F17,F18,F19,F20,Find,Insert,Remove,
  6.                      Select,Prev,Next,PF1,PF2,PF3,PF4];
  7.  
  8.       KeyFileName : String[80] = 'TC';
  9.  
  10.    Var
  11.       FunctionKeyChanged : Boolean;
  12.  
  13.    Function MakeDisplayable(InputStr : STR80) : STR80;
  14.       { Return a screen displayable version of the input string }
  15.       Var
  16.          CharCount : Byte;
  17.          TempString : STR80;
  18.       Begin
  19.          TempString := '';
  20.          For CharCount := 1 to Length(InputStr) Do
  21.             If InputStr[CharCount] < ' '
  22.                Then TempString := TempString + '^'
  23.                                      + Chr(Ord(InputStr[CharCount])+64)
  24.                Else TempString := TempString + InputStr[CharCount];
  25.  
  26.          MakeDisplayable := TempString;
  27.          End; { Function MakeDisplayable }
  28.  
  29.  
  30.    Procedure RedefineKey(Key : FunKeyCode);
  31.       { Append keyboard input to key definition until <F4> is pressed }
  32.       Const
  33.          DispOfs = 18;
  34.       Var
  35.          NewString : STR80;
  36.          DisplayString,OldVideoLine : String[160];
  37.  
  38.       Begin
  39.          FunctionKeyChanged := True;
  40.          DisplayString := '';
  41.          NewString := '';
  42.          FunCode := DUM4;
  43.          OldVideoLine := GetVidLine(24);  { Save what was on the 24th line }
  44.          Write(SaveCursor);
  45.          GotoXY(1,24);
  46.          Write('Enter Definition:');
  47.          ClrEol;
  48.  
  49.          While (FunCode <> F4) And (Length(DisplayString) < (80 - DispOfs)) Do
  50.             Begin
  51.                Repeat Until ReadKey;
  52.                Case FunCode Of
  53.                   DUM4:   If InString = Chr(127) { Delete Key }
  54.                              Then Begin
  55.                                 NewString := Copy(NewString,1,
  56.                                    Length(NewString) - 1);
  57.                                 DisplayString := MakeDisplayable(NewString);
  58.                                 End
  59.                              Else NewString := NewString + InString;
  60.                   F4:     InString := '';
  61.                   Else    Begin
  62.                              InString := GetInitFunkey(FunCode);
  63.                              NewString := NewString + InString;
  64.                              End;
  65.                   End; { Case statement }
  66.  
  67.                GotoXY(Length(DisplayString) + DispOfs,24);
  68.                If InString = Chr(127)
  69.                   Then ClrEol
  70.                   Else Begin
  71.                      Write(MakeDisplayable(Instring));
  72.                      DisplayString := DisplayString +
  73.                         MakeDisplayable(InString);
  74.                      End;
  75.  
  76.                End; { While statement }
  77.  
  78.          FunKeys[Key] := NewString;
  79.          GotoXY(1,24);
  80.          ClrEol;
  81.          NormVideo;
  82.          Write('Ok');
  83.          LowVideo;
  84.          GotoXY(1,24);
  85.          Delay(1000);
  86.          ClrEol;
  87.          Write(OldVideoLine);  { Restore what was on the 24th line }
  88.          Write(RestoreCursor);
  89.          End; { Procedure RedefineKey }
  90.  
  91.  
  92.    Procedure ReadKeyFile;
  93.       { Read in function key redefinitions from the file }
  94.       Label NoKeyFile;
  95.  
  96.       Type
  97.          FunctionKeyRec = Record
  98.                            KeyNum : FunKeyCode;
  99.                            KeyLen : Byte;
  100.                            KeyStr : String[80];
  101.                            End;
  102.       Var
  103.          FileVar : File of FunctionKeyRec;
  104.          FunKeyRec : FunctionKeyRec;
  105.          FileLine : STR80;
  106.          TempCode : FunKeyCode;
  107.          I : Integer;
  108.       Begin
  109.          FunctionKeyChanged := False;  { Initialize as false }
  110.  
  111.          Assign(FileVar,KeyFileName+'.KEY');
  112.          {$I-}  Reset(FileVar);  {$I+}
  113.  
  114.          If IOResult <> 0 Then
  115.             Begin
  116.                Goto NoKeyFile;
  117.                End;
  118.  
  119.          While not Eof(FileVar) Do
  120.             Begin
  121.                Read(FileVar,FunKeyRec);
  122.                With FunKeyRec Do
  123.                   Begin
  124.                      FileLine := '';
  125.                      For I := 1 to KeyLen Do
  126.                         FileLine := FileLine + KeyStr[I];
  127.                      FunKeys[KeyNum] := FileLine;
  128.                      End; { With statement }
  129.                End; { While not end of the file }
  130.             
  131.          Close(FileVar);
  132.          NoKeyFile:  { There was not key file to be read }
  133.          End; { Procedure ReadKeyFile }
  134.  
  135.  
  136.    Procedure WriteKeyFile;
  137.       { Write out NON-DEFAULT function key definitions to file }
  138.       Label NoKeyChanges;          
  139.       
  140.       Const
  141.          BadNewFileName : Boolean = True;
  142.                         
  143.       Type
  144.          FunctionKeyRec = Record
  145.                            KeyNum : FunKeyCode;
  146.                            KeyLen : Byte;
  147.                            KeyStr : String[80];
  148.                            End;
  149.       Var                  
  150.          NewFileName : STR80;                                 
  151.          FileExtPos : Byte;
  152.          FileVar : File of FunctionKeyRec;
  153.          FunKeyRec : FunctionKeyRec;
  154.          SaveQuery : Char;
  155.          FunCount : FunKeyCode;
  156.          I : Integer;
  157.  
  158.       Begin
  159.          SaveQuery := ' ';
  160.  
  161.          If FunctionKeyChanged  { Check if they want to save changes }
  162.             Then
  163.                Begin
  164.                   NormVideo;
  165.                   Writeln;
  166.                   Write('Do you want to save the new function key ');
  167.                   Write('definitions? [Y/N] <Y> ');
  168.                   Repeat
  169.                      Read(Kbd,SaveQuery);
  170.                      Until SaveQuery In ['Y','y','N','n',^M];
  171.                   Writeln;
  172.                   If SaveQuery In ['N','n'] Then
  173.                      Begin
  174.                         Writeln('Not saving new definitions.');
  175.                         Goto NoKeyChanges;
  176.                         End { If they don't want to save }
  177.                      Else 
  178.                         Begin
  179.                            While BadNewFileName Do
  180.                               Begin
  181.                                  LowVideo;
  182.                                  Write('Save to file <');
  183.                                  NormVideo;
  184.                                  Write(KeyFileName);
  185.                                  LowVideo;
  186.                                  Write('> :');
  187.                                  Readln(NewFileName);
  188.                                  Writeln;
  189.                                  FileExtPos := Pos('.',NewFileName);
  190.                                  If Length(NewFileName) > 0
  191.                                     Then If FileExtPos > 0
  192.                                        Then KeyFileName := Copy(NewFileName,
  193.                                           1,FileExtPos - 1)
  194.                                        Else KeyFileName := NewFileName;
  195.                                  Assign(FileVar,KeyFileName+'.KEY');
  196.                                  {$I-} Rewrite(FileVar); {$I+}
  197.                                  If IOResult <> 0
  198.                                     Then Write('Bad file name! ',
  199.                                             'No extension allowed!')
  200.                                     Else BadNewFileName := False;
  201.                                  End; { While the new filename was bad }
  202.                               Writeln('Saving new definitions.');
  203.                            End;
  204.                   End { There were changes }
  205.             Else Goto NoKeyChanges;  { There were no changes to save }
  206.  
  207.          For FunCount := Help to Break Do
  208.             If FunCount In Redefinables
  209.                Then If FunKeys[FunCount] <> GetInitFunkey(FunCount)
  210.                      Then { The definition is not the default value }
  211.                         Begin
  212.                            With FunKeyRec Do
  213.                               Begin
  214.                                  KeyNum := FunCount;
  215.                                  KeyLen := Length(FunKeys[FunCount]);
  216.                                  KeyStr := FunKeys[FunCount];
  217.                                  End;
  218.                            Write(FileVar,FunKeyRec);
  219.                            End; { If this definition should be written }
  220.  
  221.          Close(FileVar);
  222.          NoKeyChanges: LowVideo;
  223.          End; { Procedure WriteKeyFile }
  224.  
  225.  
  226.