home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / hyperkey / hyperkey.pgm < prev    next >
Encoding:
Text File  |  1987-11-11  |  7.3 KB  |  150 lines
  1. (* ------------------------------------------------------------------------- *)
  2. (*                             HYPERKEY.PGM                                  *)
  3. (*                     Das HYPERKEY-Hauptprogramm                            *)
  4. (* ------------------------------------------------------------------------- *)
  5. (*                   Aufbau des HYPERKEY-Arbeitsfensters:                    *)
  6. PROCEDURE InitScreen;
  7. BEGIN
  8.    MkWindow (XWin,YWin,XWin+65,YWin+13,2,FrameColor,WindowBack,WindowBack);
  9.    WriteString ( 4,0, ' ' + Version + ' ');
  10.    WinFrame (XWin+13, YWin+2, XWin+19, YWin+ 4, 1, WindowFore, WindowBack);
  11.    WinFrame (XWin+30, YWin+2, XWin+37, YWin+ 4, 1, WindowFore, WindowBack);
  12.    WinFrame (XWin+49, YWin+2, XWin+59, YWin+ 4, 1, WindowFore, WindowBack);
  13.    WinFrame (XWin+13, YWin+5, XWin+59, YWin+ 7, 1, WindowFore, WindowBack);
  14.    WinFrame (XWin+13, YWin+8, XWin+19, YWin+10, 1, WindowFore, WindowBack);
  15.    WinFrame (XWin+28, YWin+8, XWin+35, YWin+10, 1, WindowFore, WindowBack);
  16.    WinFrame (XWin+47, YWin+8, XWin+59, YWin+10, 1, WindowFore, WindowBack);
  17.    Window (1,1,80,25);              WriteString ( 5,3, 'Nummer:');
  18.    WriteString (23,3, 'Taste:');    WriteString (41,3, 'Status:');
  19.    WriteString ( 5,6, 'Makro:');    WriteString ( 5,9, 'Cursor:');
  20.    WriteString (22,9, 'Code:');     WriteString (38,9, 'Zeichen:')
  21. END;
  22. (*            lesen von Makro-Belegungen aus einer Diskettendatei:           *)
  23. PROCEDURE ReadMacroAssignment;
  24.    VAR WorkPtr   :ListPtrType;       k, ActInt     :INTEGER;
  25.        MacroFile :FILE OF INTEGER;   MacroFileName :STRING[35];
  26.        NameIsValid, EnoughHeap :BOOLEAN;
  27. BEGIN
  28.    CursorShape (full);
  29.    REPEAT
  30.       MenuLine ('Datei zum Lesen:  ');     Read (MacroFileName);
  31.       Assign (MacroFile, MacroFileName);   ReSet (MacroFile);
  32.       NameIsValid := (IOResult = 0);
  33.       IF NOT NameIsValid AND (MacroFileName <> '') THEN  ErrorMsg (4)
  34.    UNTIL NameIsValid OR (MacroFileName = '');
  35.    IF MacroFileName <> '' THEN BEGIN
  36.       WorkPtr := ListHead;                     (* vorhandene Liste loeschen: *)
  37.       WHILE WorkPtr <> NIL DO  DeleteEntry (WorkPtr);
  38.       EnoughHeap := TRUE;
  39.       WHILE NOT Eof(MacroFile) AND EnoughHeap DO BEGIN
  40.          EnoughHeap := EntryInserted (WorkPtr);
  41.          IF EnoughHeap THEN
  42.             WITH WorkPtr^ DO BEGIN
  43.                Read (MacroFile, EntryNr);   Read (MacroFile, ScanCode);
  44.                Read (MacroFile, ActInt);    Active := BOOLEAN (ActInt);
  45.                Read (MacroFile, Replacement[0]);
  46.                FOR k:=1 TO Replacement[0] DO  Read (MacroFile, Replacement[k])
  47.             END
  48.          ELSE  ErrorMsg (1)
  49.       END;
  50.       Close (MacroFile);
  51.       ListEnd := WorkPtr;   ListPtr := ListHead
  52.    END;
  53.    MenuLine (MainMenu)
  54. END;
  55. (*             schreiben von Makro-Belegungen in eine Diskettendatei:        *)
  56. PROCEDURE WriteMacroAssignment;
  57.    VAR WorkPtr :ListPtrType;
  58.        YesNoKey, k, ActInt :INTEGER;    FileExists, NameIsValid :BOOLEAN;
  59.        MacroFile :FILE OF INTEGER;      MacroFileName :STRING[35];
  60. BEGIN
  61.    CursorShape (full);
  62.    REPEAT
  63.       MenuLine ('Datei zum Schreiben:  ');   Read (MacroFileName);
  64.       Assign (MacroFile, MacroFileName);
  65.       IF MacroFileName <> '' THEN BEGIN
  66.          ReSet (MacroFile);   FileExists := (IOResult = 0);
  67.          IF FileExists THEN BEGIN
  68.             Close (MacroFile);   ErrorMsg (5);
  69.             REPEAT  GetKey (YesNoKey);
  70.             UNTIL UpCase(Chr(Lo(YesNoKey))) IN ['J','N'];
  71.             NameIsValid := (UpCase(Chr(Lo(YesNoKey))) = 'J')
  72.          END
  73.          ELSE  NameIsValid := TRUE
  74.       END
  75.    UNTIL NameIsValid OR (MacroFileName = '');
  76.    IF MacroFileName <> '' THEN BEGIN
  77.       ReWrite (MacroFile);   WorkPtr := ListHead;
  78.       WHILE WorkPtr <> NIL DO
  79.          WITH WorkPtr^ DO BEGIN
  80.             ActInt := INTEGER (Active);    Write (MacroFile, EntryNr);
  81.             Write (MacroFile, ScanCode);   Write (MacroFile, ActInt);
  82.             FOR k:=0 TO Replacement[0] DO  Write (MacroFile, Replacement[k]);
  83.             WorkPtr := Next
  84.          END;
  85.       Close (MacroFile)
  86.    END;
  87.    MenuLine (MainMenu)
  88. END;
  89.  
  90. BEGIN (* TSRPgm *)
  91.   InitScreen;   MenuLine (MainMenu);   Quit := FALSE;
  92.   REPEAT                                      (* aktuellen Eintrag anzeigen: *)
  93.     ShowEntry (ListPtr);   GetKey (Key);
  94.     CASE Key OF
  95.       Left:      WITH ListPtr^ DO                      (* Eintrag nach links *)
  96.                     IF ListPtr <> NIL THEN
  97.                        IF Last <> NIL THEN  ListPtr := Last;
  98.       Right:     WITH ListPtr^ DO                     (* Eintrag nach rechts *)
  99.                     IF ListPtr <> NIL THEN
  100.                        IF Next <> NIL THEN  ListPtr := Next;
  101.       Home:      ListPtr := ListHead;                      (* erster Eintrag *)
  102.       End_:      ListPtr := ListEnd;                      (* letzter Eintrag *)
  103.       Delete:    IF ListPtr <> NIL THEN BEGIN            (* Eintrag loeschen *)
  104.                     MenuLine ('Eintrag loeschen (J/N) ? ');
  105.                     CursorShape (Line);   GetKey (YesNoKey);
  106.                     IF UpCase(Chr(Lo((YesNoKey)))) = 'J' THEN
  107.                       DeleteEntry (ListPtr);
  108.                     MenuLine (MainMenu)
  109.                  END;
  110.       ShiftDel:  IF ListPtr <> NIL THEN BEGIN     (* alle Eintraege loeschen *)
  111.                     MenuLine ('Gesamte Liste loeschen (J/N) ? ');
  112.                     CursorShape (Line);   GetKey (YesNoKey);
  113.                     IF UpCase(Chr(Lo((YesNoKey)))) = 'J' THEN
  114.                        WHILE ListPtr <> NIL DO  DeleteEntry (ListPtr);
  115.                     MenuLine (MainMenu)
  116.                  END;
  117.       Insert:    IF NOT EntryInserted(ListPtr) THEN BEGIN
  118.                     ErrorMsg (1);   MenuLine (MainMenu)
  119.                  END
  120.                  ELSE  EditEntry (ListPtr);           (* ab in's Edit-Menue! *)
  121.       Return:    BEGIN
  122.                     IF ListPtr = NIL THEN
  123.                        IF NOT EntryInserted(ListPtr) THEN BEGIN
  124.                           ErrorMsg (1);   MenuLine (MainMenu)
  125.                        END;
  126.                      EditEntry (ListPtr)
  127.                  END;
  128.       Up:        WITH ListPtr^ DO                     (* Belegung aktivieren *)
  129.                     IF ListPtr <> NIL THEN  Active := TRUE;
  130.       Down:      WITH ListPtr^ DO                  (* Belegung desaktivieren *)
  131.                     IF ListPtr <> NIL THEN  Active := FALSE;
  132.       AltUp,
  133.       AltDown:   BEGIN                    (* alle Belegungen (des)aktivieren *)
  134.                     WorkPtr := ListHead;
  135.                     WHILE WorkPtr <> NIL DO
  136.                        WITH WorkPtr^ DO BEGIN
  137.                           Active := (Key = AltUp);   WorkPtr := Next
  138.                        END
  139.                  END;
  140.       PgDn:      ReadMacroAssignment;              (* neue Belegung einlesen *)
  141.       PgUp:      WriteMacroAssignment;     (* aktuelle Belegung wegschreiben *)
  142.       Help:      MainHelp;                   (* Anzeige Main-Hilfsbildschirm *)
  143.       Escape:    Quit := TRUE                      (* Verlassen von HYPERKEY *)
  144.     END
  145.   UNTIL Quit;
  146.   CursorShape (Line);   RmWindow;     (* letzten Bildschirm wiederherstellen *)
  147. END;
  148. (* ------------------------------------------------------------------------- *)
  149. (*                              HYPERKEY.PGM                                 *)
  150.