home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / HOTM60.ZIP / HOTMOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-03-19  |  13.7 KB  |  540 lines
  1. program HotMod;
  2.  
  3. {  Turbo Pascal Hot Key Modification Program.  Version 6.0  03/18/91  }
  4. {  Copyright (c) 1991 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.   MaxOffsets = 8;
  13.  
  14. type
  15.   KeyStr = string[15];
  16.   CursorSize = word;
  17.  
  18.   HotkeyRec = record
  19.     Name : string[25];
  20.     Offsets : array [1..MaxOffsets] of LongInt;
  21.   end;
  22.  
  23. const
  24.   StartAddr = $44F00;
  25.   EndAddr   = $45a00;
  26.  
  27.   NbrOfHotkeys = 26;
  28.   NbrOfRows = succ (NbrOfHotkeys) div 2;
  29.   Hotkeys : array [1..NbrOfHotkeys] of HotkeyRec = (
  30.     (Name: 'Compile|Compile'; Offsets:($4524A,$4576F,$4598E,0,0,0,0,0)),
  31.     (Name: 'Compile|Make'; Offsets:($45260,$45784,$4587F,$459A3,0,0,0,0)),
  32.     (Name: 'Debug|Add Watch'; Offsets:($4530B,0,0,0,0,0,0,0)),
  33.     (Name: 'Debug|Evaluate/Modify'; Offsets:($452DA,0,0,0,0,0,0,0)),
  34.     (Name: 'Debug|Toggle Breakpoint'; Offsets:($4537F,0,0,0,0,0,0,0)),
  35.     (Name: 'File|Exit'; Offsets:($45000,0,0,0,0,0,0,0)),
  36.     (Name: 'File|Open'; Offsets:($44F44,$45761,$45980,0,0,0,0,0)),
  37.     (Name: 'File|Save'; Offsets:($44F65,$45753,$45972,0,0,0,0,0)),
  38.     (Name: 'Help'; Offsets:($45745,$457A7,$4581F,$45854,$458A2,$4590E,$45964,$459C6)),
  39.     (Name: 'Help|Index'; Offsets:($45675,$458D4,0,0,0,0,0,0)),
  40.     (Name: 'Help|Previous Topic'; Offsets:($456B6,$458B8,0,0,0,0,0,0)),
  41.     (Name: 'Help|Topic Search'; Offsets:($45695,0,0,0,0,0,0,0)),
  42.     (Name: 'Menu'; Offsets:($45792,$45800,$4583F,$4588D,$4594F,$459B1,0,0)),
  43.     (Name: 'Run|Go to Cursor'; Offsets:($451DA,0,0,0,0,0,0,0)),
  44.     (Name: 'Run|Program Reset'; Offsets:($451BB,0,0,0,0,0,0,0)),
  45.     (Name: 'Run|Run'; Offsets:($4519B,0,0,0,0,0,0,0)),
  46.     (Name: 'Run|Step Over'; Offsets:($45209,$457C4,$45871,$45941,0,0,0,0)),
  47.     (Name: 'Run|Trace Into'; Offsets:($451F2,$457B5,$45862,$45932,0,0,0,0)),
  48.     (Name: 'Window|Call stack'; Offsets:($455FB,0,0,0,0,0,0,0)),
  49.     (Name: 'Window|Close'; Offsets:($4559F,0,0,0,0,0,0,0)),
  50.     (Name: 'Window|List'; Offsets:($4563B,0,0,0,0,0,0,0)),
  51.     (Name: 'Window|Next'; Offsets:($45570,0,0,0,0,0,0,0)),
  52.     (Name: 'Window|Previous'; Offsets:($45586,0,0,0,0,0,0,0)),
  53.     (Name: 'Window|Size/Move'; Offsets:($45524,0,0,0,0,0,0,0)),
  54.     (Name: 'Window|User Screen'; Offsets:($45619,0,0,0,0,0,0,0)),
  55.     (Name: 'Window|Zoom'; Offsets:($4553B,0,0,0,0,0,0,0)));
  56.  
  57.   MinKey = 14;
  58.   MaxKey = 165;
  59.   KeyNames : array [MinKey..MaxKey] of KeyStr = (
  60.     'Alt-Backspace', {14}
  61.     'Shift-Tab', {15}
  62.     'Alt-Q', {16}
  63.     'Alt-W', {17}
  64.     'Alt-E', {18}
  65.     'Alt-R', {19}
  66.     'Alt-T', {20}
  67.     'Alt-Y', {21}
  68.     'Alt-U', {22}
  69.     'Alt-I', {23}
  70.     'Alt-O', {24}
  71.     'Alt-P', {25}
  72.     'Alt-[', {26}
  73.     'Alt-]', {27}
  74.     'Alt-Enter', {28}
  75.     'Ctrl', {29}
  76.     'Alt-A', {30}
  77.     'Alt-S', {31}
  78.     'Alt-D', {32}
  79.     'Alt-F', {33}
  80.     'Alt-G', {34}
  81.     'Alt-H', {35}
  82.     'Alt-J', {36}
  83.     'Alt-K', {37}
  84.     'Alt-L', {38}
  85.     'Alt-;', {39}
  86.     'Alt-''',    {40}
  87.     'Alt-`', {41}
  88.     'LeftShift',    {42}
  89.     'Alt-\', {43}
  90.     'Alt-Z', {44}
  91.     'Alt-X', {45}
  92.     'Alt-C', {46}
  93.     'Alt-V', {47}
  94.     'Alt-B', {48}
  95.     'Alt-N', {49}
  96.     'Alt-M', {50}
  97.     'Alt-,', {51}
  98.     'Alt-.', {52}
  99.     'Alt-/', {53}
  100.     'RightShift',   {54}
  101.     'PrtSc',    {55}
  102.     'Alt',  {56}
  103.     'Space',    {57}
  104.     'CapLock',  {58}
  105.     'F1',   {59}
  106.     'F2',   {60}
  107.     'F3',   {61}
  108.     'F4',   {62}
  109.     'F5',   {63}
  110.     'F6',   {64}
  111.     'F7',   {65}
  112.     'F8',   {66}
  113.     'F9',   {67}
  114.     'F10',  {68}
  115.     'NumLock',  {69}
  116.     'ScrollLock',   {70}
  117.     'Home', {71}
  118.     'UpArrow',  {72}
  119.     'PgUp', {73}
  120.     'Minus',    {74}
  121.     'LeftArrow',    {75}
  122.     'Center',   {76}
  123.     'RightArrow',   {77}
  124.     'Plus', {78}
  125.     'End',  {79}
  126.     'DownArrow',    {80}
  127.     'PgDn', {81}
  128.     'Ins',  {82}
  129.     'Del',  {83}
  130.     'Shift-F1',  {84}
  131.     'Shift-F2',  {85}
  132.     'Shift-F3',  {86}
  133.     'Shift-F4',  {87}
  134.     'Shift-F5',  {88}
  135.     'Shift-F6',  {89}
  136.     'Shift-F7',  {90}
  137.     'Shift-F8',  {91}
  138.     'Shift-F9',  {92}
  139.     'Shift-F10', {93}
  140.     'Ctrl-F1',   {94}
  141.     'Ctrl-F2',   {95}
  142.     'Ctrl-F3',   {96}
  143.     'Ctrl-F4',   {97}
  144.     'Ctrl-F5',   {98}
  145.     'Ctrl-F6',   {99}
  146.     'Ctrl-F7',   {100}
  147.     'Ctrl-F8',   {101}
  148.     'Ctrl-F9',   {102}
  149.     'Ctrl-F10',  {103}
  150.     'Alt-F1',    {104}
  151.     'Alt-F2',    {105}
  152.     'Alt-F3',    {106}
  153.     'Alt-F4',    {107}
  154.     'Alt-F5',    {108}
  155.     'Alt-F6',    {109}
  156.     'Alt-F7',    {110}
  157.     'Alt-F8',    {111}
  158.     'Alt-F9',    {112}
  159.     'Alt-F10',   {113}
  160.     'Ctrl-PrtSc',    {114}
  161.     'Ctrl-LeftArrow',    {115}
  162.     'Ctrl-RightArrow',   {116}
  163.     'Ctrl-End',  {117}
  164.     'Ctrl-PgDn', {118}
  165.     'Ctrl-Home', {119}
  166.     'Alt-1', {120}
  167.     'Alt-2', {121}
  168.     'Alt-3', {122}
  169.     'Alt-4', {123}
  170.     'Alt-5', {124}
  171.     'Alt-6', {125}
  172.     'Alt-7', {126}
  173.     'Alt-8', {127}
  174.     'Alt-9', {128}
  175.     'Alt-0', {129}
  176.     'Alt--', {130}
  177.     'Alt-=', {131}
  178.     'Ctrl-PgUp', {132}
  179.     'F11',  {133}
  180.     'F12',  {134}
  181.     'Shift-F11', {135}
  182.     'Shift-F12', {136}
  183.     'Ctrl-F11',  {137}
  184.     'Ctrl-F12',  {138}
  185.     'Alt-F11',   {139}
  186.     'Alt-F12',   {140}
  187.     'Ctrl-UpArrow',  {141}
  188.     'Ctrl-Minus',    {142}
  189.     'Ctrl-Center',   {143}
  190.     'Ctrl-Plus', {144}
  191.     'Ctrl-DownArrow',    {145}
  192.     'Ctrl-Ins',  {146}
  193.     'Ctrl-Del',  {147}
  194.     'Ctrl-Tab',  {148}
  195.     '?',    {149}
  196.     '?',    {150}
  197.     'Alt-Home',  {151}
  198.     'Alt-UpArrow',   {152}
  199.     'Alt-PgUp',  {153}
  200.     '?',    {154}
  201.     'Alt-LeftArrow', {155}
  202.     'Alt-Center',    {156}
  203.     'Alt-RightArrow',    {157}
  204.     '?',    {158}
  205.     'Alt-End',   {159}
  206.     'Alt-DownArrow', {160}
  207.     'Alt-PgDn',  {161}
  208.     'Alt-Ins',   {162}
  209.     'Alt-Del',   {163}
  210.     '?',    {164}
  211.     'Alt-Tab');  {165}
  212.  
  213. var
  214.   Turbo : file;
  215.   OriginalCursor: CursorSize;
  216.   Buf : array [0..EndAddr-StartAddr] of Byte;
  217.   Save : Boolean;
  218.  
  219. function MonoDisplay: boolean;
  220.   { Return true if the current display is a monochrome adapter }
  221.   var Reg: Registers;
  222. begin
  223.   Reg.AH := $0F;
  224.   Intr ($10, Reg);
  225.   MonoDisplay := Reg.AL = 7
  226. end;
  227.  
  228. procedure GetCursor (var Curs: CursorSize);
  229.   { Get the current cursor size }
  230.   var Reg: Registers;
  231. begin
  232.   Reg.AH := $03;
  233.   Reg.BH := $00;
  234.   Intr ($10, Reg);
  235.   if (Reg.CX=$0607) and MonoDisplay
  236.    then
  237.     Curs := $0C0D                                { Watch out for bug in DOS }
  238.    else
  239.     Curs := Reg.CX
  240. end;
  241.  
  242. procedure SetCursor (Curs: CursorSize);
  243.   { Set the current cursor size }
  244.   var Reg: Registers;
  245. begin
  246.   Reg.AH := $01;
  247.   Reg.CX := Curs;
  248.   Intr ($10, Reg)
  249. end;
  250.  
  251. function KeyName (Key : Byte) : KeyStr;
  252. {  Return the name of the key, given its key code  }
  253. begin
  254.   if Key = 0 then
  255.     KeyName := '<Disabled>'
  256.   else if (Key >= MinKey) and (Key <= MaxKey) then
  257.     KeyName := KeyNames[Key]
  258.   else
  259.     KeyName := '?';
  260. end;
  261.  
  262. function Pad (S : String; Len : Integer) : String;
  263. begin
  264.   while Length (S) < Len do
  265.     S := S + ' ';
  266.   Pad := S;
  267. end;
  268.  
  269. function LeftPad (S : String; Len : Integer) : String;
  270. begin
  271.   while Length (S) < Len do
  272.     S := ' ' + S;
  273.   LeftPad := S;
  274. end;
  275.  
  276. function CharStr (Ch : Char; Len : Byte) : string;
  277. var
  278.   S : string;
  279. begin
  280.   Byte(S[0]) := Len;
  281.   FillChar (S[1], Len, Ch);
  282.   CharStr := S;
  283. end;
  284.  
  285. procedure NormalVideo;
  286. begin
  287.   if MonoDisplay then begin
  288.     TextColor (White);
  289.     TextBackground (Black);
  290.   end
  291.   else begin
  292.     TextColor (LightGray);
  293.     TextBackground (Blue);
  294.   end;
  295. end;
  296.  
  297. procedure ReverseVideo;
  298. begin
  299.   if MonoDisplay then begin
  300.     TextColor (Black);
  301.     TextBackground (LightGray);
  302.   end
  303.   else begin
  304.     TextColor (White);
  305.     TextBackground (Black);
  306.   end;
  307. end;
  308.  
  309. function GetKeyOffset (L : LongInt) : LongInt;
  310. { Given the offset of the text string, return the offset of the key code }
  311. begin
  312.   if Buf[L-StartAddr+1] = ord('~') then
  313.     GetKeyOffset := L + Buf[L-StartAddr] + 2
  314.   else
  315.     GetKeyOffset := L - 3;
  316. end;
  317.  
  318. function GetKeyCode (L : LongInt) : Byte;
  319. { Given the offset of the text string, return the associated key code }
  320. begin
  321.   GetKeyCode := Buf[GetKeyOffset(L)-StartAddr];
  322. end;
  323.  
  324. procedure PutKeyCode (L : LongInt; K : Byte);
  325. { Given the offset of the text string, update the associated key code }
  326. begin
  327.   Buf[GetKeyOffset(L)-StartAddr] := K;
  328. end;
  329.  
  330. procedure DisplayHotkey (I : Integer);
  331. {  Display the name and current key assignment of the hot key }
  332. begin
  333.   with Hotkeys[I] do begin
  334.     GotoXY (40 * (pred (I) div NbrOfRows) + 1, pred (I) mod NbrOfRows + 10);
  335.     Write (Pad (Name, 25), Pad (Keyname (GetKeyCode(Offsets[1])), 15));
  336.   end;
  337. end;
  338.  
  339. procedure DisplayMenu;
  340. var
  341.   I : Integer;
  342. begin
  343.   TextColor (Black);
  344.   TextBackground (LightGray);
  345.   ClrScr;
  346.   Writeln ('HOTMOD - The Turbo Pascal Hot Key Modifier.  Version 6.0.');
  347.   Writeln ('Copyright (c) 1991 Ron Schuster.  For non-commercial use only.');
  348.   Writeln;
  349.   Writeln ('Move the cursor to the hot key that you want to change.');
  350.   Writeln ('Press the key that you want to change it to.');
  351.   Writeln ('To disable a hot key, press Ctrl-@.  The disabled key can then be');
  352.   Writeln ('reassigned to an editor function or macro with Borland''s TEMC program.');
  353.   Writeln ('Press Esc to save your changes and exit.');
  354.   NormalVideo;
  355.   for I := 1 to NbrOfHotkeys do
  356.     DisplayHotkey (I);
  357. end;
  358.  
  359. function Read_Key : Word;
  360. var
  361.   Key : Char;
  362. begin
  363.   Key := ReadKey;
  364.   if Key = #0 then begin
  365.     Key := ReadKey;
  366.     if Key = #3 then
  367.       Read_Key := 0   {Ctrl-@}
  368.     else
  369.       Read_Key := word (ord (Key)) shl 8;
  370.   end
  371.   else
  372.     Read_Key := ord (Key);
  373. end;
  374.  
  375. function MakeChanges : boolean;
  376. const
  377.   Esc = 27;
  378.   UpArrow = 72;
  379.   DownArrow = 80;
  380.   LeftArrow = 75;
  381.   RightArrow = 77;
  382. var
  383.   Sel : Integer;
  384.   I : Integer;
  385.   Key : Word;
  386.   Done : Boolean;
  387.   HiKey : Byte;
  388.   ChangeMade : Boolean;
  389.  
  390.   procedure ChangeSelection (New : Integer);
  391.   begin
  392.     NormalVideo;
  393.     DisplayHotkey (Sel);
  394.     Sel := New;
  395.     ReverseVideo;
  396.     DisplayHotkey (Sel);
  397.   end;
  398.  
  399.   procedure ChangeKeys;
  400.   var
  401.     I : Integer;
  402.   begin
  403.     with Hotkeys[Sel] do
  404.       for I := 1 to MaxOffsets do
  405.         if Offsets[I] <> 0 then
  406.           PutKeyCode (Offsets[I], Hi(Key));
  407.   end;
  408.  
  409.   procedure ChangeHelps;
  410.   var
  411.     NewKeyName : KeyStr;
  412.     MaxHelpLen : Integer;
  413.     I : Integer;
  414.   begin
  415.     with Hotkeys[Sel] do begin
  416.       NewKeyName := KeyName(Hi(Key));
  417.       if Buf[Offsets[1]-StartAddr+1] <> ord('~') then
  418.         MaxHelpLen := Buf[Offsets[1]-StartAddr]
  419.       else begin
  420.         MaxHelpLen := 1;
  421.         while Buf[Offsets[1]-StartAddr+2+MaxHelpLen] <> ord('~') do
  422.           Inc(MaxHelpLen);
  423.       end;
  424.       if (NewKeyName[1] = '<') or (Length(NewKeyName) > MaxHelpLen) then
  425.         NewKeyName := CharStr ('*', MaxHelpLen)
  426.       else
  427.         NewKeyName := LeftPad(NewKeyName, MaxHelpLen);
  428.       for I := 1 to MaxOffsets do
  429.         if Offsets[I] <> 0 then
  430.           if Buf[Offsets[I]-StartAddr+1] <> ord('~') then
  431.             Move (NewKeyName[1],Buf[Offsets[I]-StartAddr+1],MaxHelpLen)
  432.           else
  433.             Move (NewKeyName[1],Buf[Offsets[I]-StartAddr+2],MaxHelpLen);
  434.     end;
  435.   end;
  436.  
  437. begin  {MakeChanges}
  438.   ChangeMade := False;
  439.   Sel := 1;
  440.   ReverseVideo;
  441.   DisplayHotkey (1);
  442.   Done := False;
  443.   repeat
  444.     Key := Read_Key;
  445.     case Lo (Key) of
  446.       0: case Hi (Key) of
  447.            UpArrow: if Sel > 1 then
  448.                       ChangeSelection (pred (Sel));
  449.            DownArrow: if Sel < NbrOfHotkeys then
  450.                         ChangeSelection (succ (Sel));
  451.            LeftArrow: if Sel > NbrOfRows then
  452.                         ChangeSelection (Sel - NbrOfRows);
  453.            RightArrow: if Sel <= NbrOfRows then
  454.                         ChangeSelection (Sel + NbrOfRows);
  455.            else begin
  456.              if GetKeyCode(Hotkeys[Sel].Offsets[1]) <> Hi(Key) then begin
  457.                ChangeKeys;
  458.                ChangeHelps;
  459.                DisplayHotkey (Sel);
  460.                ChangeMade := True;
  461.              end;
  462.            end;
  463.          end; {case Hi (Key)}
  464.       Esc : Done := True;
  465.       else Write (^G);
  466.     end; {case Lo (Key)}
  467.   until Done;
  468.   ClrScr;
  469.   if ChangeMade then begin
  470.     Write ('Save changes to TURBO.EXE (Y/N) ?');
  471.     repeat
  472.       Key := Read_Key
  473.     until Upcase(Chr(Lo(Key))) in ['Y','N'];
  474.     MakeChanges := Upcase(Chr(Lo(Key))) = 'Y';
  475.   end
  476.   else
  477.     MakeChanges := False;
  478. end;  {MakeChanges}
  479.  
  480. procedure OpenTurbo;
  481. var
  482.   IO_result : Word;
  483.   Result : Word;
  484. begin
  485.   {$I-}
  486.   Assign (Turbo, 'TURBO.EXE');
  487.   Reset (Turbo,1);
  488.   IO_result := IOresult;
  489.   if IO_result <> 0 then begin
  490.     Writeln ('Could not open TURBO.EXE');
  491.     Writeln ('IOresult = ', IO_result);
  492.     Halt (1);
  493.   end;
  494.   if FileSize (Turbo) <> 325397 then begin
  495.     Writeln ('Incorrect version of Turbo Pascal.  This program only supports 6.0.');
  496.     Halt (2);
  497.   end;
  498.   Seek (Turbo, StartAddr);
  499.   BlockRead (Turbo, Buf, sizeof(Buf), Result);
  500.   IO_result := IOresult;
  501.   if (IO_result <> 0) or (Result <> sizeof(Buf)) then begin
  502.     Writeln ('Error reading TURBO.EXE');
  503.     Writeln ('IOresult = ', IO_result);
  504.     Halt (1);
  505.   end;
  506.   {$I+}
  507. end;
  508.  
  509. procedure CloseTurbo(Save : Boolean);
  510. var
  511.   IO_result : Word;
  512.   Result : Word;
  513. begin
  514.   {$I-}
  515.   if Save then begin
  516.     Seek (Turbo, StartAddr);
  517.     BlockWrite (Turbo, Buf, sizeof(Buf), Result);
  518.     IO_result := IOresult;
  519.     if (IO_result <> 0) or (Result <> sizeof(Buf)) then begin
  520.       Writeln ('Error writing changes to TURBO.EXE');
  521.       Writeln ('IOresult = ', IO_result);
  522.       Halt (1);
  523.     end;
  524.   end;
  525.   Close (Turbo);
  526.   {$I+}
  527. end;
  528.  
  529. begin { main program }
  530.   OpenTurbo;
  531.   GetCursor (OriginalCursor);
  532.   SetCursor ($2000);  { Make the cursor invisible }
  533.   DisplayMenu;
  534.   Save := MakeChanges;
  535.   SetCursor (OriginalCursor);
  536.   NormVideo;
  537.   ClrScr;
  538.   CloseTurbo(Save);
  539. end.
  540.