[Back to ENTRY SWAG index]  [Back to Main SWAG index]  [Original]

{ code to allow input of strings that are wider than the crt or
  the current window.  Will scroll the window to allow continued input

This is for entering large strings in a smaller
screen (do you have a monitor that's 255 chars wide???). In any case, I'll
give it to you now. So long as you make the viewport larger than the
length limit of the string, you will have no scrolling and no problem. I
will simply have to fix the scrolling later. Modify as you wish, you may
find it useful. CRT.TPU is required. }


uses crt;
const     ksins = 128; {insert mode on}
var       kbshift :    byte absolute $40:$17; {shift key status}
Function Getkey:word;
assembler; asm
 xor ah,ah
 int $16
end;
Procedure Beep(Hz,Ms:word);
begin
 sound(hz);
 delay(ms);
 nosound;
end;
function edstr(var instring;x,y,viewport,color,limit:byte):boolean;
var
 wmax,wmin:word;
 showpos,xmax,ymax,editpos,viewpos,oldx,oldy,oldcolor:byte;
 update,insmode:boolean;
 editstr:string absolute instring;
 key:record
  ch,scan:byte;
 end;
begin
  wmax:=windmax; {store window}
  wmin:=windmin; {store window}
  oldcolor:=textattr; {store color}
  oldx:=wherex; {store cursor}
  oldy:=wherey; {store cursor}
  window(1,1,80,25);
  window(1,1,80,50);
  xmax:=windmax and 255 + 1;
  ymax:=windmax shr 8 + 1;
  {verify viewport dimensions}
  if (y<=ymax) and (x+viewport-1<=xmax) and (viewport<>0) then begin
  edstr:=true;
  window(x,y,x+viewport-1,y); {set window}
  textattr:=color; {set new color}
  viewpos:=1; {init view pos}
  editpos:=1; {init edit pos}
  clrscr; {clear window}
  kbshift:=kbshift or ksins; {force insert}
  update:=true;
  if editstr[0]>char(limit) then editstr[0]:=char(limit);
  repeat {loop until Enter pressed}
   {update display}
   if update then begin
    gotoxy(1,1);
    inc(windmax); {prevents CRT scrolling}
    showpos:=viewpos;
    while (showpos<=length(editstr)) and (showpos<=viewpos+viewport-1) do
    begin
     write(editstr[showpos]);
     inc(showpos);
    end;
    dec(windmax); {restore window after temporary anti-scroll}
    clreol;
   end;
   update:=true;
   gotoxy((editpos-1) mod viewport+1,1); {proper cursor edit pos}
   word(key):=getkey; {get key}
   insmode:=kbshift and ksins<>0; {check insert mode}
   {if insert then flat cursor else block cursor}
   case key.ch of {check key char}
    0:case key.scan of {check key scan code}
     $47:editpos:=1; {home}
     $4B:if editpos<>1 then dec(editpos); {left}
     $4D:if (editpos<>limit) and (editpos<>length(editstr)+1) then
         inc(editpos); {right}
     $4F:if length(editstr)=limit then editpos:=limit
         else editpos:=length(editstr)+1; {end}
     $53:delete(editstr,editpos,1); {del}
     $77:{^Home, del till start of line}
         begin
          delete(editstr,1,editpos-1);
          editpos:=1;
         end;
     $75:delete(editstr,editpos,255); {^End, del till end of line}
     $73:{^Left, seek word left}
         if editpos=1 then update:=false
         else repeat
          dec(editpos);
         until (editpos=1) or (editstr[editpos-1]=' ');
     $74:{^Right, seek word right}
         if (editpos=limit) or (editpos=length(editstr)+1) then
          update:=false
         else repeat
          inc(editpos);
         until (editstr[editpos-1]=' ') or (editpos=limit)
          or (editpos=length(editstr)+1);
     else update:=false; {do not waste time updating screen}
    end; {check key scan code}
    8:if editpos>1 then begin {backspace}
     dec(editpos);
     delete(editstr,editpos,1);
    end
    else update:=false;
    32..255:begin {valid chars}
     if insmode or (length(editstr)+1=editpos) then
      {inserted if using insert mode OR if overstrike AND at string end}
      if (length(editstr)<>limit) then insert(char(key.ch),editstr,editpos)
      else beep(5000,10) {error: string full}
     else editstr[editpos]:=char(key.ch); {overstrike char}
     if editpos<>limit then inc(editpos); {inc pos within limit}
    end; {valid chars}
    else update:=false; {do not waste time updating screen}
   end; {check key char}

   {update scroll window}
   while editpos<viewpos do dec(viewpos,viewport); {left}
   while editpos>=viewpos+viewport do inc(viewpos,viewport); {right}
  until key.ch=13; {enter ends loop/input}
  textattr:=oldcolor; {minimal screen clean up}
  clrscr;
 end {valid viewport}
 else edstr:=false; {invalid viewport}
 windmin:=wmin; {restore window}
 windmax:=wmax; {restore window}
 textattr:=oldcolor; {restore color}
 gotoxy(oldx,oldy); {restore cursor}
end; {edstr}

VAR
     aStr : STRING;

BEGIN
    IF edstr(aStr,   { the value to edit }
             10,     { Col (x) }
             10,     { Row (y) }
             50,     { window width max }
             31,     { input color }
             100)    { maximum length of input }
         THEN WriteLn(aStr);
END.

[Back to ENTRY SWAG index]  [Back to Main SWAG index]  [Original]