home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / readme / readme.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-05-16  |  34.2 KB  |  1,019 lines
  1. (* ====================================================== *)
  2. (*              README.PAS v2.5   (16.5.94)               *)
  3. (*      Copyright (C) 1993, 1994 J. Braun & toolbox       *)
  4. (*      Compiler: Turbo Pascal/Borland Pascal 7.0         *)
  5. (*             Target: DOS Real-Mode                      *)
  6. (* ====================================================== *)
  7. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+,P-,Q-,T-,Y-}
  8. {$M $3FF1,0,$FFFF}
  9. {$IFNDEF VER70}  Fehler: Falsche Compiler-Version   {$ENDIF}
  10. {$IFDEF Windows} Fehler: Falsches Target!           {$ENDIF}
  11. {$IFDEF DPMI}    Fehler: Falsches Target!           {$ENDIF}
  12.  
  13. PROGRAM ReadMe;
  14.  
  15. USES
  16.   Crt, Dos, Strings, ReadText;
  17.  
  18. {$I LINES.INC}
  19.  
  20. TYPE
  21.   tScreen  = ARRAY[0..24, 0..79] OF RECORD
  22.                char: CHAR;
  23.                attr: BYTE;
  24.              END;
  25.   tCharSet = SET OF CHAR;    (* Erweiterung 11. 5. 94 /jb *)
  26.  
  27. CONST                        (* Erweiterung 11. 5. 94 /jb *)
  28.   FileChars   : tCharset = ['A'..'Z', '0'..'9', '.', '\',
  29.                             ':', '_'];
  30.   SearchChars : tCharset = [^U, ' '..#255];    (* 13.5.94 *)
  31.   PortChars   : tCharset = ['C', 'L'..'P', 'R', 'T',
  32.                             '1'..'4'];
  33.  
  34.   FirstPosition : INTEGER = 0; (* Anzahl der Spaces links *)
  35.                                (* vom Text. Bei Änderung  *)
  36.                                (* wandert der angezeigte  *)
  37.                                (* Text nach rechts bzw.   *)
  38.                                (* nach links              *)
  39.   Incr          = TRUE;
  40.   Decr          = FALSE;
  41.  
  42.   StatusColor : BYTE      = $70; (* schwarz auf weiß      *)
  43.   ErrorColor  : BYTE      = $74; (* rot auf weiß          *)
  44.   PrintColor  : BYTE      = $47; (* weiß auf rot          *)
  45.   SearchColor : BYTE      = $9F; (* weiß auf blau blinkend*)
  46.   HelpColor   : BYTE      = $30; (* schwarz auf Cyan      *)
  47.   NormColor   : BYTE      = $1E; (* gelb auf blau         *)
  48.   PortName    : STRING[4] = 'LPT1';
  49.   StartCursor : WORD      = $0607;
  50.   MyCopyright : pChar     = 'Erzeugt mit dem Readme-Builder'
  51.                           + ' der toolbox, (C) 1993 - 94 J.'
  52.                           + ' Braun & toolbox';
  53.  
  54. VAR
  55.   DosBoxColor,                         (* wird ausgelesen *)
  56.   DefaultColor,                        (* Grundfarbe      *)
  57.   ActualColor       : BYTE;
  58.   ActualCursor      : WORD    ABSOLUTE $0040:$0060;  (* ! *)
  59.   MonoScreen        : tScreen ABSOLUTE $B000:$0000;  (* ! *)
  60.   ColorScreen       : tScreen ABSOLUTE $B800:$0000;  (* ! *)
  61.   DoBeep, Monochrom : BOOLEAN;
  62.   LastSearch, LCStr : STRING;
  63.   BIOSCursor        : WORD;
  64.   OldExitProc       : Pointer;
  65.   MaxLineLen        : INTEGER;   (* Änderung 16.5.94 / jb *)
  66.  
  67. (* ====================================================== *)
  68. (*                Funktionen und Prozeduren               *)
  69. (* ====================================================== *)
  70.  
  71.   FUNCTION UpCase(ch: CHAR): CHAR;        (* Intl. CP 437 *)
  72.   BEGIN
  73.     CASE ch OF
  74.       'A'..'Z': ;
  75.       'a'..'z': Dec(ch, 32);
  76.       'ä'     : ch := 'Ä';
  77.       'ö'     : ch := 'Ö';
  78.       'ü'     : ch := 'Ü';
  79.       'ñ'     : ch := 'Ñ';
  80.       'é'     : ch := 'É';
  81.       'ó'     : ch := 'O';
  82.       'ú'     : ch := 'U';
  83.       'ç'     : ch := 'Ç';
  84.       'æ'     : ch := 'Æ';
  85.       'å'     : ch := 'Å';
  86.     END;
  87.     UpCase := ch;
  88.   END;
  89.  
  90.   PROCEDURE SetCursor(CONST CursorShape: WORD); ASSEMBLER;
  91.   (* Setzen des Cursors mit Int 10h *)
  92.   ASM
  93.     MOV  CX, CursorShape;
  94.     MOV  AH, 1
  95.     INT  10h
  96.   END;
  97.  
  98.   (* ==================================================== *)
  99.  
  100.   PROCEDURE HideCursor;
  101.   (* Abschalten des Cursors über zu hohen Startwert *)
  102.   BEGIN
  103.     SetCursor($1500);
  104.   END;
  105.  
  106.   (* ==================================================== *)
  107.  
  108.   PROCEDURE BlockCursor;
  109.   (* Setzen eines Cursors von Zeile 0 bis Zeile 15 *)
  110.   BEGIN
  111.     SetCursor($0015);
  112.   END;
  113.  
  114.   (* ==================================================== *)
  115.  
  116.   PROCEDURE NormCursor;
  117.   (* normaler Strichcursor wie beim Programmstart *)
  118.   BEGIN
  119.     SetCursor(StartCursor);
  120.   END;
  121.  
  122.   (* ==================================================== *)
  123.  
  124.   PROCEDURE MyExitProc; FAR;
  125.   (* Neue Exit-Procedur, die den Cursor wieder auf den    *)
  126.   (* Startwert zurücksetzt und die Bildschirmfarbe        *)
  127.   (* restauriert                                          *)
  128.   BEGIN
  129.     SetCursor(BIOSCursor);
  130.     TextAttr := DefaultColor;
  131.     ClrScr;
  132.     ExitProc := OldExitProc;
  133.   END;
  134.  
  135.   (* ==================================================== *)
  136.  
  137.   PROCEDURE ErrorBeep(CONST Wait : Word);
  138.   BEGIN                               (* geändert 13.5.94 *)
  139.     Sound(900);
  140.     Delay(50);
  141.     NoSound;
  142.     IF Wait > 0 THEN Delay(Wait);
  143.   END;
  144.  
  145.   (* ==================================================== *)
  146.  
  147.   FUNCTION ReadString(CONST DefaultStr : STRING; (*Vorgabe*)
  148.                       CONST valid      : tCharSet;(* erl. *)
  149.                       CONST EntryLength: BYTE;   (*maximal*)
  150.                       VAR   Return     : CHAR    (* Test  *)
  151.                                      ) : STRING;
  152.   VAR
  153.     ch             : CHAR;
  154.     Insert, Ready  : BOOLEAN;
  155.     CurPoint, x, y : WORD;
  156.     counter        : BYTE;
  157.     Entry          : STRING;
  158.     i              : INTEGER;
  159.     OrgCursor      : WORD;
  160.   BEGIN
  161.     OrgCursor := ActualCursor;                (* Lokal !! *)
  162.     x         := WhereX;
  163.     y         := WhereY;             (* Bugfix 16.5. / jb *)
  164.     GotoXY(x, y);                    (* Bugfix 16.5. / jb *)
  165.     FOR i := 1 TO EntryLength DO Write(#22);
  166.     GotoXY(x, y);
  167.     Entry     := DefaultStr;
  168.     IF Entry[0] > ^@ THEN BEGIN  (* Bugfix 11. 5. 94 / jb *)
  169.       Write(Entry);
  170.       CurPoint := Length(Entry); (* Bugfix 11. 5. 94 / jb *)
  171.     END ELSE
  172.       CurPoint := 0;
  173.     GotoXY(x + CurPoint, y);
  174.     Insert := TRUE;
  175.     Ready  := FALSE;             (* Bugfix 11. 5. 94 / jb *)
  176.  
  177.     REPEAT
  178.       IF Insert THEN NormCursor ELSE BlockCursor;
  179.       ch := UpCase(ReadKey);     (* Bugfix 11. 5. 94 / jb *)
  180.       IF ch IN valid THEN BEGIN(* variable Eingabezeichen *)
  181.                                (* 11.5.94 /jb             *)
  182.         IF Length(Entry) > Pred(EntryLength) THEN BEGIN
  183.           IF DoBeep THEN
  184.             ErrorBeep(0)                (* Bugfix 13.5.94 *)
  185.         END ELSE IF (Length(Entry) < EntryLength) OR
  186.            NOT Insert THEN BEGIN
  187.           IF CurPoint = Length(Entry) THEN BEGIN
  188.             Entry := Entry + ch;
  189.             GotoXY(x + CurPoint, y);
  190.             Inc(CurPoint);
  191.             Write(ch);
  192.           END ELSE BEGIN
  193.             IF Insert THEN BEGIN
  194.               Entry := Entry + Chr(32);
  195.               FOR counter := Pred(Length(Entry)) DOWNTO
  196.                                   Succ(CurPoint) DO
  197.                 Entry[Succ(counter)] := Entry[counter];
  198.             END;
  199.             Inc(CurPoint);
  200.             Entry[CurPoint] := ch;
  201.             GotoXY(x, y);
  202.             Write(Entry);
  203.             GotoXY(x + CurPoint, y);
  204.           END;
  205.         END;
  206.       END ELSE CASE ch OF
  207.       Chr(10), Chr(13):                         (* LF, CR *)
  208.         BEGIN
  209.           Return   := ch;
  210.           Ready    := TRUE;
  211.         END;
  212.       Chr(3), Chr(27):                         (* ^C, ESC *)
  213.         BEGIN
  214.           Return   := ch;
  215.           Entry    := '';
  216.           CurPoint := 0;
  217.           Ready    := TRUE;
  218.         END;
  219.       Chr(7):
  220.         BEGIN
  221.           IF CurPoint <> Length(Entry) THEN BEGIN
  222.             FOR counter := Succ(CurPoint)
  223.               TO Pred(Length(Entry)) DO
  224.               Entry[counter] := Entry[Succ(counter)];
  225.             Entry := Copy(Entry, 1, Pred(Length(Entry)));
  226.             GotoXY(x, y);
  227.             Write(Entry, Chr(22));
  228.             GotoXY(x + CurPoint, y);
  229.           END;
  230.         END;
  231.       Chr(8), Chr(127):                        (* BS, ^BS *)
  232.         BEGIN
  233.           IF CurPoint <> 0 THEN BEGIN
  234.             FOR counter := CurPoint TO Pred(Length(Entry))DO
  235.               Entry[counter] := Entry[Succ(counter)];
  236.             Entry := Copy(Entry, 1, Pred(Length(Entry)));
  237.             Dec(CurPoint);
  238.             GotoXY(x, y);
  239.             Write(Entry, Chr(22));
  240.             GotoXY(x + CurPoint, y);
  241.           END;
  242.         END;
  243.       Chr(0):                         (* erweiterte Taste *)
  244.         BEGIN
  245.           ch := ReadKey;
  246.           CASE ch OF
  247.           Chr(82):                                 (* Ins *)
  248.             BEGIN
  249.               Insert := NOT Insert;
  250.               IF Insert THEN NormCursor ELSE Blockcursor;
  251.             END;
  252.           Chr(71):                                (* Home *)
  253.             BEGIN
  254.               CurPoint := 0;
  255.               GotoXY(x, y);
  256.               Write(Entry);
  257.               GotoXY(x + CurPoint, y);
  258.             END;
  259.           Chr(79):                                 (* End *)
  260.             BEGIN
  261.               CurPoint := Length(Entry);
  262.               GotoXY(x, y);
  263.               Write(Entry);
  264.               GotoXY(x + CurPoint, y);
  265.             END;
  266.           Chr(83):                                 (* Del *)
  267.             BEGIN
  268.               IF CurPoint <> Length(Entry) THEN BEGIN
  269.                 FOR counter := Succ(CurPoint) TO
  270.                                Pred(Length(Entry)) DO
  271.                   Entry[counter] := Entry[counter + 1];
  272.                 Entry:=Copy(Entry, 1, Pred(Length(Entry)));
  273.                 GotoXY(x, y);
  274.                 Write(Entry, Chr(22));
  275.                 GotoXY(x + CurPoint, y);
  276.               END;
  277.             END;
  278.           Chr(75):                                  (* <- *)
  279.             BEGIN
  280.               IF CurPoint <> 0 THEN BEGIN
  281.                 Dec(CurPoint);
  282.                 GotoXY(x + CurPoint, y);
  283.               END;
  284.             END;
  285.           Chr(77):                                  (* -> *)
  286.             BEGIN
  287.               IF CurPoint <> Length(Entry) THEN BEGIN
  288.                 Inc(CurPoint);
  289.                 GotoXY(x + CurPoint, y);
  290.                 END;
  291.               END;
  292.             ELSE IF DoBeep THEN ErrorBeep(0);
  293.           END;
  294.         END ELSE IF DoBeep THEN ErrorBeep(0);
  295.       END;
  296.     UNTIL Ready;
  297.     ReadString := Entry;
  298.     SetCursor(OrgCursor);                     (* Lokal !! *)
  299. (*  HideCursor; *)
  300.   END;
  301.  
  302.   (* ==================================================== *)
  303.  
  304.   PROCEDURE OutTextXY(CONST Str            : STRING;
  305.                       CONST Attr           : BYTE;
  306.                       CONST Line, FirstPos : INTEGER);
  307.  
  308.     PROCEDURE ClearMonoLine;
  309.     VAR
  310.       x: INTEGER;
  311.     BEGIN
  312.       FOR x := 0 TO 79 DO BEGIN
  313.         (* direkt in den BS-Speicher, kein DPMI möglich!  *)
  314.         MonoScreen[Pred(Line), x].attr := Attr;
  315.         MonoScreen[Pred(Line), x].char := ' ';
  316.       END;
  317.     END;
  318.  
  319.     PROCEDURE ClearColorLine;
  320.     VAR
  321.       x: INTEGER;
  322.     BEGIN
  323.       FOR x := 0 TO 79 DO BEGIN
  324.         (* direkt in den BS-Speicher, kein DPMI möglich   *)
  325.         ColorScreen[Pred(Line), x].attr := Attr;
  326.         ColorScreen[Pred(Line), x].char := ' ';
  327.       END;
  328.     END;
  329.  
  330.   VAR
  331.     x: INTEGER;
  332.   BEGIN
  333.     IF Monochrom THEN BEGIN
  334.       ClearMonoLine;
  335.       (* Display Text *)
  336.       IF Length(Str) > 0 THEN
  337.         FOR x := 1 TO Length(Str) DO
  338.           IF x + FirstPos < 81 THEN
  339.             MonoScreen[Pred(Line),
  340.                        Pred(x) + FirstPos].char := Str[x];
  341.     END ELSE BEGIN
  342.       ClearColorLine;
  343.       (* Display Text *)
  344.       IF Length(Str) > 0 THEN
  345.         FOR x := 1 TO Length(Str) DO
  346.           IF x + FirstPos < 81 THEN      (* wg. Überlauf! *)
  347.            ColorScreen[Pred(Line),
  348.                        Pred(x) + FirstPos].char := Str[x];
  349.     END;
  350.   END;
  351.  
  352.   (* ==================================================== *)
  353.  
  354.   PROCEDURE DisplayFooter;
  355.   CONST
  356.     StatusLine  = '['#24']['#25'] [Bild'#24']'
  357.                 + '[Bild'#25'] [Pos1][Ende] '
  358.                 + '[S]uche [W]eiter e[X]it [D]rucken'
  359.                 + ' [F1]Hilfe';
  360.   BEGIN
  361.     OutTextXY(StatusLine, StatusColor, 25, 1);
  362.   END;
  363.  
  364.   (* ==================================================== *)
  365.  
  366.   PROCEDURE DisplayHeader(CONST s: STRING);
  367.   VAR
  368.     i  : INTEGER;
  369.     il : STRING;
  370.   BEGIN
  371.     il := StrPas(InfoLine); (* Änderung jb/11.5.94 --> *)
  372.     IF s <> '' THEN BEGIN   (* Infoline auch ein pChar *)
  373.       WHILE Length(il) < 79 DO il := ' ' + il + ' ';
  374.       il[0] := #80;
  375.       FOR i := 1 TO 10 DO il[68 + i] := s[i];
  376.       il[68] := '[';
  377.       il[75 + MaxLineLen] := ']'; (* Änderung 16.5.94 / jb *)
  378.       OutTextXY(il, StatusColor, 1, 1);
  379.     END ELSE
  380.         OutTextXY(il, StatusColor, 1, 40-Length(il) DIV 2);
  381.   END;
  382.  
  383.   (* ==================================================== *)
  384.  
  385.   PROCEDURE ScrollThruText(VAR Line : INTEGER);
  386.   VAR
  387.     i, y      : INTEGER;
  388.     OutStr    : STRING;
  389.     GoTop     : BOOLEAN;
  390.  
  391.   BEGIN
  392.     GoTop := FALSE;
  393.     REPEAT
  394.       IF GoTop THEN BEGIN
  395.         ClrScr;
  396.         FOR i := 1 TO ScreenLines DO
  397.           OutTextXY(StrPas(README_TEXT[i]), TextAttr,
  398.                    Succ(1), FirstPosition);
  399.         GotoXY(1, ScreenLines);
  400.         Line := 1;
  401.         Delay(330);
  402.       END ELSE BEGIN
  403.         Window(1 + FirstPosition, 2, 80, Succ(ScreenLines));
  404.         GotoXY(1, ScreenLines);
  405.       END;
  406.       IF Line < NumOfLines THEN y := Pred(Line)
  407.                            ELSE y := 1;
  408.       FOR i := y + Succ(ScreenLines) TO NumOfLines DO BEGIN
  409.         Str(i - Succ(ScreenLines), LCStr);
  410.         WHILE Length(LCStr) < MaxLineLen DO LCStr := ' ' + LCStr;
  411.         LCStr := 'Zeile ' + LCStr;
  412.         DisplayHeader(LCStr);
  413.         Line   := i - ScreenLines;
  414.         OutStr := StrPas(README_TEXT[Pred(i)]);
  415.         IF (Length(OutStr) + FirstPosition) > 80 THEN BEGIN
  416.           OutStr[0] := Chr(80);               (* cut it ! *)
  417.           Write(OutStr);
  418.         END ELSE WriteLn(OutStr);
  419.         OutTextXY(StrPas(README_TEXT[i]), TextAttr,
  420.                   Succ(ScreenLines), FirstPosition);
  421.         IF KeyPressed THEN
  422.           IF ReadKey = ' ' THEN BEGIN
  423.             Inc(Line);
  424.             Window(1, 1, 80, 25);
  425.             Exit;
  426.           END;
  427.         Delay(333);              (* 1/3tel Sekunde warten *)
  428.       END;
  429.       GoTop := TRUE;
  430.     UNTIL FALSE;
  431.   END;
  432.  
  433.   (* ==================================================== *)
  434.  
  435.   PROCEDURE Help;
  436.   VAR
  437.     ch  : CHAR;
  438.  
  439.     PROCEDURE WriteAt(CONST WhichLine : INTEGER;
  440.                       CONST MsgStr    : STRING);
  441.     BEGIN
  442.       OutTextXY(MsgStr, HelpColor, WhichLine,
  443.                                  40 - Length(MsgStr) DIV 2);
  444.     END;
  445.  
  446.   BEGIN
  447.     WriteAt( 2,
  448.              '┌──────────────────────────────────────────' +
  449.              '──────────────────────┐');
  450.     WriteAt( 3,
  451.              '│   H I L F E   Z U   D E N   T A S T E N '  +
  452.              'F U N K T I O N E N    │');
  453.     WriteAt( 4,
  454.              '├──────────────────────────────────────────' +
  455.              '──────────────────────┤');
  456.     WriteAt( 5,
  457.              '│                                          ' +
  458.              '                      │');
  459.     WriteAt( 6,
  460.              '│ ['#24' | '#25']                   Scroll'  +
  461.              'en nach oben und unten         │');
  462.     WriteAt( 7,
  463.              '│ [Pos1]                    Zum Textanfang ' +
  464.              'springen              │');
  465.     WriteAt( 8,
  466.              '│ [Ende]                    Zum Textende '   +
  467.              'springen                │');
  468.     WriteAt( 9,
  469.              '│ [Bild'#25']                   Eine Seite'  +
  470.              ' nach unten blättern       │');
  471.     WriteAt(10,
  472.              '│ [Bild'#24']                   Eine Seite'  +
  473.              ' nach oben blättern        │');
  474.     WriteAt(11,
  475.              '│                                         '  +
  476.              '                       │');
  477.     WriteAt(12,
  478.              '│ [ESC], [ALT]-[X], [F10]   Programm beend'  +
  479.              'en                     │');
  480.     WriteAt(13,
  481.              '│                                          ' +
  482.              '                      │');
  483.     WriteAt(14,
  484.              '│ [D]                       Text ausdrucken' +
  485.              '                      │');
  486.     WriteAt(15,
  487.              '│ [F2]                      Text in '        +
  488.              '(anzugebender) Datei sichern │');
  489.     WriteAt(16,
  490.              '│ [S] | [W]                 Text suchen / T' +
  491.              'ext nochmals suchen   │');
  492.     WriteAt(17,
  493.              '│ [L]                       Text automatisc' +
  494.              'h nach unten scrollen │');
  495.     WriteAt(18,
  496.              '│                                          ' +
  497.              '                      │');
  498.     WriteAt(19,
  499.              '│ [>]                       Farbattribut um' +
  500.              ' 1 erhöhen            │');
  501.     WriteAt(20,
  502.              '│ [<]                       Farbattribut um' +
  503.              ' 1 erniedrigen        │');
  504.     WriteAt(21,
  505.              '│ [T]                       Fehlerton '      +
  506.              '(falsche Taste) umschalten │');
  507.     WriteAt(22,
  508.              '│ [O]                       Dos aufruf'      +
  509.              'en (Zurück mit »Exit«      │');
  510.     WriteAt(23,
  511.              '│                                        '   +
  512.              '                        │');
  513.     WriteAt(24,
  514.              '└─────────────────────────────────────────'  +
  515.              '───────────────────────┘');
  516.     OutTextXY('Hilfebildschirm - zurück mit beliebiger '   +
  517.               'Taste ...', StatusColor, 25, 1);
  518.     ch := ReadKey;
  519.     IF ch = #0 THEN ch := ReadKey;
  520.     DisplayFooter;
  521.   END;
  522.  
  523.   (* ==================================================== *)
  524.  
  525.   PROCEDURE SaveToFile;
  526.   VAR
  527.    test     : CHAR;
  528.    i        : INTEGER;
  529.    FileName : STRING;
  530.    Attr     : BYTE;
  531.    t        : Text;
  532.   BEGIN
  533.     NormCursor;
  534.     OutTextXY('Dateiname(+Pfad)+'#17#196#196#217'):',
  535.               StatusColor, 25, 1);
  536.     GotoXY(26, 25);
  537.     Attr     := TextAttr;
  538.     TextAttr := StatusColor;
  539.     FileName := ParamStr(0);
  540.     Dec(FileName[0], 4);
  541.     FileName := FileName + '.TXT';
  542.     FileName := ReadString(FileName, FileChars, 54, test);
  543.                           (* max. 54 Zeichen! *)
  544.     TextAttr := Attr;
  545.     IF test = #27 THEN FileName := '';           (* ESC ! *)
  546.     IF FileName = '' THEN BEGIN
  547.       IF DoBeep THEN ErrorBeep(0);
  548.     END ELSE BEGIN
  549.       FOR i := 1 TO Length(FileName) DO
  550.         FileName[i] := UpCase(FileName[i]);
  551.       OutTextXY('Speichere Text in ' + FileName,
  552.                 StatusColor, 25, 1);
  553.       Delay(500);
  554.       Assign(t, FileName);
  555.       {$I-}
  556.       Rewrite(t);
  557.       IF IOResult <> 0 THEN BEGIN
  558.         OutTextXY('Fehler beim Speichern von »' +
  559.                   FileName + '«!', ErrorColor, 25, 1);
  560.         IF DoBeep THEN ErrorBeep(1000);
  561.       END ELSE BEGIN
  562.         (* Den Overhead in »ScreenLines« nicht sichern!   *)
  563.         FOR i := 1 TO NumOfLines - ScreenLines DO
  564.           WriteLn(t, README_TEXT[i]);
  565.         Close(t);
  566.       END;
  567.     END;
  568.     DisplayFooter;
  569.   END;
  570.  
  571.   (* ==================================================== *)
  572.  
  573.   PROCEDURE PrintText;
  574.   VAR            (* Erweiterung mit bel. Port 11.5.94/'jb *)
  575.     i        : INTEGER;
  576.     ch       : CHAR;
  577.     lst      : Text;
  578.     test     : CHAR;
  579.     Attr     : WORD;
  580.   BEGIN
  581.     OutTextXY('Druckerport: ', StatusColor, 25, 1);
  582.     GotoXY(15, 25);
  583.     Attr     := TextAttr;
  584.     TextAttr := StatusColor;
  585.     PortName := ReadString(PortName, PortChars, 4, test);
  586.     IF test = #13 THEN
  587.       IF PortName = '' THEN
  588.         PortName := 'PRN';
  589.     TextAttr := Attr;
  590.     IF test = #27 THEN PortName := '';
  591.     IF PortName = '' THEN BEGIN
  592.       DisplayFooter;
  593.       Exit;
  594.     END;
  595.     Assign(Lst, PortName);
  596.     {$I-}
  597.     Rewrite(Lst);
  598.     {$I+}
  599.     IF IoResult <> 0 THEN BEGIN
  600.       OutTextXY('Fehler bei Druck auf ' + PortName + '!',
  601.                 ErrorColor, 25, 1);
  602.       Delay(1000);
  603.       DisplayFooter;
  604.       Exit;
  605.     END;
  606.     OutTextXY('Datei wird auf '+ PortName + ' gedruckt,' +
  607.               'Abbruch mit <ESC> ' +
  608.               'sonst bitte warten ...', PrintColor, 25, 1);
  609.     Delay(1000);
  610.     FOR i := 1 TO NumOfLines - ScreenLines DO BEGIN
  611.       (* den Overhead in »Screenlines« nicht drucken! *)
  612.       IF KeyPressed THEN BEGIN
  613.         ch := ReadKey;
  614.         IF ch = #27 THEN BEGIN
  615.           OutTextXY('Ausdruck wird abgebrochen ...',
  616.                     ErrorColor, 25, 1);
  617.           IF DoBeep THEN ErrorBeep(500);
  618.           Close(Lst);
  619.           DisplayFooter;
  620.           Exit;
  621.         END;
  622.       END;
  623.       WriteLn(Lst, StrPas(README_TEXT[i]));
  624.     END;
  625.     Write(Lst, ^L);          (* Seitenvorschub zum Schluß *)
  626.     Close(Lst);
  627.     DisplayFooter;
  628.   END;
  629.  
  630.   (* ==================================================== *)
  631.  
  632.   PROCEDURE ChangeColor(CONST b : BOOLEAN);
  633.   VAR
  634.     ColStr : STRING[3];
  635.     x, y   : BYTE;
  636.   BEGIN
  637.     IF b THEN BEGIN  (* + *)
  638.       TextAttr := Succ(TextAttr);
  639.       IF ((TextAttr SHR 4) AND TextAttr = 1)
  640.                            OR (TextAttr = 0) THEN
  641.         TextAttr := Succ(TextAttr);
  642.     END ELSE BEGIN   (* - *)
  643.       TextAttr := Pred(TextAttr);
  644.       IF ((TextAttr SHR 4) AND TextAttr = 1) OR
  645.          (TextAttr = 0) THEN
  646.         TextAttr := Pred(TextAttr);
  647.     END;
  648.     Str(TextAttr: 3, ColStr);
  649.     IF Monochrom THEN BEGIN
  650.       MonoScreen[0, 68].char := ' ';
  651.       MonoScreen[0, 69].char := ' ';
  652.       MonoScreen[0, 70].char := ' ';
  653.       MonoScreen[0, 71].char := ' ';
  654.       MonoScreen[0, 72].char := ' ';
  655.       MonoScreen[0, 73].char := ' ';
  656.       MonoScreen[0, 74].char := ' ';
  657.       MonoScreen[0, 75].char := ' ';
  658.       MonoScreen[0, 76].char := ColStr[1];
  659.       MonoScreen[0, 77].char := ColStr[2];
  660.       MonoScreen[0, 78].char := ColStr[3];
  661.       MonoScreen[0, 79].char := ' ';
  662.       FOR y := 1 TO 23 DO
  663.         FOR x := 0 TO 79 DO
  664.           MonoScreen[y, x].attr := TextAttr;
  665.     END ELSE BEGIN
  666.       ColorScreen[0, 68].char := ' ';
  667.       ColorScreen[0, 69].char := ' ';
  668.       ColorScreen[0, 70].char := ' ';
  669.       ColorScreen[0, 71].char := ' ';
  670.       ColorScreen[0, 72].char := ' ';
  671.       ColorScreen[0, 73].char := ' ';
  672.       ColorScreen[0, 74].char := ' ';
  673.       ColorScreen[0, 75].char := ' ';
  674.       ColorScreen[0, 76].char := ColStr[1];
  675.       ColorScreen[0, 77].char := ColStr[2];
  676.       ColorScreen[0, 78].char := ColStr[3];
  677.       ColorScreen[0, 79].char := ' ';
  678.       FOR y := 1 TO 23 DO
  679.         FOR x := 0 TO 79 DO
  680.           ColorScreen[y, x].attr := TextAttr;
  681.     END;
  682.     Delay(100);
  683.   END;
  684.  
  685.   (* ==================================================== *)
  686.  
  687.   FUNCTION SearchForString(CONST Last : STRING;
  688.                            VAR   Line : INTEGER;
  689.                            CONST again: BOOLEAN): BYTE;
  690.   VAR
  691.     ExitChar     : CHAR;
  692.     Attr         : BYTE;
  693.     i            : INTEGER;
  694.     TextStr,
  695.     SearchStr    : pChar;
  696.     SearchString : STRING;
  697.  
  698.     FUNCTION StrUpper(CONST s: pChar; VAR t: pChar): pChar;
  699.     (* ... wegen Schlamperei von Borland in der Laufzeit- *)
  700.     (* bibliothek: Die Funktion wandelt den Referenzpara- *)
  701.     (* meter statt des Funktionsergebnisses!!!            *)
  702.     BEGIN
  703.       StrCopy(t, s);
  704.       StrCopy(t, Strings.StrUpper(t));
  705.       StrUpper := t;
  706.     END;
  707.  
  708.   BEGIN
  709.     Attr     := TextAttr;
  710.     TextAttr := StatusColor;
  711.     OutTextXY('Text suchen: ', TextAttr, 25, 1);
  712.     GotoXY(15, 25);
  713.     IF NOT again THEN BEGIN
  714.       SearchString := ReadString(Last,
  715.                                  SearchChars, 65,
  716.                                  ExitChar);
  717.       LastSearch   := SearchString;
  718.     END ELSE SearchString := LastSearch;
  719.     TextAttr := Attr;
  720.     IF ExitChar = #27 THEN BEGIN
  721.       SearchForString := 2;
  722.       Exit;
  723.     END;
  724.     IF Length(SearchString) > 0 THEN BEGIN
  725.       GetMem(SearchStr, $100);
  726.       GetMem(TextStr,   $100);
  727.       StrPCopy(SearchStr, SearchString);
  728.       StrUpper(SearchStr, SearchStr);
  729.       IF Line >= NumOfLines - Pred(ScreenLines) THEN
  730.         Line := 1;
  731.       FOR i := Succ(Line) TO NumOfLines DO
  732.         IF StrLen(README_TEXT[i]) > 0 THEN BEGIN
  733.     (*nicht die aktuelle erste sondern nächste Zeile am BS*)
  734.         StrUpper(README_TEXT[i], TextStr);
  735.         IF StrPos(TextStr, SearchStr) <> NIL THEN BEGIN
  736.           Line            := i;
  737.           SearchForString := 1;
  738.           FreeMem(SearchStr, $100);
  739.           FreeMem(TextStr,   $100);
  740.           Exit;
  741.         END;
  742.       END;
  743.       Line := NumOfLines;
  744.     END ELSE BEGIN
  745.       SearchForString := 2;
  746.       Exit;
  747.     END;
  748.     Line := NumOfLines - ScreenLines;
  749.     SearchForString := 0;
  750.   END;
  751.  
  752.   (* ==================================================== *)
  753.  
  754.   FUNCTION DosShell(CONST Line : INTEGER) : INTEGER;
  755.   VAR
  756.     Attr : BYTE;
  757.     i, y : INTEGER;
  758.     name : STRING;
  759.   BEGIN
  760.     Attr     := TextAttr;
  761.     TextAttr := DosBoxColor;
  762.     name     := ParamStr(0);            (* Programmname   *)
  763.     IF Pos('\', name) > 0 THEN          (* Pfad abtrennen *)
  764.       WHILE Pos('\', name) > 0 DO Delete(name, 1, 1);
  765.     ClrScr;
  766.     Dec(Name[0], 4);                  (* Endung abtrennen *)
  767.     WriteLn(^J'Zurück zu ' + name + ' mit Exit'
  768.             + #17#196#196#217#10);
  769.     BlockCursor;
  770.     SwapVectors;
  771.     Exec(GetEnv('COMSPEC'), '');
  772.     DosShell := DosError;
  773.     SwapVectors;
  774.     HideCursor;
  775.     TextAttr := Attr;
  776.     y        := 1;
  777.     FOR i := Line TO Line + Pred(ScreenLines) DO BEGIN
  778.       Inc(y);
  779.       OutTextXY(StrPas(README_TEXT[i]), TextAttr, y,
  780.                 FirstPosition);
  781.     END;
  782.     DisplayHeader('');
  783.   END;
  784.  
  785. (* ====================================================== *)
  786.  
  787. VAR
  788.   Key, ch                    : CHAR;
  789.   LineCounter, y, OutPutLine : INTEGER;
  790.   Found                      : BYTE;
  791.   LineScroll, Done           : BOOLEAN;
  792.  
  793. BEGIN
  794.   IF IOResult <> 0 THEN ;
  795.  
  796.   IF NumOfLines < 100 THEN       (* Änderung 16.5.94 / jb *)
  797.     MaxLineLen := 2
  798.   ELSE IF NumOfLines < 1000 THEN
  799.     MaxLineLen := 3
  800.   ELSE IF NumOfLines < 10000 THEN
  801.     MaxLineLen := 4
  802.   ELSE
  803.     MaxLineLen := 5;
  804.  
  805.   BIOSCursor   := ActualCursor;          (* global !      *)
  806.   Monochrom    := Byte(Ptr(Seg0040, $0049)^) = 7; (* HGC  *)
  807.   CheckBreak   := FALSE;                 (* kein Abbruch  *)
  808.   DirectVideo  := TRUE;                  (* schneller     *)
  809.   DoBeep       := TRUE; (* Falls Ton unerwünscht := FALSE *)
  810.   DefaultColor := TextAttr;              (* Farben merken *)
  811.   OldExitProc  := ExitProc;
  812.   ExitProc     := @MyExitProc;
  813.   HideCursor;
  814.   ClrScr;
  815.  
  816.   IF Monochrom OR (Byte(Ptr(Seg0040, $49)^) = 2) THEN BEGIN
  817.     StatusColor := $70;          (* invertiert            *)
  818.     ErrorColor  := $1F;          (* weiß auf grau         *)
  819.     PrintColor  := $10;          (* invertiert            *)
  820.     SearchColor := $F0;          (* invertiert + blinkend *)
  821.     HelpColor   := $0F;          (* hell                  *)
  822.     NormColor   := $07;          (* normal                *)
  823.   END;                           (* $01 = unterstrichen   *)
  824.  
  825.   DosBoxColor   := TextAttr;
  826.   DisplayHeader('');
  827.   DisplayFooter;
  828.   TextAttr := NormColor;
  829.   FOR y := 1 TO ScreenLines DO
  830.     OutTextXY(StrPas(README_TEXT[y]), TextAttr, Succ(y),
  831.               FirstPosition);
  832.   LineCounter := 1;
  833.   LastSearch  := '';
  834.  
  835.   REPEAT
  836.     Str(LineCounter, LCStr);
  837.     WHILE Length(LCStr) < MaxLineLen DO LCStr := ' ' + LCStr;
  838.     LCStr := 'Zeile ' + LCStr;
  839.     DisplayHeader(LCStr);
  840.     LineScroll := FALSE;
  841.     Key        := ReadKey;
  842.     CASE UpCase(Key) OF
  843.       'T' : DoBeep := NOT DoBeep;           (* Umschalter *)
  844.       'O' : BEGIN
  845.               IF DosShell(LineCounter) <> 0 THEN BEGIN
  846.                 OutTextXY('Shell konnte nicht ausgeführt' +
  847.                           ' werden!', ErrorColor, 25, 1);
  848.                 IF DoBeep THEN ErrorBeep(1500);
  849.               END;
  850.               DisplayFooter;
  851.             END;
  852.       'W' : BEGIN  (* immer weiter suchen ... *)
  853.               IF LastSearch = '' THEN
  854.                 Found := SearchForString('', LineCounter, FALSE)
  855.               ELSE
  856.                 Found := SearchForString(LastSearch, LineCounter,
  857.                                          TRUE);
  858.               ActualColor := TextAttr;
  859.               OutPutLine  := 1;
  860.               FOR y := LineCounter TO
  861.                 LineCounter + Pred(ScreenLines) DO BEGIN
  862.                 Inc(OutPutLine);
  863.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  864.                           OutPutLine, FirstPosition);
  865.               END;
  866.               OutPutLine := 1;
  867.               IF Found = 1 THEN BEGIN
  868.                 OutTextXY('Textstelle gefunden!',
  869.                           StatusColor, 25, 1);
  870.                 IF Monochrom THEN
  871.                   FOR y := 0 TO 79 DO
  872.                     MonoScreen[1, y].attr := SearchColor
  873.                 ELSE
  874.                   FOR y := 0 TO 79 DO
  875.                     ColorScreen[1, y].attr := SearchColor;
  876.                 Delay(1000);
  877.               END ELSE IF Found = 0 THEN BEGIN
  878.                 OutTextXY('Textstelle nicht gefunden!',
  879.                           ErrorColor, 25, 1);
  880.                 IF DoBeep THEN ErrorBeep(1000);
  881.               END ELSE BEGIN
  882.                 OutTextXY('Suche wurde abgebrochen',
  883.                           ErrorColor, 25, 1);
  884.                 IF DoBeep THEN ErrorBeep(1000);
  885.               END;
  886.               TextAttr := ActualColor;
  887.               IF Monochrom THEN
  888.                 FOR y := 0 TO 79 DO
  889.                   MonoScreen[1, y].attr := ActualColor
  890.               ELSE
  891.                 FOR y := 0 TO 79 DO
  892.                   ColorScreen[1, y].attr := ActualColor;
  893.               DisplayFooter;
  894.             END;
  895.       'S' : BEGIN  (* Immer neuen String suchen ... *)
  896.               Found := SearchForString(LastSearch, LineCounter, FALSE);
  897.               ActualColor := TextAttr;
  898.               OutPutLine  := 1;
  899.               FOR y := LineCounter TO
  900.                 LineCounter + Pred(ScreenLines) DO BEGIN
  901.                 Inc(OutPutLine);
  902.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  903.                           OutPutLine, FirstPosition);
  904.               END;
  905.               OutPutLine := 1;
  906.               IF Found = 1 THEN BEGIN
  907.                 OutTextXY('Textstelle gefunden!',
  908.                           StatusColor, 25, 1);
  909.                 IF Monochrom THEN
  910.                   FOR y := 0 TO 79 DO
  911.                     MonoScreen[1, y].attr := SearchColor
  912.                 ELSE
  913.                   FOR y := 0 TO 79 DO
  914.                     ColorScreen[1, y].attr := SearchColor;
  915.                 Delay(1000);
  916.               END ELSE IF Found = 0 THEN BEGIN
  917.                 OutTextXY('Textstelle nicht gefunden!',
  918.                           ErrorColor, 25, 1);
  919.                 IF DoBeep THEN ErrorBeep(1000);
  920.               END ELSE BEGIN
  921.                 OutTextXY('Suche wurde abgebrochen',
  922.                           ErrorColor, 25, 1);
  923.                 IF DoBeep THEN ErrorBeep(1000);
  924.               END;
  925.               TextAttr := ActualColor;
  926.               IF Monochrom THEN
  927.                 FOR y := 0 TO 79 DO
  928.                   MonoScreen[1, y].attr := ActualColor
  929.               ELSE
  930.                 FOR y := 0 TO 79 DO
  931.                   ColorScreen[1, y].attr := ActualColor;
  932.               DisplayFooter;
  933.             END;
  934.        'D': PrintText;
  935.        'L': BEGIN
  936.               ActualColor := TextAttr;
  937.               OutTextXY('Text wird endlos ge' +
  938.                         'scrollt, Ende mit [Leertaste] ...',
  939.                         StatusColor, 25, 1);
  940.               ScrollThruText(LineCounter);
  941.               TextAttr   := ActualColor;
  942.               DisplayFooter;
  943.               LineScroll := TRUE;
  944.               OutPutLine := 1;
  945.               FOR y := LineCounter TO
  946.                 LineCounter + Pred(ScreenLines) DO BEGIN
  947.                 Inc(OutPutLine);
  948.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  949.                           OutPutLine, FirstPosition);
  950.               END;
  951.             END;
  952.        '>': ChangeColor(Incr);
  953.        '<': ChangeColor(Decr);
  954.        'Q', 'X': Key := #27;                      (* Ende *)
  955.        #27: ;                   (* einfachste Möglichkeit *)
  956.                                 (* um Beep auszuschließen *)
  957.       ELSE IF Key <> #0 THEN IF DoBeep THEN ErrorBeep(0);
  958.     END;
  959.  
  960.     IF Key = #0 THEN BEGIN
  961.       Done := TRUE;
  962.       IF NOT LineScroll THEN ch := ReadKey;
  963.       CASE ch OF
  964.         ';': Help;                                  (* F1 *)
  965.         '<': SaveToFile;                            (* F2 *)
  966.  {      'M': BEGIN                                  (* -> *)
  967.                Inc(FirstPosition);
  968.              END;
  969.         'K': BEGIN                                  (* <- *)
  970.                Dec(FirstPosition);
  971.              END;}
  972.    '-', 'D': Key := #27;                          (* Ende *)
  973.         'H': IF LineCounter > 1 THEN Dec(LineCounter)
  974.                                 ELSE Done := FALSE;
  975.         'P': IF LineCounter<NumOfLines-Pred(ScreenLines)THEN
  976.                Inc(LineCounter)
  977.              ELSE
  978.                Done := FALSE;
  979.         'G': IF LineCounter > 1 THEN LineCounter := 1
  980.                                 ELSE Done        := FALSE;
  981.         'O': IF LineCounter <
  982.                 NumOfLines - Pred(ScreenLines) THEN
  983.                LineCounter := NumOfLines - Pred(ScreenLines)
  984.              ELSE
  985.                Done := FALSE;
  986.         'Q': IF LineCounter < (NumOfLines -
  987.                 Pred(ScreenLines) SHL 1) THEN
  988.                Inc(LineCounter, ScreenLines)
  989.              ELSE IF LineCounter = (NumOfLines -
  990.                      Pred(ScreenLines) SHL 1) THEN
  991.                Done := FALSE
  992.              ELSE
  993.                LineCounter := NumOfLines - Pred(ScreenLines);
  994.         'I': IF LineCounter > (ScreenLines SHL 1) THEN
  995.                Dec(LineCounter, ScreenLines)
  996.              ELSE IF LineCounter = 1 THEN
  997.                Done := FALSE
  998.              ELSE
  999.                LineCounter := 1;
  1000.         ELSE IF DoBeep THEN ErrorBeep(0); Done := FALSE;
  1001.       END;
  1002.       IF Done THEN BEGIN
  1003.         OutPutLine := 1;
  1004.         FOR y := LineCounter TO
  1005.                  LineCounter + Pred(ScreenLines) DO BEGIN
  1006.           Inc(OutPutLine);
  1007.           OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  1008.                     OutPutLine, FirstPosition);
  1009.         END;
  1010.       END;
  1011.     END;
  1012.   UNTIL Key = #27;
  1013.   (* Restaurierungen werden in der Exitprozedur vorge-    *)
  1014.   (* nommen!                                              *)
  1015. END.
  1016.  
  1017. (* ====================================================== *)
  1018. (*                 Ende von README.PAS                    *)
  1019.