home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
tpdoskermit.zip
/
feltedit.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-18
|
15KB
|
561 lines
$R-,S-,D+,T+,F-,V+,B-
Unit FeltEdit;
Interface
Uses Crt;
CONST
ToUpper = 1;
ToLower = 2;
NoInput = 4;
TYPE
CharSet = SET OF CHAR;
CharSetPtr = ^CharSet;
JustType = (LeftJ,CenterJ,RightJ);
FeltStr = STRING[12];
PromptStr = STRING[30];
FeltStrArray = ARRAY [0..255] OF FeltStr;
FeltType = (CharT, StrT, EnumT, BoolT, ByteT, IntT, WordT, LongT);
EditPtr = ^EditRecord;
EditRecord = RECORD
x, y, len, xpos : BYTE;
just : JustType;
prompt : PromptStr;
CASE ftype : FeltType OF
CharT : (CharP : ^CHAR;
oksetC : CharSetPtr;
modeC : BYTE);
StrT : (StrP : ^STRING;
oksetS : CharSetPtr;
modeS : BYTE);
EnumT,
BoolT : (EnumP : ^BYTE;
EnumAntall : BYTE;
EnumStr : ^FeltStrArray);
ByteT : (ByteP : ^BYTE;
ByteMin, ByteMax : LongInt);
IntT : (IntP : ^INTEGER;
IntMin, IntMax : LongInt);
WordT : (WordP : ^WORD;
WordMin, WordMax : LongInt);
LongT : (LongP : ^LongInt;
LongMin, LongMax : LongInt);
END;
CONST
Eantall : WORD = 0;
BoolStr : ARRAY [0..1] OF FeltStr = ('FALSE','TRUE');
NumericSet : CharSet = ['0'..'9','.','+','-'];
InsertMode : BOOLEAN = FALSE;
LastRecord : WORD = 0;
FeltAttr : BYTE = 14;
EditAttr : BYTE = 112;
CONST
EditChar : CHAR = #255;
FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;
FUNCTION Pad(st:String;len : INTEGER): String;
FUNCTION Tstr(l : LongInt; len : INTEGER): String;
PROCEDURE ShowOne(VAR e : EditRecord);
PROCEDURE ShowAll;
PROCEDURE EditOne(VAR e : EditRecord);
PROCEDURE EditARecord(n : WORD);
FUNCTION UpCase(ch : CHAR): CHAR;
FUNCTION LoCase(ch : CHAR): CHAR;
PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);
PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);
PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);
PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : BOOLEAN);
PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : BYTE; min, max : BYTE);
PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);
PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : WORD; min, max : WORD);
PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : LongInt; min, max : LongInt);
PROCEDURE EditAllRecords;
PROCEDURE EditVar(VAR v);
(**************************************************************************)
Implementation
VAR
ERec : ARRAY [0..255] OF EditPtr;
CONST No_Upper : String[3] = '';
No_Lower : String[3] = '';
FUNCTION UpCase(ch : CHAR): CHAR;
VAR p : INTEGER;
BEGIN
IF (ch >= 'a') AND (ch <= 'z') THEN ch := CHAR(BYTE(ch)-32)
ELSE BEGIN
p := Pos(ch,No_Lower);
IF p > 0 THEN ch := No_Upper[p];
END;
UpCase := ch;
END;
FUNCTION LoCase(ch : CHAR): CHAR;
VAR p : INTEGER;
BEGIN
IF (ch >= 'A') AND (ch <= 'Z') THEN ch := CHAR(BYTE(ch)+32)
ELSE BEGIN
p := Pos(ch,No_Upper);
IF p > 0 THEN ch := No_Lower[p];
END;
LoCase := ch;
END;
PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := StrT; xpos := 1; just := pjust;
StrP := Addr(v);
oksetS := okp;
modeS := mode;
END;
Inc(EAntall);
END;
PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := CharT; xpos := 1; just := pjust;
CharP := Addr(v);
oksetC := okp;
modeC := mode;
END;
Inc(EAntall);
END;
PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := EnumT; xpos := 1; just := pjust;
EnumP := Addr(v);
EnumAntall := antall;
EnumStr := Addr(enum_ar);
END;
Inc(EAntall);
END;
PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : BOOLEAN);
BEGIN
MakeEnum(px,py,plen,pjust,prstr,v,2,BoolStr);
END;
PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : BYTE; min, max : BYTE);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := ByteT; xpos := 1; just := pjust;
ByteP := Addr(v);
ByteMin := min;
ByteMax := max;
END;
Inc(EAntall);
END;
PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := IntT; xpos := 1; just := pjust;
IntP := Addr(v);
IntMin := min;
IntMax := max;
END;
Inc(EAntall);
END;
PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : WORD; min, max : WORD);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := WordT; xpos := 1; just := pjust;
WordP := Addr(v);
WordMin := min;
WordMax := max;
END;
Inc(EAntall);
END;
PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
prstr : PromptStr; VAR v : LongInt; min, max : LongInt);
BEGIN
New(ERec[EAntall]);
WITH ERec[Eantall]^ DO BEGIN
x := px; y := py; len := plen; prompt := prstr;
ftype := LongT; xpos := 1; just := pjust;
LongP := Addr(v);
LongMin := min;
LongMax := max;
END;
Inc(EAntall);
END;
FUNCTION Pad(st:String;len : INTEGER): String;
BEGIN
IF len < 0 THEN BEGIN
len := Lo(-len);
WHILE len > Length(st) DO st := ' ' + st;
END
ELSE IF len > 0 THEN BEGIN
len := Lo(len);
WHILE len > Length(st) DO st := st + ' ';
END;
Pad := st;
END;
(*
FUNCTION Justify(st : String; len : BYTE; just : JustType): String;
VAR front : BOOLEAN;
BEGIN
CASE just OF
LeftJ : Justify := Pad(st,len);
CenterJ : BEGIN
front := FALSE;
WHILE Length(st) < len DO BEGIN
IF front THEN st := ' ' + st
ELSE st := st + ' ';
front := NOT front;
END;
Justify := st;
END;
RightJ : Justify := Pad(st,-len);
END;
END;
*)
FUNCTION Tstr(l : LongInt; len : INTEGER): String;
VAR st : String;
BEGIN
Str(l:len,st);
Tstr := st;
END;
FUNCTION Refresh(len: BYTE; just : JustType; st : String): INTEGER;
VAR front, back, offs : INTEGER;
BEGIN
front := len - Length(st); IF front < 0 THEN front := 0;
CASE just OF
LeftJ : BEGIN back := front; front := 0; END;
RightJ : back := 0;
CenterJ : BEGIN back := (front+1) DIV 2; Dec(front,back); END;
END;
IF front > 0 THEN Write('':front);
Write(st);
IF back > 0 THEN Write('':back);
Refresh := front;
END;
PROCEDURE ShowOne(VAR e : EditRecord);
VAR i : WORD;
l : LongInt;
attr : BYTE;
BEGIN
attr := TextAttr;
GotoXY(e.x,e.y);
Write(e.prompt);
TextAttr := FeltAttr;
CASE e.ftype OF
CharT : IF Refresh(e.len,e.just,e.CharP^) = 0 THEN ;
StrT : IF Refresh(e.len,e.just,e.StrP^) = 0 THEN ;
BoolT,
EnumT : IF Refresh(e.len,e.just,e.EnumStr^[e.EnumP^]) = 0 THEN ;
ByteT : IF Refresh(e.len,e.just,Tstr(e.ByteP^,1)) = 0 THEN ;
IntT : IF Refresh(e.len,e.just,Tstr(e.IntP^,1)) = 0 THEN ;
WordT : IF Refresh(e.len,e.just,Tstr(e.WordP^,1)) = 0 THEN ;
LongT : IF Refresh(e.len,e.just,Tstr(e.LongP^,1)) = 0 THEN ;
END;
TextAttr := attr;
END;
PROCEDURE ShowAll;
VAR i : WORD;
BEGIN
FOR i := 0 TO Eantall-1 DO
ShowOne(ERec[i]^);
END;
FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;
VAR sx, sy : BYTE;
st : String;
cok, ferdig, change, dirty : BOOLEAN;
PROCEDURE Del1; BEGIN Delete(st,xpos,1); Dirty := TRUE; END;
PROCEDURE RefreshStr;
BEGIN
GotoXY(sx,sy);
GotoXY(sx+xpos+Refresh(len,just,st)-1,sy);
Dirty := FALSE;
END;
BEGIN
EditStr := FALSE;
sx := WhereX; sy := WhereY;
st := str;
dirty := TRUE;
ferdig := FALSE;
IF xpos > Length(str)+1 THEN xpos := 1;
REPEAT
IF len <= 1 THEN xpos := 1;
{IF Dirty THEN }RefreshStr;
EditChar := ReadKey;
CASE EditChar OF
#0 : BEGIN
EditChar := ReadKey;
CASE Ord(EditChar) OF
68 : BEGIN
st := str; RefreshStr; Exit;
END;
71 : BEGIN xpos := 1; END;
72,
80 : ferdig := TRUE;
75 : IF xpos > 1 THEN Dec(xpos);
77 : IF xpos <= Length(st) THEN Inc(xpos);
79 : BEGIN xpos := Length(st)+1; END;
82 : InsertMode := NOT InsertMode;
83 : Del1;
$75 : st[0] := Chr(xpos-1); {Ctrl-End}
ELSE
Exit;
END;
END;
^H : IF xpos > 1 THEN BEGIN
Dec(xpos);
Del1;
END;
^M : ferdig := TRUE;
^[ : BEGIN
change := st <> str;
IF change THEN BEGIN st := str; xpos := 1; END;
RefreshStr;
IF NOT change THEN Exit;
END;
#0..#255 :
BEGIN
IF mode AND ToUpper <> 0 THEN EditChar := UpCase(EditChar)
ELSE IF mode AND ToLower <> 0 THEN EditChar := LoCase(EditChar);
cok := mode AND NoInput = 0;
IF (ok <> NIL) AND cok THEN cok := EditChar IN ok^;
IF cok THEN BEGIN
IF InsertMode THEN BEGIN
IF Length(st) < len THEN BEGIN
Insert(EditChar,st,xpos);
Inc(xpos);
END;
END
ELSE BEGIN
IF xpos <= len THEN BEGIN
IF xpos > Length(st) THEN
st := st + EditChar
ELSE
st[xpos] := EditChar;
Inc(xpos);
END;
END;
Dirty := TRUE;
END;
END;
END;
UNTIL ferdig;
str := st;
EditStr := TRUE;
END;
FUNCTION EditNum(VAR e : EditRecord): BOOLEAN;
VAR feil, sx, sy : WORD;
st : String;
num : LongInt;
BEGIN
EditNum:= FALSE;
sx := WhereX; sy := WhereY;
CASE e.ftype OF
ByteT : num := e.ByteP^;
IntT : num := e.IntP^;
WordT : num := e.WordP^;
LongT : num := e.LongP^;
END;
REPEAT
GotoXY(sx,sy);
Str(num:1,st);
e.xpos := 1;
IF NOT EditStr(st,e.xpos,e.len,0,Addr(NumericSet),e.just) THEN Exit;
Val(st,num,feil);
IF feil = 0 THEN BEGIN
feil := 1;
IF num < e.LongMin THEN
num := e.LongMin
ELSE IF num > e.LongMax THEN
num := e.LongMax
ELSE
feil := 0;
END;
UNTIL feil = 0;
EditNum := TRUE;
CASE e.ftype OF
ByteT : e.ByteP^ := num;
IntT : e.IntP^ := num;
WordT : e.WordP^ := num;
LongT : e.LongP^ := num;
END;
END;
FUNCTION EditEnum(VAR en; max : WORD; len : BYTE; just : JustType;
VAR enstr : FeltStrArray): BOOLEAN;
VAR e : BYTE ABSOLUTE en;
b : BYTE;
sx, sy : WORD;
BEGIN
b := e;
sx := WhereX; sy := WhereY;
EditEnum := TRUE;
REPEAT
GotoXY(sx,sy);
IF Refresh(len,just,enstr[b]) = 0 THEN ;
GotoXY(sx,sy);
EditChar := ReadKey;
CASE EditChar OF
#0 :
BEGIN
EditChar := ReadKey;
CASE Ord(EditChar) OF
68 : BEGIN EditEnum := FALSE; Exit; END;
71 : b := 0;
72,
80 : BEGIN e := b; Exit; END;
75 : b := Succ(b) MOD max;
77 : b := Pred(b+max) MOD max;
79 : b := max-1;
ELSE BEGIN
e := b;
Exit;
END;
END;
END;
^M : BEGIN e := b; Exit; END;
^[ : IF e <> b THEN b := e
ELSE BEGIN EditEnum := FALSE; Exit; END;
' ': b := Succ(b) MOD max;
END;
UNTIL FALSE;
END;
PROCEDURE EditOne(VAR e : EditRecord);
VAR res : BOOLEAN;
attr : BYTE;
st : String;
BEGIN
attr := TextAttr;
WITH e DO BEGIN
GotoXY(x,y); Write(prompt);
TextAttr := EditAttr;
CASE ftype OF
CharT : BEGIN
st := CharP^;
res := EditStr(st,xpos,len,modeC,oksetC,just);
IF res AND (Length(st) = 1) THEN CharP^ := st[1];
END;
StrT : res := EditStr(StrP^,xpos,len,modeS,oksetS,just);
BoolT,
EnumT : res := EditEnum(EnumP^,EnumAntall,len,just,EnumStr^);
ByteT,
IntT,
WordT,
LongT : res := EditNum(e);
END;
END;
TextAttr := attr;
ShowOne(e);
END;
PROCEDURE EditVar(VAR v);
VAR i : INTEGER;
BEGIN
FOR i := 0 TO EAntall-1 DO BEGIN
IF Addr(v) = Erec[i]^.StrP THEN EditOne(Erec[i]^);
Inc(i);
END;
END;
PROCEDURE EditARecord(n : WORD);
BEGIN
IF n < Eantall THEN EditOne(Erec[n]^);
END;
PROCEDURE EditAllRecords;
BEGIN
REPEAT
EditARecord(LastRecord);
Case EditChar OF
#80 : LastRecord := Succ(LastRecord) MOD Eantall;
#72 : LastRecord := Pred(LastRecord + Eantall) MOD Eantall;
ELSE
Exit;
END;
UNTIL EditChar = #27;
END;
END.