home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HOTMOD.ZIP / HOTMOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-11-09  |  10.5 KB  |  388 lines
  1. program HotMod;
  2.  
  3. {  Turbo Pascal 5.0 Hot Key Modification Program.  Version 1.0  11/7/88  }
  4. {  Copyright (c) 1988 Ron Schuster.  For non-commercial use only.  }
  5.  
  6. {  The cursor routines were extracted from CURSORS.PAS by Scott Bussinger.  The
  7.    complete set can be downloaded from CompuServe. (BPROGA Lib 6 CURSOR.ARC)  }
  8.  
  9. uses Crt, Dos;
  10.  
  11. const
  12.   NbrOfTables = 2;  {  Number of hot key assignment tables in TURBO.EXE  }
  13.   TableBase : array [1..NbrOfTables] of LongInt = (136058, 136320);
  14.  
  15. type
  16.   KeyStr = string[15];
  17.   CursorSize = word;
  18.  
  19.   HotkeyRec = record
  20.     Name : string[20];
  21.     Offset : array [1..NbrOfTables] of Integer;
  22.   end;
  23.  
  24.   KeyRec = record
  25.     Name : KeyStr;
  26.     Code : Byte;
  27.   end;
  28.  
  29. const
  30.   NbrOfHotkeys = 30;
  31.   NbrOfRows = succ (NbrOfHotkeys) div 2;
  32.   Hotkeys : array [1..NbrOfHotkeys] of HotkeyRec = (
  33.     (Name: 'Break/watch menu'; Offset: (69, 81)),
  34.     (Name: 'B/Add watch'; Offset: (72, 51)),
  35.     (Name: 'B/Toggle breakpoint'; Offset: (63, 54)),
  36.     (Name: 'Compile menu'; Offset: (33, 75)),
  37.     (Name: 'Compile/Compile'; Offset: (24, 21)),
  38.     (Name: 'Compile/Make'; Offset: (21, 18)),
  39.     (Name: 'Debug menu'; Offset: (51, 84)),
  40.     (Name: 'Debug/Call stack'; Offset: (81, 39)),
  41.     (Name: 'Debug/Evaluate'; Offset: (60, 42)),
  42.     (Name: 'Edit'; Offset: (-1, 69)),
  43.     (Name: 'File menu'; Offset: (36, 66)),
  44.     (Name: 'File/Load'; Offset: (12, 3)),
  45.     (Name: 'File/Pick'; Offset: (42, 27)),
  46.     (Name: 'File/Quit'; Offset: (15, 93)),
  47.     (Name: 'File/Save'; Offset: (0, 6)),
  48.     (Name: 'Help'; Offset: (-1, 57)),
  49.     (Name: 'Last help'; Offset: (-1, 60)),
  50.     (Name: 'Menu'; Offset: (27, 24)),
  51.     (Name: 'Options menu'; Offset: (39, 78)),
  52.     (Name: 'Run menu'; Offset: (30, 72)),
  53.     (Name: 'Run/Go to cursor'; Offset: (66, 33)),
  54.     (Name: 'Run/Program reset'; Offset: (78, 36)),
  55.     (Name: 'Run/Run'; Offset: (75, 30)),
  56.     (Name: 'Run/Step over'; Offset: (57, 48)),
  57.     (Name: 'Run/Trace into'; Offset: (54, 45)),
  58.     (Name: 'Run/User screen'; Offset: (48, 63)),
  59.     (Name: 'Swap'; Offset: (18, 12)),
  60.     (Name: 'Switch'; Offset: (9, 9)),
  61.     (Name: 'Version screen'; Offset: (45, 0)),
  62.     (Name: 'Zoom'; Offset: (6, 15)));
  63.  
  64.   NbrOfkeys = 103;
  65.   KeyNames : array [1..NbrOfKeys] of KeyRec = (
  66.     (Name: 'Alt0'; Code: 129),
  67.     (Name: 'Alt1'; Code: 120),
  68.     (Name: 'Alt2'; Code: 121),
  69.     (Name: 'Alt3'; Code: 122),
  70.     (Name: 'Alt4'; Code: 123),
  71.     (Name: 'Alt5'; Code: 124),
  72.     (Name: 'Alt6'; Code: 125),
  73.     (Name: 'Alt7'; Code: 126),
  74.     (Name: 'Alt8'; Code: 127),
  75.     (Name: 'Alt9'; Code: 128),
  76.     (Name: 'AltA'; Code: 30),
  77.     (Name: 'AltB'; Code: 48),
  78.     (Name: 'AltC'; Code: 46),
  79.     (Name: 'AltD'; Code: 32),
  80.     (Name: 'AltDash'; Code: 130),
  81.     (Name: 'AltE'; Code: 18),
  82.     (Name: 'AltEqual'; Code: 131),
  83.     (Name: 'AltF'; Code: 33),
  84.     (Name: 'AltF1'; Code: 104),
  85.     (Name: 'AltF10'; Code: 113),
  86.     (Name: 'AltF11'; Code: 139),
  87.     (Name: 'AltF12'; Code: 140),
  88.     (Name: 'AltF2'; Code: 105),
  89.     (Name: 'AltF3'; Code: 106),
  90.     (Name: 'AltF4'; Code: 107),
  91.     (Name: 'AltF5'; Code: 108),
  92.     (Name: 'AltF6'; Code: 109),
  93.     (Name: 'AltF7'; Code: 110),
  94.     (Name: 'AltF8'; Code: 111),
  95.     (Name: 'AltF9'; Code: 112),
  96.     (Name: 'AltG'; Code: 34),
  97.     (Name: 'AltH'; Code: 35),
  98.     (Name: 'AltI'; Code: 23),
  99.     (Name: 'AltJ'; Code: 36),
  100.     (Name: 'AltK'; Code: 37),
  101.     (Name: 'AltL'; Code: 38),
  102.     (Name: 'AltM'; Code: 50),
  103.     (Name: 'AltN'; Code: 49),
  104.     (Name: 'AltO'; Code: 24),
  105.     (Name: 'AltP'; Code: 25),
  106.     (Name: 'AltQ'; Code: 16),
  107.     (Name: 'AltR'; Code: 19),
  108.     (Name: 'AltS'; Code: 31),
  109.     (Name: 'AltT'; Code: 20),
  110.     (Name: 'AltU'; Code: 22),
  111.     (Name: 'AltV'; Code: 47),
  112.     (Name: 'AltW'; Code: 17),
  113.     (Name: 'AltX'; Code: 45),
  114.     (Name: 'AltY'; Code: 21),
  115.     (Name: 'AltZ'; Code: 44),
  116.     (Name: 'CtrlEnd'; Code: 117),
  117.     (Name: 'CtrlF1'; Code: 94),
  118.     (Name: 'CtrlF10'; Code: 103),
  119.     (Name: 'CtrlF11'; Code: 137),
  120.     (Name: 'CtrlF12'; Code: 138),
  121.     (Name: 'CtrlF2'; Code: 95),
  122.     (Name: 'CtrlF3'; Code: 96),
  123.     (Name: 'CtrlF4'; Code: 97),
  124.     (Name: 'CtrlF5'; Code: 98),
  125.     (Name: 'CtrlF6'; Code: 99),
  126.     (Name: 'CtrlF7'; Code: 100),
  127.     (Name: 'CtrlF8'; Code: 101),
  128.     (Name: 'CtrlF9'; Code: 102),
  129.     (Name: 'CtrlHome'; Code: 119),
  130.     (Name: 'CtrlLeftArrow'; Code: 115),
  131.     (Name: 'CtrlPgDn'; Code: 118),
  132.     (Name: 'CtrlPgUp'; Code: 132),
  133.     (Name: 'CtrlRightArrow'; Code: 116),
  134.     (Name: 'DelKey'; Code: 83),
  135.     (Name: 'DownArrow'; Code: 80),
  136.     (Name: 'EndKey'; Code: 79),
  137.     (Name: 'F1'; Code: 59),
  138.     (Name: 'F10'; Code: 68),
  139.     (Name: 'F11'; Code: 133),
  140.     (Name: 'F12'; Code: 134),
  141.     (Name: 'F2'; Code: 60),
  142.     (Name: 'F3'; Code: 61),
  143.     (Name: 'F4'; Code: 62),
  144.     (Name: 'F5'; Code: 63),
  145.     (Name: 'F6'; Code: 64),
  146.     (Name: 'F7'; Code: 65),
  147.     (Name: 'F8'; Code: 66),
  148.     (Name: 'F9'; Code: 67),
  149.     (Name: 'Home'; Code: 71),
  150.     (Name: 'InsKey'; Code: 82),
  151.     (Name: 'LeftArrow'; Code: 75),
  152.     (Name: 'PgDn'; Code: 81),
  153.     (Name: 'PgUp'; Code: 73),
  154.     (Name: 'RightArrow'; Code: 77),
  155.     (Name: 'ShiftF1'; Code: 84),
  156.     (Name: 'ShiftF10'; Code: 93),
  157.     (Name: 'ShiftF11'; Code: 135),
  158.     (Name: 'ShiftF12'; Code: 136),
  159.     (Name: 'ShiftF2'; Code: 85),
  160.     (Name: 'ShiftF3'; Code: 86),
  161.     (Name: 'ShiftF4'; Code: 87),
  162.     (Name: 'ShiftF5'; Code: 88),
  163.     (Name: 'ShiftF6'; Code: 89),
  164.     (Name: 'ShiftF7'; Code: 90),
  165.     (Name: 'ShiftF8'; Code: 91),
  166.     (Name: 'ShiftF9'; Code: 92),
  167.     (Name: 'ShiftTab'; Code: 15),
  168.     (Name: 'UpArrow'; Code: 72));
  169.  
  170. var
  171.   Turbo : file of Byte;
  172.   OriginalCursor: CursorSize;
  173.  
  174. function MonoDisplay: boolean;
  175.   { Return true if the current display is a monochrome adapter }
  176.   var Reg: Registers;
  177. begin
  178.   Reg.AH := $0F;
  179.   Intr ($10, Reg);
  180.   MonoDisplay := Reg.AL = 7
  181. end;
  182.  
  183. procedure GetCursor (var Curs: CursorSize);
  184.   { Get the current cursor size }
  185.   var Reg: Registers;
  186. begin
  187.   Reg.AH := $03;
  188.   Reg.BH := $00;
  189.   Intr ($10, Reg);
  190.   if (Reg.CX=$0607) and MonoDisplay
  191.    then
  192.     Curs := $0C0D                                { Watch out for bug in DOS }
  193.    else
  194.     Curs := Reg.CX
  195. end;
  196.  
  197. procedure SetCursor (Curs: CursorSize);
  198.   { Set the current cursor size }
  199.   var Reg: Registers;
  200. begin
  201.   Reg.AH := $01;
  202.   Reg.CX := Curs;
  203.   Intr ($10, Reg)
  204. end;
  205.  
  206. function KeyName (Key : Byte) : KeyStr;
  207. {  Return the name of the key, given its key code  }
  208. var
  209.   S : KeyStr;
  210.   I : Integer;
  211. begin
  212.   for I := 1 to NbrOfKeys do
  213.     with KeyNames[I] do
  214.       if Code = Key then begin
  215.         KeyName := Name;
  216.         Exit;
  217.       end;
  218.   Str (Key, S);  { If Key value not found in table }
  219.   KeyName := S;  { use the number as the name }
  220. end;
  221.  
  222. function Pad (S : String; Len : Integer) : String;
  223. {  Pad the string S out to length Len with spaces  }
  224. begin
  225.   while Length (S) < Len do
  226.     S := S + ' ';
  227.   Pad := S;
  228. end;
  229.  
  230. procedure NormalVideo;
  231. begin
  232.   if MonoDisplay then begin
  233.     TextColor (White);
  234.     TextBackground (Black);
  235.   end
  236.   else begin
  237.     TextColor (LightGray);
  238.     TextBackground (Blue);
  239.   end;
  240. end;
  241.  
  242. procedure ReverseVideo;
  243. begin
  244.   if MonoDisplay then begin
  245.     TextColor (Black);
  246.     TextBackground (LightGray);
  247.   end
  248.   else begin
  249.     TextColor (White);
  250.     TextBackground (Black);
  251.   end;
  252. end;
  253.  
  254. procedure DisplayHotkey (I : Integer);
  255. {  Display the name and current key assignment of the hot key }
  256. var
  257.   B : Byte;
  258. begin
  259.   with Hotkeys[I] do begin
  260.     B := 1;
  261.     while (Offset[B] = -1) do
  262.       Inc (B);
  263.     Seek (Turbo, TableBase[B] + Offset[B]);
  264.     Read (Turbo, B);
  265.     GotoXY (40 * (pred (I) div NbrOfRows) + 1,
  266.             pred (I) mod NbrOfRows + 7);
  267.     Write (Pad (Name, 25), Pad (Keyname (B), 15));
  268.   end;
  269. end;
  270.  
  271. procedure DisplayMenu;
  272. var
  273.   I : Integer;
  274. begin
  275.   TextColor (Black);
  276.   TextBackground (LightGray);
  277.   ClrScr;
  278.   Writeln ('HOTMOD - The Turbo Pascal 5.0 Hot Key Modifier.  Version 1.0.');
  279.   Writeln ('Copyright (c) 1988 Ron Schuster.  For non-commercial use only.');
  280.   Writeln ('Move the cursor to the hot key that you want to change.');
  281.   Writeln ('Press the key that you want to change it to.');
  282.   Writeln ('Press Esc to save your changes and exit.');
  283.   NormalVideo;
  284.   for I := 1 to NbrOfHotkeys do
  285.     DisplayHotkey (I);
  286. end;
  287.  
  288. function Read_Key : Word;
  289. var
  290.   Key : Char;
  291. begin
  292.   Key := ReadKey;
  293.   if Key = #0 then begin
  294.     Key := ReadKey;
  295.     Read_Key := word (ord (Key)) shl 8;
  296.   end
  297.   else
  298.     Read_Key := ord (Key);
  299. end;
  300.  
  301. procedure MakeChanges;
  302. const
  303.   Esc = 27;
  304.   UpArrow = 72;
  305.   DownArrow = 80;
  306.   LeftArrow = 75;
  307.   RightArrow = 77;
  308. var
  309.   Sel : Integer;
  310.   I : Integer;
  311.   Key : Word;
  312.   Done : Boolean;
  313.   HiKey : Byte;
  314.  
  315.   procedure ChangeSelection (New : Integer);
  316.   begin
  317.     NormalVideo;
  318.     DisplayHotkey (Sel);
  319.     Sel := New;
  320.     ReverseVideo;
  321.     DisplayHotkey (Sel);
  322.   end;
  323.  
  324. begin  {MakeChanges}
  325.   Sel := 1;
  326.   ReverseVideo;
  327.   DisplayHotkey (1);
  328.   Done := False;
  329.   repeat
  330.     Key := Read_Key;
  331.     case Lo (Key) of
  332.       0: case Hi (Key) of
  333.            UpArrow: if Sel > 1 then
  334.                       ChangeSelection (pred (Sel));
  335.            DownArrow: if Sel < NbrOfHotkeys then
  336.                         ChangeSelection (succ (Sel));
  337.            LeftArrow: if Sel > NbrOfRows then
  338.                         ChangeSelection (Sel - NbrOfRows);
  339.            RightArrow: if Sel <= NbrOfRows then
  340.                         ChangeSelection (Sel + NbrOfRows);
  341.            else begin
  342.              with Hotkeys[Sel] do
  343.                for I := 1 to NbrOfTables do
  344.                  if Offset[I] <> -1 then begin
  345.                    Seek (Turbo, TableBase[I] + Offset[I]);
  346.                    HiKey := Hi (Key);
  347.                    Write (Turbo, HiKey);
  348.                  end;
  349.              DisplayHotkey (Sel);
  350.            end;
  351.          end; {case Hi (Key)}
  352.       Esc: Done := True;
  353.       else Write (^G);
  354.     end; {case Lo (Key)}
  355.   until Done;
  356. end;  {MakeChanges}
  357.  
  358. procedure OpenTurbo;
  359. {$I-}
  360. var
  361.   IO_result : Word;
  362. begin
  363.   Assign (Turbo, 'TURBO.EXE');
  364.   Reset (Turbo);
  365.   IO_result := IOresult;
  366.   if IO_result <> 0 then begin
  367.     Writeln ('Could not open TURBO.EXE');
  368.     Writeln ('IOresult = ', IO_result);
  369.     Halt (1);
  370.   end;
  371.   if FileSize (Turbo) <> 149793 then begin
  372.     Writeln ('Incorrect version of Turbo Pascal');
  373.     Halt (2);
  374.   end;
  375. end;
  376.  
  377. begin { main program }
  378.   OpenTurbo;
  379.   GetCursor (OriginalCursor);
  380.   SetCursor ($2000);  { Make the cursor invisible }
  381.   DisplayMenu;
  382.   MakeChanges;
  383.   SetCursor (OriginalCursor);
  384.   NormVideo;
  385.   ClrScr;
  386.   Close (Turbo);
  387. end.
  388.