home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / readunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  5.2 KB  |  178 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y-}
  2. (*===================================================================*)
  3. (*                            READUNIT.PAS                           *)
  4. (*             Copyright (C) 1993 te-wi Verlag, München              *)
  5. (*-------------------------------------------------------------------*)
  6. (*      Implementation einer komfortablen ReadString-Routine         *)
  7. (*===================================================================*)
  8.  
  9. UNIT ReadUnit;
  10.  
  11. INTERFACE
  12.  
  13. FUNCTION ReadString(EntryLength: BYTE; VAR LastChar: INTEGER): STRING;
  14.  
  15. IMPLEMENTATION
  16.  
  17. USES
  18.   Dos, Cursor, Crt;
  19.  
  20. FUNCTION ReadString;
  21. VAR
  22.   ch            : CHAR;
  23.   Insert, Ready : BOOLEAN;
  24.   CursorStart   : WORD;
  25.   CurPoint,
  26.   x, y          : WORD;
  27.   counter       : BYTE;
  28.   Entry         : STRING;
  29.  
  30.   PROCEDURE Errorbeep;
  31.   BEGIN
  32.     Sound(900);
  33.     Delay(20);
  34.     NoSound;
  35.   END;
  36.  
  37. BEGIN
  38.   CursorStart := StartCursor;
  39.   CheckBreak  := FALSE;
  40.   x           := WhereX;
  41.   y           := WhereY;
  42.   Entry       := '';
  43.   GotoXY(x, y);
  44.   CurPoint    := 0;
  45.   Insert      := TRUE;
  46.   Ready       := FALSE;
  47.   REPEAT
  48.     ch := ReadKey;
  49.     CASE ch OF
  50.     Chr(10), Chr(13):                                      (* LF, CR *)
  51.       BEGIN
  52.         LastChar := Ord(ch);
  53.         Ready    := TRUE;
  54.       END;
  55.     Chr(3), Chr(27):                                      (* ^C, ESC *)
  56.       BEGIN
  57.         LastChar := Ord(ch);
  58.         Entry    := '';
  59.         CurPoint := 0;
  60.         Ready    := TRUE;
  61.       END;
  62.     Chr(7):                                (* -> Del bei PC1512/1640 *)
  63.       BEGIN
  64.         IF CurPoint <> Length(Entry) THEN
  65.         BEGIN
  66.          FOR counter := CurPoint + 1 TO Length(Entry) - 1 DO
  67.            Entry[counter] := Entry[counter + 1];
  68.            Entry := Copy(Entry, 1, Length(Entry) - 1);
  69.            GotoXY(x, y);
  70.            Write(Entry, Chr(22));
  71.            GotoXY(x + CurPoint, y);
  72.          END;
  73.        END;
  74.     Chr(32)..Chr(126), Chr(128)..Chr(255):      (* erlaubtes Zeichen *)
  75.       BEGIN
  76.         IF (Length(Entry) < EntryLength) OR NOT Insert THEN
  77.         BEGIN
  78.           IF CurPoint = Length(Entry) THEN
  79.           BEGIN
  80.             Entry := Entry + ch;
  81.             GotoXY(x + CurPoint, y);
  82.             Inc(CurPoint);
  83.             Write(ch);
  84.           END
  85.           ELSE
  86.           BEGIN
  87.             IF Insert THEN
  88.             BEGIN
  89.               Entry := Entry + Chr(32);
  90.               FOR counter := Length(Entry) - 1 DOWNTO CurPoint + 1 DO
  91.                 Entry[counter+1] := Entry[counter];
  92.             END;
  93.             Inc(CurPoint);
  94.             Entry[CurPoint] := ch;
  95.             GotoXY(x, y);
  96.             Write(Entry);
  97.             GotoXY(x + CurPoint, y);
  98.           END;
  99.         END;
  100.       END;
  101.     Chr(8), Chr(127):                                     (* BS, ^BS *)
  102.       BEGIN
  103.         IF CurPoint <> 0 THEN
  104.         BEGIN
  105.           FOR counter := CurPoint TO Length(Entry) - 1 DO
  106.             Entry[counter] := Entry[counter + 1];
  107.           Entry := Copy(Entry, 1, Length(Entry) - 1);
  108.           Dec(CurPoint);
  109.           GotoXY(x, y);
  110.           Write(Entry, Chr(22));
  111.           GotoXY(x + CurPoint, y);
  112.         END;
  113.       END;
  114.     Chr(0):                                      (* erweiterte Taste *)
  115.       BEGIN
  116.         ch := ReadKey;
  117.         CASE ch OF
  118.         Chr(82):                                              (* Ins *)
  119.           BEGIN
  120.             Insert := NOT Insert;
  121.             IF Insert THEN SetCursor(StartCursor)
  122.                       ELSE Blockcursor;
  123.           END;
  124.         Chr(71):                                             (* Home *)
  125.           BEGIN
  126.             CurPoint := 0;
  127.             GotoXY(x, y);
  128.             Write(Entry);
  129.             GotoXY(x + CurPoint, y);
  130.           END;
  131.         Chr(79):                                              (* End *)
  132.           BEGIN
  133.             CurPoint := Length(Entry);
  134.             GotoXY(x, y);
  135.             Write(Entry);
  136.             GotoXY(x + CurPoint, y);
  137.           END;
  138.         Chr(83):                                              (* Del *)
  139.           BEGIN
  140.             IF CurPoint <> Length(Entry) THEN
  141.             BEGIN
  142.               FOR counter := CurPoint + 1 TO Length(Entry) - 1 DO
  143.                 Entry[counter] := Entry[counter + 1];
  144.               Entry := Copy(Entry, 1, Length(Entry) - 1);
  145.               GotoXY(x, y);
  146.               Write(Entry, Chr(22));
  147.               GotoXY(x + CurPoint, y);
  148.             END;
  149.           END;
  150.         Chr(75):                                               (* <- *)
  151.           BEGIN
  152.             IF CurPoint <> 0 THEN
  153.             BEGIN
  154.               Dec(CurPoint);
  155.               GotoXY(x + CurPoint, y);
  156.             END;
  157.           END;
  158.         Chr(77):                                               (* -> *)
  159.           BEGIN
  160.             IF CurPoint <> Length(Entry) THEN
  161.             BEGIN
  162.               Inc(CurPoint);
  163.               GotoXY(x + CurPoint, y);
  164.               END;
  165.             END;
  166.           ELSE Errorbeep;
  167.         END;
  168.       END
  169.       ELSE Errorbeep;
  170.     END;
  171.   UNTIL Ready;
  172.   SetCursor(CursorStart);            (* Original-Cursor restaurieren *)
  173.   ReadString := Entry;
  174. END;
  175.  
  176. END.
  177. (*===================================================================*)
  178.