home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / anivga12 / eingaben.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-11  |  9KB  |  279 lines
  1. {$UNDEF test}
  2. {$IFDEF test}
  3.   PROGRAM eingaben;
  4.   {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  5.   {$M 16384,0,655360}
  6. {$ELSE}
  7.   unit eingaben;
  8.   {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
  9.   {$M 16384,0,655360}
  10.  
  11. {Zweck    : Stellt eine komfortable Eingaberoutine zur Verfügung}
  12. {Autor    : Kai Rohrbacher    }
  13. {Sprache  : TurboPascal 6.0   }
  14. {Datum    : 17.09.1992        }
  15. {Anmerkung: Arbeitet mit allen Textmodi}
  16.  
  17. INTERFACE
  18. {$ENDIF}
  19. USES crt,dos;
  20.  
  21. CONST MaxInput=79;
  22. TYPE  InputString=String[MaxInput];
  23.  
  24. {$IFNDEF test}
  25.  
  26. PROCEDURE GetString(VAR InOutStr:InputString; MaxLen:Byte;
  27.                     VAR abbruch:Boolean);
  28. PROCEDURE BoxGetString(VAR InOutStr:InputString; MaxLen:Byte;
  29.                     VAR abbruch:Boolean; header:InputString);
  30.  
  31. IMPLEMENTATION
  32. {$ENDIF}
  33.  
  34. CONST StackSize=10;
  35.       BufStart:Integer=0;
  36.       BufEnd:Integer=0;
  37.       StackEmpty:Boolean=true;
  38.       InsertM:Boolean=true;
  39. VAR Stack:Array[0..StackSize] OF InputString;
  40.     columns:BYTE ABSOLUTE $40:$4A; {#Spalten des aktuellen Videomodus}
  41.  
  42.  
  43. PROCEDURE GetString(VAR InOutStr:InputString; MaxLen:Byte;
  44.                     VAR abbruch:Boolean);
  45. { in: "InOutStr" = Defaultstring für Eingabe}
  46. {     "MaxLen"  = maximale Länge der Eingabe}
  47. {     "abbruch" = TRUE/FALSE für: alten Eingabenstapel löschen/nicht löschen}
  48. {out: "InOutStr" = eingegebener String (falls "abbruch"= FALSE)}
  49. {     "abbruch" = TRUE/FALSE, wenn ESC/RETURN eingegeben wurde}
  50. {     "Stack" (globale Variable!) wurde um "ActualLine" ergänzt, wenn die}
  51. {     Eingabe mit RETURN beendet wurde und kein Leerstring war: diese}
  52. {     Variable ist somit eine Art "Eingabestapel" früherer Eingaben}
  53. {rem: Editiermöglichkeiten wie bei Wordstareditor, zusätzlich }
  54. {     UP/DOWN für die letzten "StackSize+1" Eingaben}
  55. {     Die Eingabe beginnt an der aktuellen Cursorposition und darf }
  56. {     den rechten Bildschirmrand nicht überschreiten (die Prozedur }
  57. {     schneidet allerdings selber entsprechend ab)! Aus dem selben }
  58. {     Grund kann eine Eingabe von vorneherein maximal "MaxInput"   }
  59. {     Zeichen lang sein.}
  60. CONST stop:set of char=
  61.    ['0'..'9','A'..'Z','a'..'z','ä','ö','ü','ß','Ä','Ö','Ü'];
  62. VAR oldx,oldy:byte;
  63.     currentline:Integer;
  64.     LineDone:boolean;
  65.     temp:Integer;
  66.     ActualLine:InputString;
  67.     index:BYTE;
  68.     Wahl:WORD;
  69.     done:boolean;
  70.     ch:char;
  71.  
  72.   PROCEDURE ShowActualLine;
  73.   VAR i:BYTE;
  74.   BEGIN
  75.    GotoXY(oldx+length(ActualLine),oldy);
  76.    FOR i:=Succ(length(ActualLine)) TO MaxLen DO WRITE(' ');
  77.    GotoXY(oldx,oldy);
  78.    WRITE(ActualLine)
  79.   END;
  80.  
  81.   FUNCTION SearchForward(von:BYTE):BYTE;
  82.   VAR max:BYTE;
  83.   BEGIN
  84.    max:=succ(length(ActualLine));
  85.    WHILE (von<max) and (ActualLine[von] in stop) DO inc(von);
  86.    if von<max THEN inc(von);
  87.    WHILE (von<max) and NOT(ActualLine[von] in stop) DO inc(von);
  88.    if (von>max)
  89.     THEN SearchForward:=max
  90.     ELSE SearchForward:=von
  91.   END;
  92.  
  93.   FUNCTION SearchBackward(von:SHORTINT):BYTE;
  94.   BEGIN
  95.    Dec(von);
  96.    WHILE (von>0) and NOT(ActualLine[von] in stop) DO dec(von);
  97.    if von>0 THEN dec(von);
  98.    WHILE (von>0) and (ActualLine[von] in stop) DO dec(von);
  99.    if (von<0)
  100.     THEN SearchBackward:=0
  101.     ELSE SearchBackward:=Succ(von)
  102.   END;
  103.  
  104. BEGIN {of GetString}
  105.  oldx:=wherex; oldy:=wherey;
  106.  IF MaxLen>columns-oldx THEN MaxLen:=columns-oldx;
  107.  ActualLine:=copy(InOutStr,1,MaxLen);
  108.  IF abbruch
  109.   THEN BEGIN
  110.         BufStart:=0; BufEnd:=0; StackEmpty:=TRUE;
  111.        END;
  112.  currentline:=BufEnd; LineDone:=false; abbruch:=false;
  113.  Stack[BufEnd]:='';
  114.  REPEAT
  115.   ShowActualLine;
  116.   index:=succ(length(ActualLine));
  117.   if index>MaxLen THEN index:=MaxLen;
  118.   done:=false;
  119.   REPEAT
  120.    GotoXY(pred(oldx+index),oldy);
  121.    ch:=readkey;
  122.    if ch>=' '
  123.     THEN BEGIN
  124.           if InsertM
  125.            THEN BEGIN
  126.                  insert(ch,ActualLine,index);
  127.                  ActualLine:=copy(ActualLine,1,MaxLen);
  128.                  write(copy(ActualLine,index,255));
  129.                  if index<MaxLen THEN inc(index)
  130.                 END
  131.            ELSE BEGIN
  132.                  ActualLine[index]:=ch;
  133.                  if index<=MaxLen THEN write(ch);
  134.                  if ActualLine[0]<chr(index) THEN ActualLine[0]:=chr(index);
  135.                  if index<MaxLen THEN inc(index)
  136.                 END;
  137.          END
  138.     ELSE BEGIN
  139.           IF ch=#0
  140.            THEN Wahl:=ORD(ReadKey) SHL 8  {Funktionstasten -> >256}
  141.            ELSE Wahl:=ORD(ch);
  142.           CASE Wahl OF
  143.            $000D, {RETURN}
  144.            $4800, {UP}
  145.            $5000, {DOWN}
  146.            $001B: {ESC}
  147.                   done:=true;  {wird später abgehandelt}
  148.            $0016,
  149.            $5200:InsertM:=not InsertM; {^V, INS}
  150.            $4B00:if index>1 THEN dec(index); {LEFT}
  151.            $4D00:BEGIN {RIGHT}
  152.                   if index<=length(ActualLine) THEN inc(index);
  153.                   if index>MaxLen THEN index:=MaxLen
  154.                  END;
  155.            $4700:index:=1; {HOME}
  156.            $4F00:BEGIN {END}
  157.                   index:=succ(length(ActualLine));
  158.                   if index>MaxLen THEN index:=MaxLen
  159.                  END;
  160.            $0008:if index>1
  161.                   THEN BEGIN {BACKSPACE, ^H}
  162.                         dec(index);
  163.                         delete(ActualLine,index,1);
  164.                         ShowActualLine
  165.                        END;
  166.            $0007,
  167.            $5300:if ActualLine<>''
  168.                   THEN BEGIN {^G, DEL}
  169.                         delete(ActualLine,index,1);
  170.                         ShowActualLine
  171.                        END;
  172.            $0001,
  173.            $7300:index:=SearchBackward(index); {^A, CTRL-LEFT}
  174.            $0006,
  175.            $7400:BEGIN {^F, CTRL-RIGHT}
  176.                   index:=SearchForward(index);
  177.                   if index>MaxLen THEN index:=MaxLen
  178.                  END;
  179.            $000B:BEGIN {^K}
  180.                   delete(ActualLine,index,255);
  181.                   ShowActualLine
  182.                  END;
  183.            $0014:BEGIN {^T}
  184.                   delete(ActualLine,index,SearchForward(index)-index);
  185.                   ShowActualLine
  186.                  END;
  187.            $0019:BEGIN {^Y}
  188.                   ActualLine:=''; index:=1; ShowActualLine
  189.                  END;
  190.           END;
  191.          END;
  192.   UNTIL done;
  193.  
  194.   CASE Wahl of
  195.    $000D:BEGIN {RETURN}
  196.           LineDone:=true;
  197.           IF length(ActualLine)>0
  198.            THEN BEGIN
  199.                  Stack[BufEnd]:=ActualLine;
  200.                  BufEnd:=succ(BufEnd) mod succ(StackSize);
  201.                  if BufEnd=0 THEN StackEmpty:=false;
  202.                  if not StackEmpty
  203.                   THEN BufStart:=succ(BufStart) mod succ(StackSize)
  204.                 END;
  205.          END;
  206.    $001B:abbruch:=true; {ESC}
  207.    $4800:BEGIN {Up}
  208.           if currentline<>BufStart
  209.            THEN BEGIN
  210.                  dec(currentline);
  211.                  if currentline<0 THEN currentline:=StackSize
  212.                 END;
  213.           ActualLine:=Stack[currentline];
  214.          END;
  215.    $5000:BEGIN {Down}
  216.           if currentline<>BufEnd
  217.            THEN currentline:=succ(currentline) mod succ(StackSize);
  218.           ActualLine:=Stack[currentline];
  219.          END;
  220.   END;
  221.  UNTIL LineDone or abbruch;
  222.  if LineDone THEN InOutStr:=ActualLine;
  223. END;
  224.  
  225. PROCEDURE BoxGetString(VAR InOutStr:InputString; MaxLen:Byte;
  226.                        VAR abbruch:Boolean; header:InputString);
  227. { in,out,rem: wie bei GetString() auch! Zusätzlich:}
  228. { in: header = auszugebender Boxtext}
  229. {rem: Um den Eingabebereich wird eine Box gezogen und mit einem Header }
  230. {     versehen; dieser Header muß natürlich in die Box passen!}
  231. {     Außerdem muß die Box um den Eingabebereich herum passen!}
  232. VAR oldx,oldy,i,n:BYTE;
  233. BEGIN
  234.  oldx:=WhereX; oldy:=WhereY;
  235.  IF length(header)>MaxLen
  236.   THEN Delete(header,Succ(MaxLen),length(header)-MaxLen); {evtl. kürzen}
  237.  IF length(header)<MaxLen THEN header:=' '+header;
  238.  IF length(header)<MaxLen THEN header:=header+' ';
  239.  GotoXY(Pred(oldx),Pred(oldy));
  240.  WRITE('╔');
  241.  n:=MaxLen-length(header);
  242.  FOR i:=1 TO n SHR 1 DO WRITE('═');
  243.  WRITE(header);
  244.  IF odd(n) THEN WRITE('═');
  245.  FOR i:=1 TO n SHR 1 DO WRITE('═');
  246.  WRITE('╗');
  247.  
  248.  GotoXY(Pred(oldx),oldy);
  249.  WRITE('║'); FOR i:=1 TO MaxLen DO WRITE(' '); WRITE('║');
  250.  GotoXY(Pred(oldx),Succ(oldy));
  251.  WRITE('╚'); FOR i:=1 TO MaxLen DO WRITE('═'); WRITE('╝');
  252.  
  253.  GotoXY(oldx,oldy);
  254.  GetString(InOutStr,MaxLen,abbruch)
  255. END;
  256.  
  257. {$IFDEF test}
  258. VAR s:InputString;
  259.     flag:BOOLEAN;
  260.     attr:BYTE;
  261. {$ENDIF}
  262.  
  263. BEGIN
  264. {$IFDEF test}
  265.  REPEAT
  266.    ClrScr;
  267.    GotoXY(10,12);
  268.    s:='Default'; FLAG:=FALSE;
  269.    attr:=TextAttr; TextColor(White); TextBackground(Blue);
  270.    BoxGetString(s,20,FLAG,'Beliebiger Text:');
  271.    TextAttr:=attr;
  272.    GotoXY(1,1);
  273.    IF FLAG
  274.     THEN WRITELN('Abbruch!')
  275.     ELSE WRITELN('Eingabe: ',s);
  276.    READLN;
  277.  UNTIL FLAG;
  278. {$ENDIF}
  279. END.