home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / tpdoskermit / feltedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2020-01-01  |  14.2 KB  |  561 lines
  1. $R-,S-,D+,T+,F-,V+,B-
  2.  
  3. Unit FeltEdit;
  4.  
  5. Interface
  6.  
  7. Uses Crt;
  8.  
  9. CONST
  10.   ToUpper  = 1;
  11.   ToLower  = 2;
  12.   NoInput  = 4;
  13.  
  14. TYPE
  15.   CharSet = SET OF CHAR;
  16.   CharSetPtr = ^CharSet;
  17.   JustType = (LeftJ,CenterJ,RightJ);
  18.   FeltStr = STRING[12];
  19.   PromptStr = STRING[30];
  20.   FeltStrArray = ARRAY [0..255] OF FeltStr;
  21.   FeltType = (CharT, StrT, EnumT, BoolT, ByteT, IntT, WordT, LongT);
  22.   EditPtr = ^EditRecord;
  23.   EditRecord = RECORD
  24.                  x, y, len, xpos : BYTE;
  25.                  just : JustType;
  26.                  prompt : PromptStr;
  27.                  CASE ftype : FeltType OF
  28.                    CharT : (CharP : ^CHAR;
  29.                             oksetC : CharSetPtr;
  30.                             modeC : BYTE);
  31.                    StrT  : (StrP : ^STRING;
  32.                             oksetS : CharSetPtr;
  33.                             modeS : BYTE);
  34.                    EnumT,
  35.                    BoolT : (EnumP : ^BYTE;
  36.                             EnumAntall : BYTE;
  37.                             EnumStr : ^FeltStrArray);
  38.                    ByteT : (ByteP : ^BYTE;
  39.                             ByteMin, ByteMax : LongInt);
  40.                    IntT  : (IntP  : ^INTEGER;
  41.                             IntMin, IntMax   : LongInt);
  42.                    WordT : (WordP : ^WORD;
  43.                             WordMin, WordMax : LongInt);
  44.                    LongT : (LongP : ^LongInt;
  45.                             LongMin, LongMax : LongInt);
  46.                END;
  47.  
  48. CONST
  49.   Eantall : WORD = 0;
  50.   BoolStr : ARRAY [0..1] OF FeltStr = ('FALSE','TRUE');
  51.   NumericSet : CharSet = ['0'..'9','.','+','-'];
  52.   InsertMode : BOOLEAN = FALSE;
  53.   LastRecord : WORD = 0;
  54.   FeltAttr : BYTE =  14;
  55.   EditAttr : BYTE = 112;
  56.  
  57. CONST
  58.   EditChar : CHAR = #255;
  59.  
  60. FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
  61.                  len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;
  62.  
  63. FUNCTION Pad(st:String;len : INTEGER): String;
  64.  
  65. FUNCTION Tstr(l : LongInt; len : INTEGER): String;
  66.  
  67. PROCEDURE ShowOne(VAR e : EditRecord);
  68.  
  69. PROCEDURE ShowAll;
  70.  
  71. PROCEDURE EditOne(VAR e : EditRecord);
  72.  
  73. PROCEDURE EditARecord(n : WORD);
  74.  
  75. FUNCTION UpCase(ch : CHAR): CHAR;
  76.  
  77. FUNCTION LoCase(ch : CHAR): CHAR;
  78.  
  79. PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
  80.                   prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);
  81.  
  82. PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
  83.                   prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);
  84.  
  85. PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
  86.                   prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);
  87.  
  88. PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
  89.                   prstr : PromptStr; VAR v : BOOLEAN);
  90.  
  91. PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
  92.                   prstr : PromptStr; VAR v : BYTE; min, max : BYTE);
  93.  
  94. PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
  95.                   prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);
  96.  
  97. PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
  98.                   prstr : PromptStr; VAR v : WORD; min, max : WORD);
  99.  
  100. PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
  101.                   prstr : PromptStr; VAR v : LongInt; min, max : LongInt);
  102.  
  103. PROCEDURE EditAllRecords;
  104.  
  105. PROCEDURE EditVar(VAR v);
  106.  
  107. (**************************************************************************)
  108.  
  109. Implementation
  110.  
  111. VAR
  112.   ERec : ARRAY [0..255] OF EditPtr;
  113.  
  114. CONST No_Upper : String[3] = '';
  115.       No_Lower : String[3] = '';
  116.  
  117. FUNCTION UpCase(ch : CHAR): CHAR;
  118. VAR p : INTEGER;
  119. BEGIN
  120.   IF (ch >= 'a') AND (ch <= 'z') THEN ch := CHAR(BYTE(ch)-32)
  121.   ELSE BEGIN
  122.     p := Pos(ch,No_Lower);
  123.     IF p > 0 THEN ch := No_Upper[p];
  124.   END;
  125.   UpCase := ch;
  126. END;
  127.  
  128. FUNCTION LoCase(ch : CHAR): CHAR;
  129. VAR p : INTEGER;
  130. BEGIN
  131.   IF (ch >= 'A') AND (ch <= 'Z') THEN ch := CHAR(BYTE(ch)+32)
  132.   ELSE BEGIN
  133.     p := Pos(ch,No_Upper);
  134.     IF p > 0 THEN ch := No_Lower[p];
  135.   END;
  136.   LoCase := ch;
  137. END;
  138.  
  139. PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
  140.                   prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);
  141. BEGIN
  142.   New(ERec[EAntall]);
  143.  
  144.   WITH ERec[Eantall]^ DO BEGIN
  145.     x := px; y := py; len := plen; prompt := prstr;
  146.     ftype := StrT; xpos := 1; just := pjust;
  147.     StrP := Addr(v);
  148.     oksetS := okp;
  149.     modeS := mode;
  150.   END;
  151.   Inc(EAntall);
  152. END;
  153.  
  154. PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
  155.                   prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);
  156. BEGIN
  157.   New(ERec[EAntall]);
  158.  
  159.   WITH ERec[Eantall]^ DO BEGIN
  160.     x := px; y := py; len := plen; prompt := prstr;
  161.     ftype := CharT; xpos := 1; just := pjust;
  162.     CharP := Addr(v);
  163.     oksetC := okp;
  164.     modeC := mode;
  165.   END;
  166.   Inc(EAntall);
  167. END;
  168.  
  169. PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
  170.                   prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);
  171. BEGIN
  172.   New(ERec[EAntall]);
  173.  
  174.   WITH ERec[Eantall]^ DO BEGIN
  175.     x := px; y := py; len := plen; prompt := prstr;
  176.     ftype := EnumT; xpos := 1; just := pjust;
  177.     EnumP := Addr(v);
  178.     EnumAntall := antall;
  179.     EnumStr := Addr(enum_ar);
  180.   END;
  181.   Inc(EAntall);
  182. END;
  183.  
  184. PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
  185.                   prstr : PromptStr; VAR v : BOOLEAN);
  186. BEGIN
  187.   MakeEnum(px,py,plen,pjust,prstr,v,2,BoolStr);
  188. END;
  189.  
  190. PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
  191.                   prstr : PromptStr; VAR v : BYTE; min, max : BYTE);
  192. BEGIN
  193.   New(ERec[EAntall]);
  194.  
  195.   WITH ERec[Eantall]^ DO BEGIN
  196.     x := px; y := py; len := plen; prompt := prstr;
  197.     ftype := ByteT; xpos := 1; just := pjust;
  198.     ByteP := Addr(v);
  199.     ByteMin := min;
  200.     ByteMax := max;
  201.   END;
  202.   Inc(EAntall);
  203. END;
  204.  
  205. PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
  206.                   prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);
  207. BEGIN
  208.   New(ERec[EAntall]);
  209.  
  210.   WITH ERec[Eantall]^ DO BEGIN
  211.     x := px; y := py; len := plen; prompt := prstr;
  212.     ftype := IntT; xpos := 1; just := pjust;
  213.     IntP := Addr(v);
  214.     IntMin := min;
  215.     IntMax := max;
  216.   END;
  217.   Inc(EAntall);
  218. END;
  219.  
  220. PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
  221.                   prstr : PromptStr; VAR v : WORD; min, max : WORD);
  222. BEGIN
  223.   New(ERec[EAntall]);
  224.  
  225.   WITH ERec[Eantall]^ DO BEGIN
  226.     x := px; y := py; len := plen; prompt := prstr;
  227.     ftype := WordT; xpos := 1; just := pjust;
  228.     WordP := Addr(v);
  229.     WordMin := min;
  230.     WordMax := max;
  231.   END;
  232.   Inc(EAntall);
  233. END;
  234.  
  235. PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
  236.                   prstr : PromptStr; VAR v : LongInt; min, max : LongInt);
  237. BEGIN
  238.   New(ERec[EAntall]);
  239.  
  240.   WITH ERec[Eantall]^ DO BEGIN
  241.     x := px; y := py; len := plen; prompt := prstr;
  242.     ftype := LongT; xpos := 1; just := pjust;
  243.     LongP := Addr(v);
  244.     LongMin := min;
  245.     LongMax := max;
  246.   END;
  247.   Inc(EAntall);
  248. END;
  249.  
  250. FUNCTION Pad(st:String;len : INTEGER): String;
  251. BEGIN
  252.   IF len < 0 THEN BEGIN
  253.     len := Lo(-len);
  254.     WHILE len > Length(st) DO st := ' ' + st;
  255.   END
  256.   ELSE IF len > 0 THEN BEGIN
  257.     len := Lo(len);
  258.     WHILE len > Length(st) DO st := st + ' ';
  259.   END;
  260.   Pad := st;
  261. END;
  262.  
  263. (*
  264. FUNCTION Justify(st : String; len : BYTE; just : JustType): String;
  265. VAR front : BOOLEAN;
  266. BEGIN
  267.   CASE just OF
  268.     LeftJ   : Justify := Pad(st,len);
  269.     CenterJ : BEGIN
  270.                 front := FALSE;
  271.                 WHILE Length(st) < len DO BEGIN
  272.                   IF front THEN st := ' ' + st
  273.                   ELSE st := st + ' ';
  274.                   front := NOT front;
  275.                 END;
  276.                 Justify := st;
  277.               END;
  278.     RightJ  : Justify := Pad(st,-len);
  279.   END;
  280. END;
  281. *)
  282.  
  283. FUNCTION Tstr(l : LongInt; len : INTEGER): String;
  284. VAR st : String;
  285. BEGIN
  286.   Str(l:len,st);
  287.   Tstr := st;
  288. END;
  289.  
  290. FUNCTION Refresh(len: BYTE; just : JustType; st : String): INTEGER;
  291. VAR front, back, offs : INTEGER;
  292. BEGIN
  293.   front := len - Length(st); IF front < 0 THEN front := 0;
  294.   CASE just OF
  295.     LeftJ   : BEGIN back := front; front := 0; END;
  296.     RightJ  : back := 0;
  297.     CenterJ : BEGIN back := (front+1) DIV 2; Dec(front,back); END;
  298.   END;
  299.   IF front > 0 THEN Write('':front);
  300.   Write(st);
  301.   IF back > 0 THEN Write('':back);
  302.   Refresh := front;
  303. END;
  304.  
  305. PROCEDURE ShowOne(VAR e : EditRecord);
  306. VAR i : WORD;
  307.     l : LongInt;
  308.     attr : BYTE;
  309. BEGIN
  310.   attr := TextAttr;
  311.   GotoXY(e.x,e.y);
  312.   Write(e.prompt);
  313.   TextAttr := FeltAttr;
  314.   CASE e.ftype OF
  315.     CharT : IF Refresh(e.len,e.just,e.CharP^) = 0 THEN ;
  316.     StrT  : IF Refresh(e.len,e.just,e.StrP^) = 0 THEN ;
  317.     BoolT,
  318.     EnumT : IF Refresh(e.len,e.just,e.EnumStr^[e.EnumP^]) = 0 THEN ;
  319.     ByteT : IF Refresh(e.len,e.just,Tstr(e.ByteP^,1)) = 0 THEN ;
  320.     IntT  : IF Refresh(e.len,e.just,Tstr(e.IntP^,1)) = 0 THEN ;
  321.     WordT : IF Refresh(e.len,e.just,Tstr(e.WordP^,1)) = 0 THEN ;
  322.     LongT : IF Refresh(e.len,e.just,Tstr(e.LongP^,1)) = 0 THEN ;
  323.   END;
  324.   TextAttr := attr;
  325. END;
  326.  
  327. PROCEDURE ShowAll;
  328. VAR i : WORD;
  329. BEGIN
  330.   FOR i := 0 TO Eantall-1 DO
  331.     ShowOne(ERec[i]^);
  332. END;
  333.  
  334. FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
  335.                  len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;
  336. VAR sx, sy : BYTE;
  337.     st : String;
  338.     cok, ferdig, change, dirty : BOOLEAN;
  339.  
  340. PROCEDURE Del1; BEGIN Delete(st,xpos,1); Dirty := TRUE; END;
  341.  
  342. PROCEDURE RefreshStr;
  343. BEGIN
  344.   GotoXY(sx,sy);
  345.   GotoXY(sx+xpos+Refresh(len,just,st)-1,sy);
  346.   Dirty := FALSE;
  347. END;
  348.  
  349. BEGIN
  350.   EditStr := FALSE;
  351.   sx := WhereX; sy := WhereY;
  352.   st := str;
  353.   dirty := TRUE;
  354.   ferdig := FALSE;
  355.   IF xpos > Length(str)+1 THEN xpos := 1;
  356.   REPEAT
  357.     IF len <= 1 THEN xpos := 1;
  358.     {IF Dirty THEN }RefreshStr;
  359.  
  360.     EditChar := ReadKey;
  361.     CASE EditChar OF
  362.         #0 : BEGIN
  363.                EditChar := ReadKey;
  364.                CASE Ord(EditChar) OF
  365.                  68 : BEGIN
  366.                         st := str; RefreshStr; Exit;
  367.                       END;
  368.                  71 : BEGIN xpos := 1; END;
  369.                  72,
  370.                  80 : ferdig := TRUE;
  371.                  75 : IF xpos > 1 THEN Dec(xpos);
  372.                  77 : IF xpos <= Length(st) THEN Inc(xpos);
  373.                  79 : BEGIN xpos := Length(st)+1; END;
  374.                  82 : InsertMode := NOT InsertMode;
  375.                  83 : Del1;
  376.                 $75 : st[0] := Chr(xpos-1);    {Ctrl-End}
  377.                  ELSE
  378.                    Exit;
  379.                END;
  380.              END;
  381.         ^H : IF xpos > 1 THEN BEGIN
  382.                Dec(xpos);
  383.                Del1;
  384.              END;
  385.         ^M : ferdig := TRUE;
  386.         ^[ : BEGIN
  387.                change := st <> str;
  388.                IF change THEN BEGIN st := str; xpos := 1; END;
  389.                RefreshStr;
  390.                IF NOT change THEN Exit;
  391.              END;
  392.         #0..#255 :
  393.          BEGIN
  394.            IF mode AND ToUpper <> 0 THEN EditChar := UpCase(EditChar)
  395.            ELSE IF mode AND ToLower <> 0 THEN EditChar := LoCase(EditChar);
  396.  
  397.            cok := mode AND NoInput = 0;
  398.            IF (ok <> NIL) AND cok THEN cok := EditChar IN ok^;
  399.  
  400.            IF cok THEN BEGIN
  401.              IF InsertMode THEN BEGIN
  402.                IF Length(st) < len THEN BEGIN
  403.                  Insert(EditChar,st,xpos);
  404.                  Inc(xpos);
  405.                END;
  406.              END
  407.              ELSE BEGIN
  408.                IF xpos <= len THEN BEGIN
  409.                  IF xpos > Length(st) THEN
  410.                    st := st + EditChar
  411.                  ELSE
  412.                    st[xpos] := EditChar;
  413.                  Inc(xpos);
  414.                END;
  415.              END;
  416.              Dirty := TRUE;
  417.            END;
  418.          END;
  419.     END;
  420.   UNTIL ferdig;
  421.   str := st;
  422.   EditStr := TRUE;
  423. END;
  424.  
  425. FUNCTION EditNum(VAR e : EditRecord): BOOLEAN;
  426. VAR feil, sx, sy : WORD;
  427.     st : String;
  428.     num : LongInt;
  429. BEGIN
  430.   EditNum:= FALSE;
  431.   sx := WhereX; sy := WhereY;
  432.   CASE e.ftype OF
  433.     ByteT : num := e.ByteP^;
  434.     IntT  : num := e.IntP^;
  435.     WordT : num := e.WordP^;
  436.     LongT : num := e.LongP^;
  437.   END;
  438.  
  439.   REPEAT
  440.     GotoXY(sx,sy);
  441.     Str(num:1,st);
  442.     e.xpos := 1;
  443.     IF NOT EditStr(st,e.xpos,e.len,0,Addr(NumericSet),e.just) THEN Exit;
  444.     Val(st,num,feil);
  445.     IF feil = 0 THEN BEGIN
  446.       feil := 1;
  447.       IF num < e.LongMin THEN
  448.         num := e.LongMin
  449.       ELSE IF num > e.LongMax THEN
  450.         num := e.LongMax
  451.       ELSE
  452.         feil := 0;
  453.     END;
  454.   UNTIL feil = 0;
  455.   EditNum := TRUE;
  456.   CASE e.ftype OF
  457.     ByteT : e.ByteP^ := num;
  458.     IntT  : e.IntP^  := num;
  459.     WordT : e.WordP^ := num;
  460.     LongT : e.LongP^ := num;
  461.   END;
  462. END;
  463.  
  464. FUNCTION EditEnum(VAR en; max : WORD; len : BYTE; just : JustType;
  465.          VAR enstr : FeltStrArray): BOOLEAN;
  466. VAR e : BYTE ABSOLUTE en;
  467.     b : BYTE;
  468.     sx, sy : WORD;
  469. BEGIN
  470.   b := e;
  471.   sx := WhereX; sy := WhereY;
  472.   EditEnum := TRUE;
  473.  
  474.   REPEAT
  475.     GotoXY(sx,sy);
  476.     IF Refresh(len,just,enstr[b]) = 0 THEN ;
  477.     GotoXY(sx,sy);
  478.     EditChar := ReadKey;
  479.     CASE EditChar OF
  480.       #0 :
  481.         BEGIN
  482.           EditChar := ReadKey;
  483.           CASE Ord(EditChar) OF
  484.             68 : BEGIN EditEnum := FALSE; Exit; END;
  485.             71 : b := 0;
  486.             72,
  487.             80 : BEGIN e := b; Exit; END;
  488.             75 : b := Succ(b) MOD max;
  489.             77 : b := Pred(b+max) MOD max;
  490.             79 : b := max-1;
  491.             ELSE BEGIN
  492.               e := b;
  493.               Exit;
  494.             END;
  495.           END;
  496.         END;
  497.       ^M : BEGIN e := b; Exit; END;
  498.       ^[ : IF e <> b THEN b := e
  499.            ELSE BEGIN EditEnum := FALSE; Exit; END;
  500.       ' ': b := Succ(b) MOD max;
  501.     END;
  502.   UNTIL FALSE;
  503. END;
  504.  
  505. PROCEDURE EditOne(VAR e : EditRecord);
  506. VAR res : BOOLEAN;
  507.     attr : BYTE;
  508.     st : String;
  509. BEGIN
  510.   attr := TextAttr;
  511.   WITH e DO BEGIN
  512.     GotoXY(x,y); Write(prompt);
  513.     TextAttr := EditAttr;
  514.     CASE ftype OF
  515.       CharT : BEGIN
  516.                 st := CharP^;
  517.                 res := EditStr(st,xpos,len,modeC,oksetC,just);
  518.                 IF res AND (Length(st) = 1) THEN CharP^ := st[1];
  519.               END;
  520.       StrT  : res := EditStr(StrP^,xpos,len,modeS,oksetS,just);
  521.       BoolT,
  522.       EnumT : res := EditEnum(EnumP^,EnumAntall,len,just,EnumStr^);
  523.       ByteT,
  524.       IntT,
  525.       WordT,
  526.       LongT : res := EditNum(e);
  527.     END;
  528.   END;
  529.   TextAttr := attr;
  530.   ShowOne(e);
  531. END;
  532.  
  533. PROCEDURE EditVar(VAR v);
  534. VAR i : INTEGER;
  535. BEGIN
  536.   FOR i := 0 TO EAntall-1 DO BEGIN
  537.     IF Addr(v) = Erec[i]^.StrP THEN EditOne(Erec[i]^);
  538.     Inc(i);
  539.   END;
  540. END;
  541.  
  542. PROCEDURE EditARecord(n : WORD);
  543. BEGIN
  544.   IF n < Eantall THEN EditOne(Erec[n]^);
  545. END;
  546.  
  547. PROCEDURE EditAllRecords;
  548. BEGIN
  549.   REPEAT
  550.     EditARecord(LastRecord);
  551.     Case EditChar OF
  552.       #80 : LastRecord := Succ(LastRecord) MOD Eantall;
  553.       #72 : LastRecord := Pred(LastRecord + Eantall) MOD Eantall;
  554.     ELSE
  555.       Exit;
  556.     END;
  557.   UNTIL EditChar = #27;
  558. END;
  559.  
  560. END.
  561.