home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / readme / readme.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-31  |  24.4 KB  |  736 lines
  1. (* ====================================================== *)
  2. (*                    README.PAS v2.31                    *)
  3. (*      Copyright (C) 1993, 1994 J. Braun & toolbox       *)
  4. (*      Compiler: Turbo Pascal/Borland Pascal 7.0         *)
  5. (* ------------------------------------------------------ *)
  6. (*  Funktion: Lesen von Texten, die via »READTEXT.TPU«    *)
  7. (*  eingelinkt werden. READTEXT.PAS wird mit »MAKERD.PAS« *)
  8. (*  erzeugt und enthält den Inhalt einer max. 63 KBytes   *)
  9. (*  großen Textdatei als Pascal-Unit.                     *)
  10. (*  README.PAS darf nur im REAL-MODE compiliert werden,   *)
  11. (*  da direkte Speicherzugriffe verwendet werden.         *)
  12. (* ====================================================== *)
  13. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+,P-,Q-,T-,Y-}
  14. {$M $3FF1,0,$FFFF}
  15. {$IFNDEF VER70}  Fehler: Falsche Compiler-Version   {$ENDIF}
  16. {$IFDEF Windows} Fehler: Falsches Target!           {$ENDIF}
  17. {$IFDEF DPMI}    Fehler: Falsches Target!           {$ENDIF}
  18.  
  19. PROGRAM ReadMe;
  20.  
  21. USES
  22.   Crt, Dos, Strings, Printer, Cursor, ReadUnit, ReadText;
  23.  
  24. (* Den Quellcode der Units »ReadUnit« und »Cursor« finden *)
  25. (* Sie in: Borland GmbH (Hrsg.): Borland Pascal 7.0 - Das *)
  26. (* Buch; te-wi Verlag, 1993, ISBN 3-89362-288-8, DM 89,-- *)
  27. (* verwendet mit freundl. Genehmigung des te-wi Verlags   *)
  28.  
  29. {$I lines.inc}
  30.  
  31. TYPE
  32.   tTextScreen = ARRAY[0..24, 0..79] OF RECORD
  33.                   char: CHAR;
  34.                   attr: BYTE;
  35.                 END;
  36.  
  37. CONST
  38.   scrollwait  : WORD =  333;   (* Wartezeit beim Scrollen *)
  39.   FirstPosition =  0; (* Anzahl der Spaces links vom Text *)
  40.                       (* --> in diesem Fall keine !       *)
  41.   StatusColor : BYTE    = $70; (* schwarz auf weiß        *)
  42.   ErrorColor  : BYTE    = $74; (* rot auf weiß            *)
  43.   PrintColor  : BYTE    = $47; (* weiß auf rot            *)
  44.   SearchColor : BYTE    = $9F; (* weiß auf blau blinkend  *)
  45.   HelpColor   : BYTE    = $30; (* schwarz auf Cyan        *)
  46.   DosBoxColor : BYTE    = $1F; (* weiß auf blau           *)
  47.   NormColor   : BYTE    = $1E; (* gelb auf blau           *)
  48.  
  49.   MyCopyright : pChar   = 'Erzeugt mit dem Readme-Builder '
  50.                         + 'der toolbox, (C) 1993 - 94 J. '
  51.                         + 'Braun & toolbox'#0;
  52.   StatusLine  : pChar   =
  53.                 '['#24']['#25'] [Bild'#24']'
  54.               + '[Bild'#25'] [Pos1][Ende] '
  55.               + '[S]uche [W]eiter e[X]it [D]rucken'
  56.               + ' [F1]Hilfe';
  57.  
  58.   Incr = TRUE;
  59.   Decr = FALSE;
  60.  
  61. VAR
  62.   (* Es wird auf Performance-Gründen gnadenlos in den     *)
  63.   (* Bildschirmspeicher geschrieben (Untersch. HGC/Color) *)
  64.   MonoScreen        : tTextScreen ABSOLUTE $B000:$0000;
  65.   ColorScreen       : tTextScreen ABSOLUTE $B800:$0000;
  66.  
  67.   ActualColor       : BYTE;
  68.   DoBeep, Monochrom : BOOLEAN;
  69.   LastSearch, LCStr : STRING;
  70.  
  71. (* ------------------------------------------------------ *)
  72.  
  73. PROCEDURE Beep(CONST Wait : Word);
  74. BEGIN
  75.   IF DoBeep THEN BEGIN
  76.     Sound(900);
  77.     Delay(50);
  78.     NoSound;
  79.   END;
  80.   IF Wait > 0 THEN Delay(Wait);
  81. END;
  82.  
  83. (* ------------------------------------------------------ *)
  84.  
  85. PROCEDURE OutTextXY(CONST s              : STRING;
  86.                     CONST Attr           : BYTE;
  87.                     CONST Line, FirstPos : INTEGER);
  88.  
  89.   PROCEDURE ClearMonoLine;
  90.   VAR
  91.     x : INTEGER;
  92.   BEGIN
  93.     FOR x := 0 TO 79 DO BEGIN
  94.       (* direkt in den BS-Speicher, kein DPMI möglich!    *)
  95.       MonoScreen[Line - 1, x].Attr := Attr;
  96.       MonoScreen[Line - 1, x].char := ' ';
  97.     END;
  98.   END;
  99.  
  100.   PROCEDURE ClearColorLine;
  101.   VAR
  102.     x : INTEGER;
  103.   BEGIN
  104.     FOR x := 0 TO 79 DO BEGIN
  105.       (* direkt in den BS-Speicher, kein DPMI möglich     *)
  106.       ColorScreen[Line - 1, x].Attr := Attr;
  107.       ColorScreen[Line - 1, x].char := ' ';
  108.     END;
  109.   END;
  110.  
  111. VAR
  112.   x: INTEGER;
  113. BEGIN
  114.   IF Monochrom THEN BEGIN
  115.     ClearMonoLine;
  116.     (* Display Text *)
  117.     IF Length(s) > 0 THEN
  118.       FOR x := 1 TO Length(s) DO
  119.         IF x + FirstPos < 81 THEN
  120.           MonoScreen[Line-1, x-1 + FirstPos].char := s[x];
  121.   END ELSE BEGIN
  122.     ClearColorLine;
  123.     (* Display Text *)
  124.     IF Length(s) > 0 THEN
  125.       FOR x := 1 TO Length(s) DO
  126.         IF x + FirstPos < 81 THEN        (* wg. Überlauf! *)
  127.           ColorScreen[Line-1, x-1 + FirstPos].char := s[x];
  128.   END;
  129. END;
  130.  
  131. (* ------------------------------------------------------ *)
  132.  
  133. PROCEDURE DisplayFooter;
  134. BEGIN
  135.   OutTextXY(StrPas(StatusLine), StatusColor, 25, 1);
  136. END;
  137.  
  138. (* ------------------------------------------------------ *)
  139.  
  140. PROCEDURE DisplayHeader(CONST s: STRING);
  141. VAR
  142.   i : INTEGER;
  143. BEGIN
  144.   IF s <> '' THEN BEGIN
  145.     WHILE Length(InfoLine) < 79 DO
  146.       InfoLine := ' ' + InfoLine + ' ';
  147.     InfoLine[0] := #80;
  148.     FOR i := 1 TO 10 DO InfoLine[68 + i] := s[i];
  149.     Infoline[68] := '[';
  150.     InfoLine[79] := ']';
  151.     OutTextXY(InfoLine, StatusColor, 1, 1);
  152.   END ELSE
  153.       OutTextXY(InfoLine, StatusColor, 1,
  154.                 40 - Length(InfoLine) DIV 2);
  155. END;
  156.  
  157. (* ------------------------------------------------------ *)
  158.  
  159. PROCEDURE ScrollThruText(VAR Line : INTEGER);
  160. VAR
  161.   i, y    : INTEGER;
  162.   OutStr  : STRING;
  163.   GoTop   : BOOLEAN;
  164. BEGIN
  165.   GoTop := FALSE;
  166.   REPEAT
  167.     IF GoTop THEN BEGIN               (* Erweiterung v2.3 *)
  168.       ClrScr;
  169.       FOR i := 1 TO ScreenLines DO
  170.         OutTextXY(StrPas(README_TEXT[i]), TextAttr,
  171.                   i + 1, FirstPosition);
  172.       GotoXY(1, ScreenLines);
  173.       Line := 1;
  174.       Delay(scrollwait * 2);
  175.     END ELSE BEGIN
  176.       Window(1 + FirstPosition, 2, 80, Succ(ScreenLines));
  177.       GotoXY(1, ScreenLines);
  178.     END;
  179.     IF Line < NumOfLines THEN y := Pred(Line)
  180.                          ELSE y := 1;
  181.     FOR i := y + Succ(ScreenLines) TO NumOfLines DO BEGIN
  182.       Str(i - ScreenLines + 1, LCStr);
  183.       WHILE Length(LCStr) < 4 DO LCStr := ' ' + LCStr;
  184.       LCStr := 'Zeile ' + LCStr;
  185.       DisplayHeader(LCStr);
  186.       Line   := i - ScreenLines;
  187.       OutStr := StrPas(README_TEXT[i - 1]);
  188.       IF OutStr[0] >= Chr(80 - FirstPosition) THEN BEGIN
  189.                               (* BUGFIX v2.31, 30.3.94/jb *)
  190.                                      (* Längenangleichung *)
  191.         OutStr[0] := Chr(80 - FirstPosition);  (* cut it! *)
  192.         Write(OutStr);
  193.       END ELSE
  194.         WriteLn(OutStr); (* kürzer als (80-FirstPosition) *)
  195.  
  196.       OutTextXY(StrPas(README_TEXT[i]), TextAttr,
  197.                 Succ(ScreenLines), FirstPosition);
  198.       IF KeyPressed THEN
  199.         IF ReadKey = ' ' THEN BEGIN
  200.           Inc(Line);
  201.           Window(1, 1, 80, 25);
  202.           Exit;
  203.         END;
  204.       Delay(scrollwait);                        (* warten *)
  205.     END;
  206.     GoTop := TRUE;
  207.   UNTIL FALSE;
  208. END;
  209.  
  210. (* ------------------------------------------------------ *)
  211.  
  212. PROCEDURE Help;
  213. VAR
  214.   ch  : CHAR;
  215.  
  216.   PROCEDURE WriteAt(CONST WhichLine : INTEGER;
  217.                     CONST MsgStr    : STRING);
  218.   BEGIN
  219.     OutTextXY(MsgStr, HelpColor, WhichLine,
  220.                                  40 - Length(MsgStr) DIV 2);
  221.   END;
  222.  
  223. BEGIN
  224.   WriteAt( 2, '┌──────────────────────────────────────────'+
  225.               '──────────────────────┐');
  226.   WriteAt( 3, '│   H I L F E   Z U   D E N   T A S T E N ' +
  227.               'F U N K T I O N E N    │');
  228.   WriteAt( 4, '├──────────────────────────────────────────'+
  229.               '──────────────────────┤');
  230.   WriteAt( 5, '│                                          '+
  231.               '                      │');
  232.   WriteAt( 6, '│ ['#24' | '#25']                   Scroll' +
  233.               'en nach oben und unten         │');
  234.   WriteAt( 7, '│ [Pos1]                    Zum Textanfang '+
  235.               'springen              │');
  236.   WriteAt( 8, '│ [Ende]                    Zum Textende '  +
  237.               'springen                │');
  238.   WriteAt( 9, '│ [Bild'#25']                   Eine Seite' +
  239.               ' nach unten blättern       │');
  240.   WriteAt(10, '│ [Bild'#24']                   Eine Seite' +
  241.               ' nach oben blättern        │');
  242.   WriteAt(11, '│                                         ' +
  243.               '                       │');
  244.   WriteAt(12, '│ [ESC], [ALT]-[X], [F10]   Programm beend' +
  245.               'en                     │');
  246.   WriteAt(13, '│                                          '+
  247.               '                      │');
  248.   WriteAt(14, '│ [D]                       Text ausdrucken'+
  249.               '                      │');
  250.   WriteAt(15, '│ [F2]                      Text in '       +
  251.               '(anzugebender) Datei sichern │');
  252.   WriteAt(16, '│ [S] | [W]                 Text suchen / T'+
  253.               'ext nochmals suchen   │');
  254.   WriteAt(17, '│ [L]                       Text automatisc'+
  255.               'h nach unten scrollen │');
  256.   WriteAt(18, '│                                          '+
  257.               '                      │');
  258.   WriteAt(19, '│ [>]                       Farbattribut um'+
  259.               ' 1 erhöhen            │');
  260.   WriteAt(20, '│ [<]                       Farbattribut um'+
  261.               ' 1 erniedrigen        │');
  262.   WriteAt(21, '│ [T]                       Fehlerton '     +
  263.               '(falsche Taste) umschalten │');
  264.   WriteAt(22, '│ [O]                       Dos aufruf'     +
  265.               'en (Zurück mit »Exit«      │');
  266.   WriteAt(23, '│                                        '  +
  267.               '                        │');
  268.   WriteAt(24, '└─────────────────────────────────────────' +
  269.               '───────────────────────┘');
  270.   OutTextXY('Hilfebildschirm - zurück mit beliebiger ' +
  271.             'Taste ...', StatusColor, 25, 1);
  272.   ch := ReadKey;
  273.   IF ch = #0 THEN ch := ReadKey;
  274.   DisplayFooter;
  275. END;
  276.  
  277. (* ------------------------------------------------------ *)
  278.  
  279. PROCEDURE SaveToFile;
  280. VAR
  281.  test, i  : INTEGER;
  282.  FileName : STRING;
  283.  Attr     : BYTE;
  284.  t        : Text;
  285. BEGIN
  286.   SetCursor(StartCursor);
  287.   OutTextXY('Dateiname(+Pfad)+'#17#196#196#217'):',
  288.             StatusColor, 25, 1);
  289.   GotoXY(26, 25);
  290.   Attr     := TextAttr;
  291.   TextAttr := StatusColor;
  292.   FOR i := 1 TO 54 DO Write(#22);
  293.   GotoXY(26, 25);
  294.   FileName := ReadString(54, test);   (* max. 54 Zeichen! *)
  295.   TextAttr := Attr;
  296.   IF test = 27 THEN              (* Es wurde ESC gedrückt *)
  297.     FileName := '';
  298.   HideCursor;
  299.   IF FileName = '' THEN BEGIN
  300.     IF DoBeep THEN Beep(0);
  301.   END ELSE BEGIN
  302.     FOR i := 1 TO Length(FileName) DO
  303.       FileName[i] := UpCase(FileName[i]);
  304.     OutTextXY('Speichere Text in ' + FileName,
  305.               StatusColor, 25, 1);
  306.     Delay(scrollwait * 2);
  307.     Assign(t, FileName);
  308.     {$I-}
  309.     Rewrite(t);
  310.     IF IOResult <> 0 THEN BEGIN
  311.       OutTextXY('Fehler beim Speichern von »' +
  312.                 FileName + '«!', ErrorColor, 25, 1);
  313.       Beep(1000);
  314.     END ELSE BEGIN
  315.       (* Den Overhead in »ScreenLines« nicht sichern!     *)
  316.       FOR i := 1 TO NumOfLines - ScreenLines DO
  317.         WriteLn(t, README_TEXT[i]);
  318.       Close(t);
  319.     END;
  320.   END;
  321.   DisplayFooter;
  322. END;
  323.  
  324. (* ------------------------------------------------------ *)
  325.  
  326. PROCEDURE PrintText;
  327. VAR
  328.   i  : INTEGER;
  329.   ch : CHAR;
  330. BEGIN
  331.   OutTextXY('Datei wird ausgedruckt, Abbruch mit <ESC> ' +
  332.             'sonst bitte warten ...', PrintColor, 25, 1);
  333.   Delay(scrollwait * 3);
  334.   FOR i := 1 TO NumOfLines - ScreenLines DO BEGIN
  335.     (* den Overhead in »Screenlines« nicht drucken! *)
  336.     IF KeyPressed THEN BEGIN
  337.       ch := ReadKey;
  338.       IF ch = #27 THEN BEGIN
  339.         OutTextXY('Ausdruck wird abgebrochen ...',
  340.                   ErrorColor, 25, 1);
  341.         Beep(500);
  342.         DisplayFooter;
  343.         Exit;
  344.       END;
  345.     END;
  346.     WriteLn(Lst, StrPas(README_TEXT[i]));
  347.   END;
  348.   Write(Lst, ^L);            (* Seitenvorschub zum Schluß *)
  349.   DisplayFooter;
  350. END;
  351.  
  352. (* ------------------------------------------------------ *)
  353.  
  354. PROCEDURE ChangeColor(CONST b : BOOLEAN);
  355. VAR
  356.   ColStr : STRING[3];
  357.   x, y   : BYTE;
  358. BEGIN
  359.   IF b THEN BEGIN  (* + *)
  360.     TextAttr := Succ(TextAttr);
  361.     IF ((TextAttr SHR 4) AND TextAttr = 1) OR
  362.        (TextAttr = 0) THEN
  363.       TextAttr := Succ(TextAttr);
  364.   END ELSE BEGIN   (* - *)
  365.     TextAttr := Pred(TextAttr);
  366.     IF ((TextAttr SHR 4) AND TextAttr = 1) OR
  367.        (TextAttr = 0) THEN
  368.       TextAttr := Pred(TextAttr);
  369.   END;
  370.   Str(TextAttr: 3, ColStr);
  371.   IF Monochrom THEN BEGIN
  372.     MonoScreen[0, 68].char := ' ';
  373.     MonoScreen[0, 69].char := ' ';
  374.     MonoScreen[0, 70].char := ' ';
  375.     MonoScreen[0, 71].char := ' ';
  376.     MonoScreen[0, 72].char := ' ';
  377.     MonoScreen[0, 73].char := ' ';
  378.     MonoScreen[0, 74].char := ' ';
  379.     MonoScreen[0, 75].char := ' ';
  380.     MonoScreen[0, 76].char := ColStr[1];
  381.     MonoScreen[0, 77].char := ColStr[2];
  382.     MonoScreen[0, 78].char := ColStr[3];
  383.     MonoScreen[0, 79].char := ' ';
  384.     FOR y := 1 TO 23 DO
  385.       FOR x := 0 TO 79 DO
  386.         MonoScreen[y, x].attr := TextAttr;
  387.   END ELSE BEGIN
  388.     ColorScreen[0, 68].char := ' ';
  389.     ColorScreen[0, 69].char := ' ';
  390.     ColorScreen[0, 70].char := ' ';
  391.     ColorScreen[0, 71].char := ' ';
  392.     ColorScreen[0, 72].char := ' ';
  393.     ColorScreen[0, 73].char := ' ';
  394.     ColorScreen[0, 74].char := ' ';
  395.     ColorScreen[0, 75].char := ' ';
  396.     ColorScreen[0, 76].char := ColStr[1];
  397.     ColorScreen[0, 77].char := ColStr[2];
  398.     ColorScreen[0, 78].char := ColStr[3];
  399.     ColorScreen[0, 79].char := ' ';
  400.     FOR y := 1 TO 23 DO
  401.       FOR x := 0 TO 79 DO
  402.         ColorScreen[y, x].attr := TextAttr;
  403.   END;
  404.   Delay(scrollwait DIV 3);
  405. END;
  406.  
  407. (* ------------------------------------------------------ *)
  408.  
  409. FUNCTION SearchForString(VAR Line : INTEGER;
  410.                              again: BOOLEAN): BYTE;
  411. VAR
  412.   ExitChar, i  : INTEGER;
  413.   Attr         : BYTE;
  414.   TextStr,
  415.   SearchStr    : pChar;
  416.   SearchString : STRING;
  417.  
  418.   FUNCTION StrUpper(CONST s: pChar; VAR t: pChar): pChar;
  419.   (* ... wegen Schlamperei von Borland in der Laufzeit- *)
  420.   (* bibliothek: Die Funktion wandelt den Referenzpara- *)
  421.   (* meter statt des Funktionsergebnisses!!!            *)
  422.   BEGIN
  423.     StrCopy(t, s);
  424.     StrCopy(t, Strings.StrUpper(t));
  425.     StrUpper := t;
  426.   END;
  427.  
  428. BEGIN
  429.   SetCursor(StartCursor);
  430.   Attr := TextAttr;
  431.   TextAttr := StatusColor;
  432.   OutTextXY('Text suchen: ', TextAttr, 25, 1);
  433.   GotoXY(15, 25);
  434.   IF NOT again THEN BEGIN
  435.      SearchString := ReadString(49, ExitChar);
  436.      LastSearch   := SearchString;
  437.   END ELSE SearchString := LastSearch;
  438.   HideCursor;
  439.   TextAttr := Attr;
  440.   IF ExitChar = 27 THEN BEGIN
  441.     SearchForString := 2;
  442.     Exit;
  443.   END;
  444.   IF Length(SearchString) > 0 THEN BEGIN
  445.     GetMem(SearchStr, $100);
  446.     GetMem(TextStr,   $100);
  447.     StrPCopy(SearchStr, SearchString);
  448.     StrUpper(SearchStr, SearchStr);
  449.     IF Line >= NumOfLines - ScreenLines - 1 THEN Line := 1;
  450.     FOR i := Line + 1 TO NumOfLines DO
  451.       IF StrLen(README_TEXT[i]) > 0 THEN BEGIN
  452.     { nicht die aktuelle erste sondern nächste Zeile am BS }
  453.       StrUpper(README_TEXT[i], TextStr);
  454.       IF StrPos(TextStr, SearchStr) <> NIL THEN BEGIN
  455.         Line            := i;
  456.         SearchForString := 1;
  457.         FreeMem(SearchStr, $100);
  458.         FreeMem(TextStr,   $100);
  459.         Exit;
  460.       END;
  461.     END;
  462.     Line := NumOfLines;
  463.   END ELSE BEGIN
  464.     SearchForString := 2;
  465.     Exit;
  466.   END;
  467.   Line := NumOfLines - ScreenLines;
  468.   SearchForString := 0;
  469. END;
  470.  
  471. (* ------------------------------------------------------ *)
  472.  
  473. FUNCTION DosShell(CONST Line : INTEGER) : INTEGER;
  474. VAR
  475.   Attr : BYTE;
  476.   i, y : INTEGER;
  477. BEGIN
  478.   Attr     := TextAttr;
  479.   TextAttr := DosBoxColor;
  480.   ClrScr;
  481.   WriteLn(^J'Zurück zum Programm mit Exit'
  482.             + #17#196#196#217#10);
  483.   BlockCursor;
  484.   SwapVectors;
  485.   Exec(GetEnv('COMSPEC'), '');
  486.   DosShell := DosError;
  487.   SwapVectors;
  488.   HideCursor;
  489.   TextAttr := Attr;
  490.   y        := 1;
  491.   FOR i := Line TO Line + Pred(ScreenLines) DO BEGIN
  492.     Inc(y);
  493.     OutTextXY(StrPas(README_TEXT[i]), TextAttr, y,
  494.               FirstPosition);
  495.   END;
  496.   DisplayHeader('');
  497. END;
  498.  
  499. PROCEDURE CheckDelay;
  500. VAR
  501.   value   : WORD;
  502.   test    : INTEGER;
  503.   MyName  : PathStr;
  504.   MyDir   : DirStr;
  505.   MyFName : NameStr;
  506.   MyExt   : ExtStr;
  507. BEGIN
  508.   IF Pos('?', ParamStr(1)) > 0 THEN BEGIN
  509.     MyName := FExpand(ParamStr(0));
  510.     FSplit(MyName, MyDir, MyFName, MyExt);
  511.     WriteLn('Aufruf: ', MyFName,
  512.             ' [Scroll-Delay in Millisekunden]');
  513.     WriteLn(MyCopyRight);
  514.     Halt(0);
  515.   END ELSE BEGIN
  516.     Val(ParamStr(1), value, test);
  517.     IF test = 0 THEN IF value > 0 THEN BEGIN
  518.       scrollwait := value;
  519.     END;
  520.   END;
  521. END;
  522.  
  523. (* ====================================================== *)
  524.  
  525. VAR
  526.   Key, ch                    : CHAR;
  527.   LineCounter, y, OutPutLine : INTEGER;
  528.   DefaultColor, Found        : BYTE;
  529.   LineScroll, Done           : BOOLEAN;
  530. BEGIN
  531.   IF IOResult <> 0 THEN ;
  532.   IF ParamCount > 0 THEN CheckDelay;
  533.   Monochrom    := Byte(Ptr(Seg0040, $0049)^) = 7; (* HGC  *)
  534.   CheckBreak   := FALSE;                 (* kein Abbruch  *)
  535.   DirectVideo  := TRUE;                  (* schneller     *)
  536.   DoBeep       := TRUE; (* Falls Ton unerwünscht := FALSE *)
  537.   DefaultColor := TextAttr;              (* Farben merken *)
  538.   HideCursor;                            (* Unit Cursor   *)
  539.   ClrScr;
  540.   IF Monochrom OR (Byte(Ptr(Seg0040, $49)^) = 2) THEN BEGIN
  541.     StatusColor := $70;          (* invertiert            *)
  542.     ErrorColor  := $1F;          (* weiß auf grau         *)
  543.     PrintColor  := $10;          (* invertiert            *)
  544.     SearchColor := $F0;          (* invertiert + blinkend *)
  545.     HelpColor   := $0F;          (* hell                  *)
  546.     DosBoxColor := $0F;          (* normal                *)
  547.     NormColor   := $07;          (* normal                *)
  548.   END;                           (* $01 = unterstrichen   *)
  549.   DisplayHeader('');
  550.   DisplayFooter;
  551.   TextAttr := NormColor;
  552.   FOR y := 1 TO ScreenLines DO
  553.     OutTextXY(StrPas(README_TEXT[y]), TextAttr, y + 1,
  554.               FirstPosition);
  555.   LineCounter := 1;
  556.   LastSearch  := '';
  557.   REPEAT
  558.     Str(LineCounter, LCStr);
  559.     WHILE Length(LCStr) < 4 DO LCStr := ' ' + LCStr;
  560.     LCStr := 'Zeile ' + LCStr;
  561.     DisplayHeader(LCStr);
  562.     LineScroll := FALSE;
  563.     Key        := ReadKey;
  564.     CASE UpCase(Key) OF
  565.       'T' : DoBeep := NOT DoBeep;           (* Umschalter *)
  566.       'O' : BEGIN
  567.               IF DosShell(LineCounter) <> 0 THEN BEGIN
  568.                 OutTextXY('Shell konnte nicht ausgeführt' +
  569.                           ' werden!', ErrorColor, 25, 1);
  570.                 Beep(1500);
  571.               END;
  572.               DisplayFooter;
  573.             END;
  574.       'W' : BEGIN   (* immer weiter suchen ..., Erw. v2.3 *)
  575.               IF LastSearch = '' THEN
  576.                 Found := SearchForString(LineCounter, FALSE)
  577.               ELSE
  578.                 Found := SearchForString(LineCounter, TRUE);
  579.               ActualColor := TextAttr;
  580.               OutPutLine  := 1;
  581.               FOR y := LineCounter TO
  582.                 LineCounter + Pred(ScreenLines) DO BEGIN
  583.                 Inc(OutPutLine);
  584.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  585.                           OutPutLine, FirstPosition);
  586.               END;
  587.               OutPutLine := 1;
  588.               IF Found = 1 THEN BEGIN
  589.                 OutTextXY('Textstelle gefunden!',
  590.                           StatusColor, 25, 1);
  591.                 IF Monochrom THEN
  592.                   FOR y := 0 TO 79 DO
  593.                     MonoScreen[1, y].attr := SearchColor
  594.                 ELSE
  595.                   FOR y := 0 TO 79 DO
  596.                     ColorScreen[1, y].attr := SearchColor;
  597.                 Delay(scrollwait * 3);
  598.               END ELSE IF Found = 0 THEN BEGIN
  599.                 OutTextXY('Textstelle nicht gefunden!',
  600.                           ErrorColor, 25, 1);
  601.                 Beep(1000);
  602.               END ELSE BEGIN
  603.                 OutTextXY('Suche wurde abgebrochen',
  604.                           ErrorColor, 25, 1);
  605.                 Beep(1000);
  606.               END;
  607.               TextAttr := ActualColor;
  608.               IF Monochrom THEN
  609.                 FOR y := 0 TO 79 DO
  610.                   MonoScreen[1, y].attr := ActualColor
  611.               ELSE
  612.                 FOR y := 0 TO 79 DO
  613.                   ColorScreen[1, y].attr := ActualColor;
  614.               DisplayFooter;
  615.             END;
  616.       'S' : BEGIN  (* Immer neuen String suchen ... *)
  617.               Found := SearchForString(LineCounter, FALSE);
  618.               ActualColor := TextAttr;
  619.               OutPutLine  := 1;
  620.               FOR y := LineCounter TO
  621.                 LineCounter + Pred(ScreenLines) DO BEGIN
  622.                 Inc(OutPutLine);
  623.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  624.                           OutPutLine, FirstPosition);
  625.               END;
  626.               OutPutLine := 1;
  627.               IF Found = 1 THEN BEGIN
  628.                 OutTextXY('Textstelle gefunden!',
  629.                           StatusColor, 25, 1);
  630.                 IF Monochrom THEN
  631.                   FOR y := 0 TO 79 DO
  632.                     MonoScreen[1, y].attr := SearchColor
  633.                 ELSE
  634.                   FOR y := 0 TO 79 DO
  635.                     ColorScreen[1, y].attr := SearchColor;
  636.                 Delay(scrollwait * 3);
  637.               END ELSE IF Found = 0 THEN BEGIN
  638.                 OutTextXY('Textstelle nicht gefunden!',
  639.                           ErrorColor, 25, 1);
  640.                 Beep(1000);
  641.               END ELSE BEGIN
  642.                 OutTextXY('Suche wurde abgebrochen',
  643.                           ErrorColor, 25, 1);
  644.                 Beep(1000);
  645.               END;
  646.               TextAttr := ActualColor;
  647.               IF Monochrom THEN
  648.                 FOR y := 0 TO 79 DO
  649.                   MonoScreen[1, y].attr := ActualColor
  650.               ELSE
  651.                 FOR y := 0 TO 79 DO
  652.                   ColorScreen[1, y].attr := ActualColor;
  653.               DisplayFooter;
  654.             END;
  655.        'D': PrintText;
  656.        'L': BEGIN
  657.               ActualColor := TextAttr;
  658.               OutTextXY('Text wird endlos ge' +
  659.                         'scrollt, Ende mit [Leertaste] ...',
  660.                         StatusColor, 25, 1);
  661.               ScrollThruText(LineCounter);
  662.               TextAttr   := ActualColor;
  663.               DisplayFooter;
  664.               LineScroll := TRUE;
  665.               OutPutLine := 1;
  666.               FOR y := LineCounter TO
  667.                 LineCounter + Pred(ScreenLines) DO BEGIN
  668.                 Inc(OutPutLine);
  669.                 OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  670.                           OutPutLine, FirstPosition);
  671.               END;
  672.             END;
  673.        '>': ChangeColor(Incr);
  674.        '<': ChangeColor(Decr);
  675.        'Q', 'X': Key := #27;                      (* Ende *)
  676.        #27: ;                   (* einfachste Möglichkeit *)
  677.                                 (* um Beep auszuschließen *)
  678.       ELSE IF Key <> #0 THEN Beep(0);
  679.     END;
  680.  
  681.     IF Key = #0 THEN BEGIN
  682.       Done := TRUE;
  683.       IF NOT LineScroll THEN ch := ReadKey;
  684.       CASE ch OF
  685.         ';': Help;
  686.         '<': SaveToFile;
  687.    '-', 'D': Key := #27;                          (* Ende *)
  688.         'H': IF LineCounter > 1 THEN Dec(LineCounter)
  689.                                 ELSE Done := FALSE;
  690.         'P': IF LineCounter <
  691.                 NumOfLines - Pred(ScreenLines) THEN
  692.                Inc(LineCounter)
  693.              ELSE
  694.                Done := FALSE;
  695.         'G': IF LineCounter > 1 THEN LineCounter:= 1
  696.                                 ELSE Done := FALSE;
  697.         'O': IF LineCounter <
  698.                 NumOfLines - Pred(ScreenLines) THEN
  699.                LineCounter := NumOfLines - Pred(ScreenLines)
  700.              ELSE
  701.                Done := FALSE;
  702.         'Q': IF LineCounter < (NumOfLines -
  703.                 Pred(ScreenLines) SHL 1) THEN
  704.                Inc(LineCounter, ScreenLines)
  705.              ELSE IF LineCounter = (NumOfLines -
  706.                      Pred(ScreenLines) SHL 1) THEN
  707.                Done := FALSE
  708.              ELSE
  709.                LineCounter := NumOfLines - Pred(ScreenLines);
  710.         'I': IF LineCounter > (ScreenLines SHL 1) THEN
  711.                Dec(LineCounter, ScreenLines)
  712.              ELSE IF LineCounter = 1 THEN
  713.                Done := FALSE
  714.              ELSE
  715.                LineCounter := 1;
  716.         ELSE Beep(0); Done := FALSE;
  717.       END;
  718.       IF Done THEN BEGIN
  719.         OutPutLine := 1;
  720.         FOR y := LineCounter TO
  721.                  LineCounter + Pred(ScreenLines) DO BEGIN
  722.           Inc(OutPutLine);
  723.           OutTextXY(StrPas(README_TEXT[y]), TextAttr,
  724.                     OutPutLine, FirstPosition);
  725.         END;
  726.       END;
  727.     END;
  728.   UNTIL Key = #27;
  729.   SetCursor(StartCursor);
  730.   TextAttr := DefaultColor;
  731.   ClrScr;
  732. END.
  733.  
  734. (* ====================================================== *)
  735. (*                 Ende von README.PAS                    *)
  736.