PC-X 1997 October/pcx14_9710.iso/swag/textedit.swg/0016_EDITLINE Unit.pas

Pascal/Delphi Source File | 1997-08-30 | 12.5 KB | 455 lines

Unit EditLine;
{$O+,F+}

interface

Const CrLf:string[2]=#13+#10;


Type EditorFuncFlagsType = set of (Ins,Caps,EchoDots);
     EditorExitType = (Up,Down,Enter,Tab,Esc);
     EditorExitAllowType = Set of EditorExitType;

     WriteType = Procedure (s:string);
     movexType = Procedure (x:integer);
     WhereXType = Function:byte;
     TextColorType = Procedure(c:byte);
     TextBackgroundtype = procedure(c:byte);
     ReadKeyType = function(var extend:char):char;
     GotoXYType = procedure(x,y:byte);
     ClrEolType = Procedure;

Type
 pLineEditObj = ^LineEditObj;
 LineEditObj = object
   Constructor Init(sx,sy,MLen,fg,bg,abarcolor_:byte;
               ansi_:boolean;
               instr:string;
               edf:editorfuncflagstype;
               exf:editorexitallowtype;
               Write_:WriteType;
               movex_:movextype;
               WhereX_:WhereXType;
               textcolor_:textcolortype;
               textbackground_:textbackgroundtype;
               readkey_:readkeytype;
               gotoxy_:gotoxytype;
               ClrEol_:ClrEolType;
               pstr_:string;
               psmlen_:byte;
               psc_:byte);

   Procedure AnsiPrompt;
   Function Edit: EditorExitType;
   Procedure NonAnsiPrompt;
   Function Answer:string;
   Procedure AntiBar(f:boolean);
   Destructor Done;
   Private
       startx,starty,MaxLen,FGc,BGc,abarcolor:byte;
       ansi: boolean;
       EditFlags:EditorFuncFlagsType;
       ExitFlags:EditorExitAllowType;
       movex:movextype;
       write:writetype;
       wherex:wherextype;
       textcolor:textcolortype;
       textbackground:textbackgroundtype;
       gotoxy:gotoxytype;
       readkey:readkeytype;
       clreol:clreoltype;
       s:string;
       pstr:string;
       psmlen:byte;
       psc:byte;
   end;


implementation

uses etc;

Constructor LineEditObj.Init(sx,sy,MLen,fg,bg,abarcolor_:byte;
               ansi_:boolean;
               instr:string;
               edf:editorfuncflagstype;
               exf:editorexitallowtype;
               Write_:WriteType;
               movex_:movexType;
               WhereX_:WhereXType;
               textcolor_:textcolortype;
               textbackground_:textbackgroundtype;
               readkey_:readkeytype;
               gotoxy_:gotoxytype;
               clreol_:clreoltype;
               pstr_:string;
               psmlen_:byte;
               psc_:byte);
 begin
 clreol:=clreol_;
 MaxLen:=mlen;
 abarcolor:=abarcolor_;

 psc:=psc_;

 psmlen:=psmlen_;

 fgc:=fg;
 bgc:=bg;
 ansi:=ansi_;
 EditFlags:=edf;
 ExitFlags:=exf;

 movex:=movex_;
 write:=write_;
 wherex:=wherex_;

 textcolor:=textcolor_;
 textbackground:=textbackground_;

 gotoxy:=gotoxy_;

 readkey:=readkey_;
 pstr:=pstr_;

 startx:=sx;
 starty:=sy;

 s:=instr;
 end;

Procedure LineEditObj.NonAnsiPrompt;
 begin
 write(crlf+crlf);
 write(pstr+crlf)
 end;

procedure LineEditObj.AnsiPrompt;
 begin

 gotoxy(startx,starty);
 textcolor(psc);
 write(rjustify(pstr,psmlen)+' ');

 end;

procedure LineEditObj.AntiBar(f:boolean);
 var i:word;
 begin
 if not(f) or ((not(abarcolor=fgc)) and (not(bgc=0))) then
   begin
   textcolor(abarcolor);
   textbackground(0);
   if ((startx>0) and (starty>0)) then gotoxy(startx+psmlen+1,starty);
   write(' ');

   if echodots in editflags then
     begin
     for i:=1 to length(s) do write('.');
     end
   else
    write(s);

   clreol;
   end;
 end;

destructor LineEditObj.Done;
 begin
 end;

function LineEditObj.answer:string;
 begin
 answer := s;
 end;

