Home » Source Code » » EINGABEN.PAS

EINGABEN.PAS ( File view )

From:
  • By 2010-07-21
  • View(s):9
  • Download(s):0
  • Point(s): 1
			{
$UNDEF test
}
{
$IFDEF test
}
  PROGRAM eingaben;
  {
$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-
}
  {
$M 16384,0,655360
}
{
$ELSE
}
  unit eingaben;
  {
$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-
}
  {
$M 16384,0,655360
}

{
Zweck    : Stellt eine komfortable Eingaberoutine zur Verfgung
}
{
Autor    : Kai Rohrbacher    
}
{
Sprache  : TurboPascal 6.0   
}
{
Datum    : 17.09.1992        
}
{
Anmerkung: Arbeitet mit allen Textmodi
}

INTERFACE
{
$ENDIF
}
USES crt,dos;

CONST MaxInput=79;
TYPE  InputString=String[MaxInput];

{
$IFNDEF test
}

PROCEDURE GetString(VAR InOutStr:InputString; MaxLen:Byte;
                    VAR abbruch:Boolean);
PROCEDURE BoxGetString(VAR InOutStr:InputString; MaxLen:Byte;
                    VAR abbruch:Boolean; header:InputString);

IMPLEMENTATION
{
$ENDIF
}

CONST StackSize=10;
      BufStart:Integer=0;
      BufEnd:Integer=0;
      StackEmpty:Boolean=true;
      InsertM:Boolean=true;
VAR Stack:Array[0..StackSize] OF InputString;
    columns:BYTE ABSOLUTE $40:$4A; {
#Spalten des aktuellen Videomodus
}


PROCEDURE GetString(VAR InOutStr:InputString; MaxLen:Byte;
                    VAR abbruch:Boolean);
{
 in: "InOutStr" = Defaultstring fr Eingabe
}
{
     "MaxLen"  = maximale Lnge der Eingabe
}
{
     "abbruch" = TRUE/FALSE fr: alten Eingabenstapel lschen/nicht lschen
}
{
out: "InOutStr" = eingegebener String (falls "abbruch"= FALSE)
}
{
     "abbruch" = TRUE/FALSE, wenn ESC/RETURN eingegeben wurde
}
{
     "Stack" (globale Variable!) wurde um "ActualLine" ergnzt, wenn die
}
{
     Eingabe mit RETURN beendet wurde und kein Leerstring war: diese
}
{
     Variable ist somit eine Art "Eingabestapel" frherer Eingaben
}
{
rem: Editiermglichkeiten wie bei Wordstareditor, zustzlich 
}
{
     UP/DOWN fr die letzten "StackSize+1" Eingaben
}
{
     Die Eingabe beginnt an der aktuellen Cursorposition und darf 
}
{
     den rechten Bildschirmrand nicht berschreiten (die Prozedur 
}
{
     schneidet allerdings selber entsprechend ab)! Aus dem selben 
}
{
     Grund kann eine Eingabe von vorneherein maximal "MaxInput"   
}
{
     Zeichen lang sein.
}
CONST stop:set of char=
   ['0'..'9','A'..'Z','a'..'z','','','','','','',''];
VAR oldx,oldy:byte;
    currentline:Integer;
    LineDone:boolean;
    temp:Integer;
    ActualLine:InputString;
    index:BYTE;
    Wahl:WORD;
    done:boolean;
    ch:char;

  PROCEDURE ShowActualLine;
  VAR i:BYTE;
  BEGIN
   GotoXY(oldx+length(ActualLine),oldy);
   FOR i:=Succ(length(ActualLine)) TO MaxLen DO WRITE(' ');
   GotoXY(oldx,oldy);
   WRITE(ActualLine)
  END;

  FUNCTION SearchForward(von:BYTE):BYTE;
  VAR max:BYTE;
  BEGIN
   max:=succ(length(ActualLine));
   WHILE (vonmax)
    THEN SearchForward:=max
    ELSE SearchForward:=von
  END;

  FUNCTION SearchBackward(von:SHORTINT):BYTE;
  BEGIN
   Dec(von);
   WHILE (von>0) and NOT(ActualLine[von] in stop) DO dec(von);
   if von>0 THEN dec(von);
   WHILE (von>0) and (ActualLine[von] in stop) DO dec(von);
   if (von<0)
    THEN SearchBackward:=0
    ELSE SearchBackward:=Succ(von)
  END;

BEGIN {
of GetString
}
 oldx:=wherex; oldy:=wherey;
 IF MaxLen>columns-oldx THEN MaxLen:=columns-oldx;
 ActualLine:=copy(InOutStr,1,MaxLen);
 IF abbruch
  THEN BEGIN
        BufStart:=0; BufEnd:=0; StackEmpty:=TRUE;
       END;
 currentline:=BufEnd; LineDone:=false; abbruch:=false;
 Stack[BufEnd]:='';
 REPEAT
  ShowActualLine;
  index:=succ(length(ActualLine));
  if index>MaxLen THEN index:=MaxLen;
  done:=false;
  REPEAT
   GotoXY(pred(oldx+index),oldy);
   ch:=readkey;
   if ch>=' '
    THEN BEGIN
          if InsertM
           THEN BEGIN
                 insert(ch,ActualLine,index);
                 ActualLine:=copy(ActualLine,1,MaxLen);
                 write(copy(ActualLine,index,255));
                 if index >256
}
           ELSE Wahl:=ORD(ch);
          CASE Wahl OF
           $000D, {
RETURN
}
           $4800, {
UP
}
           $5000, {
DOWN
}
           $001B: {
ESC
}
                  done:=true;  {
wird spter abgehandelt
}
           $0016,
           $5200:InsertM:=not InsertM; {
^V, INS
}
           $4B00:if index>1 THEN dec(index); {
LEFT
}
           $4D00:BEGIN {
RIGHT
}
                  if index<=length(ActualLine) THEN inc(index);
                  if index>MaxLen THEN index:=MaxLen
                 END;
           $4700:index:=1; {
HOME
}
           $4F00:BEGIN {
END
}
                  index:=succ(length(ActualLine));
                  if index>MaxLen THEN index:=MaxLen
                 END;
           $0008:if index>1
                  THEN BEGIN {
BACKSPACE, ^H
}
                        dec(index);
                        delete(ActualLine,index,1);
                        ShowActualLine
                       END;
           $0007,
           $5300:if ActualLine<>''
                  THEN BEGIN {
^G, DEL
}
                        delete(ActualLine,index,1);
                        ShowActualLine
                       END;
           $0001,
           $7300:index:=SearchBackward(index); {
^A, CTRL-LEFT
}
           $0006,
           $7400:BEGIN {
^F, CTRL-RIGHT
}
                  index:=SearchForward(index);
                  if index>MaxLen THEN index:=MaxLen
                 END;
           $000B:BEGIN {
^K
}
                  delete(ActualLine
...
...
(Please download the complete source code to view)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
ANIVGA.DOC220.35 kB07-11-93|18:45
ANIVGA.ENG320.98 kB07-11-93|18:45
ANIVGA.PAS318.61 kB07-11-93|18:45
ANIVGA.TUT12.66 kB07-11-93|18:45
BFFFFFFF.PAS2.02 kB07-11-93|18:45
CHANGES.TXT4.76 kB07-11-93|18:45
COMPRESS.PAS38.98 kB07-11-93|18:45
DATEIEN.PAS45.08 kB07-11-93|18:45
DUMP_SPR.PAS10.05 kB07-11-93|18:45
EINGABEN.PAS8.68 kB07-11-93|18:45
EXAMPL12.PAS3.77 kB07-11-93|18:45
EXAMPLE1.PAS1.58 kB07-11-93|18:45
EXAMPLE2.PAS1.89 kB07-11-93|18:45
EXAMPLE3.PAS3.24 kB07-11-93|18:45
EXAMPLE4.PAS1.64 kB07-11-93|18:45
EXAMPLE5.PAS2.92 kB07-11-93|18:45
EXAMPLE6.PAS3.98 kB07-11-93|18:45
EXAMPLE7.PAS3.03 kB07-11-93|18:45
EXAMPLE8.PAS2.82 kB07-11-93|18:45
EXAMPLE9.PAS1.38 kB07-11-93|18:45
FAQ.TXT11.99 kB07-11-93|18:45
07.00 B
2_HEBREW.FNT3.51 kB11-03-92|10:38
30.FNT3.26 kB11-03-92|10:39
33Q.FNT3.01 kB11-03-92|10:39
36.FNT2.76 kB11-03-92|10:39
44.FNT2.26 kB11-03-92|10:39
8X10.FNT2.51 kB11-03-92|10:38
8X11SNSF.FNT2.76 kB11-03-92|10:38
8X14.FNT3.51 kB11-03-92|10:38
ALPS.FNT3.51 kB11-03-92|10:37
ALPS10.FNT2.51 kB11-03-92|10:37
ALPS11.FNT2.76 kB11-03-92|10:37
ALPS6.FNT1.51 kB11-03-92|10:37
ALPS7.FNT1.76 kB11-03-92|10:37
ALPS8.FNT2.01 kB11-03-92|10:37
ANTIQUE.FNT3.51 kB11-03-92|10:38
APLS9.FNT2.26 kB11-03-92|10:37
B814.FNT3.51 kB11-03-92|10:39
BIGSERIF.FNT3.51 kB11-03-92|10:38
BLCKSNSF.FNT2.51 kB11-03-92|10:38
BLOCK.FNT3.51 kB11-03-92|10:38
BOLD.FNT3.51 kB11-03-92|10:38
BROADWAY.FNT3.51 kB11-03-92|10:38
CNTDOWN.FNT3.51 kB11-03-92|10:37
COMPUTER.FNT3.51 kB11-03-92|10:38
COURIER.FNT3.51 kB11-03-92|10:38
CYRILLIC.FNT3.51 kB11-03-92|10:38
DEFAULT.FNT1.51 kB11-03-92|10:39
FIRE.FNT52.26 kB11-03-92|18:45
FIRE.PAL768.00 B11-03-92|18:45
FRANKFRT.FNT3.51 kB11-03-92|10:37
FRESNO.FNT3.51 kB11-03-92|10:38
FUTURE.FNT3.51 kB11-03-92|10:38
GAELIC.FNT3.51 kB11-03-92|10:37
GEORGIAN.FNT3.51 kB11-03-92|10:37
GREEK.FNT3.51 kB11-03-92|10:38
HOLLOW.FNT3.51 kB11-03-92|10:38
HUGE.FNT4.01 kB11-03-92|10:39
HYLAS.FNT3.51 kB11-03-92|10:38
ITALIC.FNT3.51 kB11-03-92|10:37
ITALICS.FNT3.51 kB11-03-92|10:37
ITT.FNT3.51 kB11-03-92|10:38
LCD.FNT3.51 kB11-03-92|10:38
MEDIEVAL.FNT3.51 kB11-03-92|10:38
MODERNFO.FNT4.01 kB11-03-92|10:39
OCR.FNT3.51 kB11-03-92|10:37
OLDENG.FNT3.51 kB11-03-92|10:37
ROMAN.FNT3.51 kB11-03-92|10:39
SANSERIF.FNT3.51 kB11-03-92|10:39
SCRIBBLE.FNT4.01 kB11-03-92|10:39
SCRIPT.FNT3.51 kB11-03-92|10:37
SCRIPT2.FNT3.51 kB11-03-92|10:39
SENAPL.FNT3.51 kB11-03-92|10:37
SIDE.FNT2.51 kB11-03-92|10:37
SIMILITE.FNT3.51 kB11-03-92|10:39
SMALCAPS.FNT3.51 kB11-03-92|10:39
STRETCH.FNT3.51 kB11-03-92|10:39
SUPER.FNT2.01 kB11-03-92|10:39
THAI.FNT3.51 kB11-03-92|10:39
THIN.FNT3.51 kB11-03-92|10:39
THIN8X8.FNT2.01 kB11-03-92|10:39
_BROADWA.FNT8.01 kB11-02-92|12:06
_OCR.FNT3.51 kB11-03-92|10:39
GRAB.EXE14.53 kB07-11-93|18:45
GRAB.PAS45.71 kB07-11-93|18:45
07.00 B
AEGYPTEN.COD1.30 kB06-12-92|21:42
BLACK.COD434.00 B06-12-92|21:54
FLOWER.COD3.26 kB03-20-92|14:04
FRACTAL.PAL768.00 B07-03-93|16:12
FRACTAL1.PIC62.50 kB07-03-93|16:12
FRACTAL2.PIC62.50 kB07-03-93|16:13
FRACTAL3.PIC62.50 kB07-03-93|16:13
FRACTAL4.PIC62.50 kB07-03-93|16:14
HANTEL.LIB4.77 kB11-10-91|15:20
MARMOR.COD8.80 kB06-13-92|18:38
RANDOM.PAL768.00 B07-17-92|19:31
TILE2.COD1.30 kB10-20-91|13:57
WHATSNEW.LIB1.72 kB06-12-93|20:09
07.00 B
APPLE.COD290.00 B10-02-92|05:34
ESP.COD4.55 kB10-05-92|15:06
GAME.EXE43.13 kB07-04-93|12:21
GAME.PAS12.00 kB07-04-93|13:46
LINE.COD1.02 kB09-25-92|18:55
MUSIC.PAS20.14 kB09-24-92|16:52
MUSIC.TPU4.89 kB07-04-93|12:21
QUEST.LIB4.53 kB10-05-92|15:51
README.TXT549.00 B07-04-93|13:47
SMALLNUM.LIB13.00 kB09-27-92|16:24
SPOOK.LIB3.57 kB10-02-92|07:36
STANDARD.PAL768.00 B09-25-92|18:53
MAKE.BAT165.00 B07-11-93|18:45
MAKES.PAS218.08 kB07-11-93|18:45
PCX2COD.DOC852.00 B07-11-93|18:45
PCX2COD.PAS77.98 kB07-11-93|18:45
README.1ST2.87 kB07-11-93|18:45
README.2ND4.12 kB07-11-93|18:45
SHOWPIC.PAS995.00 B07-11-93|18:45
SVGA256.BGI6.19 kB07-11-93|18:45
UNCHAIN.ASM11.60 kB07-11-93|18:45
UNCHAIN.EXE1.20 kB07-11-93|18:45
UNLIB.PAS5.86 kB07-11-93|18:45
WHATSNEW.EXE37.36 kB07-11-93|18:45
WHATSNEW.PAS9.10 kB07-11-93|18:45
...
Sponsored links

EINGABEN.PAS (678.56 kB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D