Function LineEditObj.Edit:EditorExitType;
   var
       extended: char;
       tempkey : char;
       done_   : boolean;
       index   : byte;
       answ    : string;
       baseX   : byte;
       i       : byte;
       insmode : boolean;
  stringtempkey: string[1];

   begin
   if ansi then if ((startx>0) and (starty>0))
       then gotoxy(startx+psmlen+1,starty);

   InsMode:= (Ins in EditFlags);

   done_ := false;
   index := 0;
   answ := '';
   if length(s) <> 0 then
      begin
      answ := s;
      index := length(s);
      end;

   if ansi then begin
   TextColor(fgc);
   TextBackground(bgc);
   end;

   write(' ');
   if echodots in editflags then
    begin
    for i:=1 to length(s) do write('.')
    end
   else Write(s);

   if ANSI and (not(fgc=abarcolor) or not(bgc=0)) then
     begin
     for i:=length(s)+1 to maxlen+1 do Write(' ');
     movex(-maxlen+length(answ)-1);
     end;

   { functions ... backspace, right, left, overwrite mode for L, R }
   {               enter, delete                                   }

   repeat
      tempkey := readkey(extended);
      case tempkey of
        ^U: if ansi then
               begin
               answ:=s;
               movex(-index);
               if echodots in editflags then
                 begin
                 for i:=1 to length(answ) do write('.')
                 end
               else Write(answ);
               for i:=length(answ)+1 to maxlen do write(' ');
               index:=length(answ);
               movex(-maxlen+length(answ));
               end
            else
               begin
               for i:=1 to length(answ) do write(#8+' '+#8);
               answ:=s;
               if echodots in editflags then
                 begin
                 for i:=1 to length(answ) do write('.')
                 end
               else Write(answ);
               index:=length(answ);
               end;

        #27,^Z: if esc in exitflags then
              begin
              done_:=true;
              edit:=esc;
              end;

        #09: if ansi and (tab in exitflags) then
              begin
              done_:=true;
              edit:=tab;
              end;


        #32,

             {'A'..'Z', 'a'..'z','0'..'9', ',' , '.':}

             ' '..'~':

             begin
              if ord(answ[0]) < maxlen then
               begin
               inc(index);
               if index <= maxlen then
               begin
               if (Caps in EditFlags) then
   {for upcase} if (answ[index-1] = #32) or (answ[index-1] = #0) then
   {checking}     begin
                  tempkey := upcase(tempkey);
                  end
                else tempkey := lowcase (tempkey);

               if (Insmode) and ansi then
                  begin
                  if ord(answ[0]) < maxlen then
                    begin
                    stringtempkey := tempkey;
                    insert(stringtempkey, answ, index);
                    if (Caps in EditFlags) then answ := CaseStr(answ);
                    if index <> ord(answ[0]) then
                     begin
                     if echodots in editflags then
                      begin
                      for i:=index to length(answ)-index+3 do write('.');
                      write(' ');
                      end
                     else
                      begin
                      write( copy(answ,index,length(answ)-index+1)+' ' );
                      end;
                     movex(-length(answ)-1+index);
                     end
                    else if echodots in editflags then write('.') else Write(tempkey);
                    end;
                  end
               else
                  begin
                  if index < ord(answ[0])+1 then answ[index] := tempkey
                  else answ := answ + tempkey;
                  if echodots in editflags then write('.') else Write(tempkey)
                  end;
               end;
              end;
             end;
        #13: if Enter in ExitFlags then
             begin
             done_ := true;
             edit := Enter;
             end;

        ^V: if (ins in editflags) then insmode := not insmode;

        #8:
             begin

             if (index > 0)  then
              begin
              delete(answ, Index, 1);
              if ANSI then
               begin
               if (index=length(answ)+1) then
                 begin
                 movex(-1);
                 write(' ');
                 movex(-1);
                 end
               else
                 begin
                 movex(-1);
                 if echodots in editflags then
                  begin
                  for i:=index to length(answ)-index+1 do write('.');
                  write(' ');
                  end
                 else
                  write( copy(answ,index,length(answ)-index+1)+' ' );
                 movex(-length(answ)-1+index-1);
                 end;
               end
              else Write(#8+' '+#8);
              dec(index);
              end;
             end;
        #0:                         { test for extended characters }
             begin
             case extended of        { poll for extended part }
               #60:  if ansi then
                      begin
                      answ:=s;
                      movex(-index);
                      if echodots in editflags then
                       begin
                       for i:=1 to length(answ) do write('.');
                       end
                      else
                       Write(answ);

                      for i:=length(answ)+1 to maxlen do write(' ');
                      index:=length(answ);
                      movex(-maxlen+length(answ));
                      end
                     else
                      begin
                      for i:=1 to length(answ) do write(#8+' '+#8);
                      answ:=s;
                      if echodots in editflags then
                       begin
                       for i:=1 to length(answ) do write('.');
                       end
                      else
                       write(answ);
                       index:=length(answ);
                      end;

               #80: if ansi and (down in exitflags) then
                    begin
                    done_:=true;
                    edit:=down;
                    end;

               #72: if ansi and (up in exitflags) then
                    begin
                    done_:=true;
                    edit:=up;
                    end;

               #75:                 { left arrow }
                   begin
                   if ANSI then
                    begin
                    if index >= 1 then
                     begin
                     dec(index);
                     movex(-1);
                     end;
                    end;
                   end;
               #77:                 { right arrow }
                  begin
                  if ANSI then
                   begin
                   if index < ord(answ[0]) then
                     begin
                     inc(index);
                     if echodots in editflags then write('.') else write(answ[index]);
                     end;
                   end;
                  end;
               #71:                 { home }
                  begin
                  if ANSI then
                     begin
                     movex(-index);
                     index:=0;
                     end;
                  end;

               #79: IF ANSI then { end }
                  begin
                  movex(length(answ)-index);
                  index := ord(answ[0]);
                  end;

               #82:      { ins }
                if (ins in editflags) then insmode := not insmode;

               #83:         { del }
                  begin
                  if ANSI then
                    begin
                    delete(answ,index+1,1);
                    If (Caps in EditFlags) then answ := CaseStr(answ);
                    if echodots in editflags then
                     begin
                     for i:=index+1 to length(answ)-index do write('.');
                     write(' ');
                     end
                    else
                     write( copy(answ,index+1,length(answ)-index)+' ' );
                     movex(-length(answ)-1+index);
                     end;
                  end;

               end;                           { end of 'case readkey of' }
             end;                             { end of '#0: begin' }
        end;                                  { end of 'case tempkey of' }
   until done_;
   s := answ;
   end;

end.