Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSUSERIO.INC

Text File | 1987-12-21 | 14.5 KB | 520 lines

{                           MSUSERIO.INC
                               MS 4.0
                Copyright (c) 1985, 87 by Borland International, Inc.         }

  procedure EdDisplayPromptWindow(msg : VarString; Yp : Integer;
                                  OKset : Charset; var Ch : Char;
                                  BoxAttr : BoxType);
    {-Pop up a one line message window, and wait for char in OKset to clear it}
  var
    W : WindowPtr;
    Xp, Wid : Integer;
    CursorState : Boolean;

  begin                      {EdDisplayPromptWindow}
    {Get rid of any status display}
    EdEraseMenuHelp;
    EdWritePromptLine('');

    {Reset Turbo window}
    EdWindow(1, 1, PhyScrCols, PhyscrRows);

    {Center the window in x direction}
    Xp := Pred((80-Length(msg)) shr 1);
    Wid := Length(msg)+2;
    W := EdSetupWindow(Border, Xp, Yp, Pred(Xp+Wid), Yp+2, BoxAttr);
    EdFastWrite(msg, Succ(Yp), Succ(Xp), TextAttr[BoxAttr]);

    {Show the hardware cursor}
    CursorState := SolidCursor;
    SolidCursor := False;
    GoToXY(Xp+Length(msg), Succ(Yp));
    EdSetInsertMode(AskforInsertflag);

    {Wait for a key in OKset}
    repeat
      Ch := EdControlFilter(EdGetAnyChar);
    until Abortcmd or (Ch in OKset);

    {Remove window}
    EdRestoreWindow(W, Xp, Yp, Wid, 3);
    {Restore cursor}
    SolidCursor := CursorState;
    EdSetCursorOff;
    if EdPtrIsNil(CurrMenu) then begin
      {Reposition cursor on screen}
      EdUpdateCursor;
      EdShowMenuHelp;
    end else
      {Turn off hardware cursor}
      EdSetCursor(CursorOff);
  end;                       {EdDisplayPromptWindow}

  function EdYesNo(Prompt : VarString) : Boolean;
    {-Return True for Yes, False for No}
  var
    Ch : Char;
    R : Byte;

  begin                      {EdYesNo}
    if WindowCount <= 0 then
      R := 20
    else begin
      with Curwin^ do
        R := (Firstlineno+Lastlineno-3) shr 1;
      if R < LogtopScr then
        R := LogtopScr
      else if R > LogscrRows-3 then
        R := LogscrRows-3;
    end;
    AbortEnable := True;
    EdDisplayPromptWindow(Prompt, R, [^Y, ^N, #27], Ch, NormalBox);
    EdYesNo := (Ch = ^Y);
    if Ch = #27 then
      AbortCmd := true;
  end;                       {EdYesNo}

  procedure EdErrormsg(Msgno : Integer);
    {-Pop up an error message box, and clear any typeahead keystrokes}
  var
    Ch : Char;
    Row : Integer;

  begin                      {EdErrormsg}
    {Clear keyboard buffer}
    EdClearBuffer;
    {Set error flag to be polled as needed by calling routines}
    Goterror := True;
    {Set up a window, display the message and wait for a key}
    with Curwin^ do
      Row := Pred(Firsttextno+Lineno);
    if Row > LogscrRows-3 then
      Row := LogscrRows-3;
    EdDisplayPromptWindow(
      EdGetMessage(Msgno)+'-'+EdGetMessage(305), Row, [#27], Ch, ErrorBox);
    {Clear keyboard buffer again}
    EdClearBuffer;
    UpdateCursor := True;
    EdZapPromptLine;
  end;                       {EdErrormsg}

  function EdFileerror : Boolean;
    {-Report error during file operation}
  var
    Code : Integer;

  begin                      {EdFileerror}
    Code := EdINT24Result;
    if hi(Code) <> 0 then
      EdErrormsg(128)
    else if Code <> 0 then
      EdErrormsg(Code);
    EdFileerror := (Code <> 0);
  end;                       {EdFileerror}

  procedure EdAskforEditor(Xp, Yp, XSize, Maxlen : Integer;
                           HaveWindow : Boolean;
                           var Rs : VarString);
    {-Perform line editing functions for string input}
  const
    Del = #127;
  var
    Wp : Byte;
    Ws : VarString;
    Ch : Char;
    Quitting, FirstRead : Boolean;

    function EdReadAndConvertChar : Char;
      {-Read a character and convert extended keystrokes to single char}
    const
      WScommands : string[12] = ^@^A^D^F^G^B^E^S^V^X^Y^J;
      EXcommands : string[11] = 'sMtSGOKRwu;';
    var
      Ch : Char;

    begin                    {EdReadAndConvertChar}
      {Wait for a key to enter the typeahead buffer}
      Ch := EdGetAnyChar;
      if Abortcmd then
        Exit;

      if (Ch = Null) then
        {Get extended character}
        {Convert IBM keypad to equivalent control char}
        Ch := WScommands[Succ(Pos(EdGetAnyChar, EXcommands))];

      EdReadAndConvertChar := Ch;
    end;                     {EdReadAndConvertChar}

    procedure EdDisplayString(S : VarString; Start : Byte);
      {-Display the working string starting at position start}
    var
      I, X, Clr : Byte;
      Ch : Char;

    begin                    {EdDisplayString}
      if not(HaveWindow) then
        Exit;
      X := Xp+Start;
      for I := Start to Length(S) do begin
        {Display the string, converting control characters to highlighted uppercase}
        Ch := S[I];
        if Ch < Blank then begin
          Clr := ScreenAttr[MsColor];
          Ch := Chr(Ord(Ch)+64);
        end else
          Clr := ScreenAttr[MnColor];
        EdFastWrite(Ch, Yp, X, Clr);
        Inc(X);
      end;
      {Clear the rest of the line}
      Clr := ScreenAttr[MnColor];
      Ch := Blank;
      while X < Pred(Xp+XSize) do begin
        EdFastWrite(Ch, Yp, X, Clr);
        Inc(X);
      end;
    end;                     {EdDisplayString}

    procedure EdClear(var Ws : VarString; var Wp : Byte);
      {-Clear the working string}

    begin                    {EdClear}
      EdClearString(Ws);
      Wp := 1;
      EdDisplayString(Ws, 1);
      if HaveWindow then
        GoToXY(Xp+Wp, Yp);
    end;                     {EdClear}

    procedure EdInsertCharacter(Ch : Char; var Ws : VarString; var Wp : Byte);
      {-Insert a character into the string}

    begin                    {EdInsertCharacter}
      if Length(Ws) < Maxlen then begin
        if AskforInsertflag then
          Insert(Ch, Ws, Wp)
        else if Wp > Length(Ws) then
          Ws := Ws+Ch
        else
          Ws[Wp] := Ch;
        EdDisplayString(Ws, Wp);
        Inc(Wp);
      end else if not(AskforInsertflag) and (Wp <= Length(Ws)) then begin
        Ws[Wp] := Ch;
        EdDisplayString(Ws, Wp);
      end;
    end;                     {EdInsertCharacter}

  begin                      {EdAskforEditor}

    {Get working copy of the input string}
    Ws := Copy(Rs, 1, Maxlen);
    Wp := Succ(Length(Ws));

    {Display the initial string}
    EdDisplayString(Ws, 1);
    FirstRead := True;
    Quitting := False;

    repeat

      {Update the cursor}
      if HaveWindow then begin
        GoToXY(Xp+Wp, Yp);
        EdSetInsertMode(AskforInsertflag);
      end;

      {Get the next keyboard character}
      Ch := EdReadAndConvertChar;
      if Abortcmd then
        {Get out of here}
        Ch := ^[;

      if FirstRead then begin
        if (Ch = ^P) or (Ch > ^Z) then
          if (Ch <> Del) then
            {Clear the default string}
            EdClear(Ws, Wp);
        FirstRead := False;
      end;

      case Ch of

        ^@ :                {Null key}
          ;

        ^J :                 {Get help on current command}
          EdHelpWindow(GlobalCmd);

        ^M :                 {Enter, accept string and exit}
          Quitting := True;

        ^[ :                 {Escape, clear string and exit}
          begin
            EdClear(Ws, Wp);
            Quitting := True;
            Abortcmd := True;
          end;

        ^B :                 {Begin of line}
          Wp := 1;

        ^E :                 {End of line}
          Wp := Succ(Length(Ws));

        ^Y :                 {Clear to end of line}
          begin
            Ws := Copy(Ws, 1, Pred(Wp));
            EdDisplayString(Ws, 1);
          end;

        ^X :                 {Clear line}
          EdClear(Ws, Wp);

        ^R :                 {Restore line to default}
          begin
            Ws := Copy(Rs, 1, Maxlen);
            Wp := Succ(Length(Ws));
            EdDisplayString(Ws, 1);
          end;

        ^S :                 {Cursor left one}
          if Wp > 1 then
            Dec(Wp);

        ^D :                 {Cursor right one}
          if Wp <= Length(Ws) then
            Inc(Wp);

        ^A :                 {Cursor left one word}
          if Wp > 1 then begin
            Dec(Wp);
            while (Wp >= 1) and ((Wp > Length(Ws)) or (Ws[Wp] = Blank)) do
              Dec(Wp);
            while (Wp >= 1) and (Ws[Wp] <> Blank) do
              Dec(Wp);
            Inc(Wp);
          end;

        ^F :                 {Cursor right one word}
          if Wp <= Length(Ws) then begin
            Inc(Wp);
            while (Wp <= Length(Ws)) and (Ws[Wp] <> Blank) do
              Inc(Wp);
            while (Wp <= Length(Ws)) and (Ws[Wp] = Blank) do
              Inc(Wp);
          end;

        ^G :                 {Delete current character}
          if Wp <= Length(Ws) then begin
            Delete(Ws, Wp, 1);
            EdDisplayString(Ws, Wp);
          end;

        ^H, Del :            {Delete character left}
          if Wp > 1 then begin
            Dec(Wp);
            Delete(Ws, Wp, 1);
            EdDisplayString(Ws, Wp);
          end;

        ^P :                 {Accept control character}
          EdInsertCharacter(Chr(Ord(EdReadAndConvertChar) and $1F), Ws, Wp);

        ^V :                 {Toggle insert mode}
          AskforInsertflag := not(AskforInsertflag);

      else
        {Insert normal character}
        if Ch > ^Z then
          EdInsertCharacter(Ch, Ws, Wp);
      end;

    until Quitting;

    {Return the working string}
    Rs := Ws;

  end;                       {EdAskforEditor}

  procedure EdAskfor(Prompt : VarString;
                     Xp, Yp, Wid : Integer;
                     var Rs : VarString);
    {-Edit and return a string}
  var
    W : WindowPtr;
    Width : Integer;
    HaveWindow, CursorState : Boolean;

  begin                      {EdAskFor}

    if Abortcmd then
      Exit;
    AbortEnable := True;

    if EditUsercommandInput = 0 then begin
      {Not in a macro, update the screen}
      EdEraseMenuHelp;
      EdUpdateCmdLine;

      {Expand window width to hold prompt}
      if Length(Prompt)+2 > Wid then
        Width := Length(Prompt)+2
      else
        Width := Wid;

      {Define a window}
      W := EdSetupWindow(Border, Xp, Yp, Pred(Xp+Width), Yp+2, NormalBox);

      {Display the prompt}
      EdFastWrite(Prompt, Yp, Xp+(Width-Length(Prompt)) shr 1, ScreenAttr[MfColor]);
      HaveWindow := True;
      CursorState := SolidCursor;
      SolidCursor := False;
    end else
      {Don't waste time on screen within macros}
      HaveWindow := False;

    {Perform the edit, returning a new string Rs}
    EdAskforEditor(Xp, Succ(Yp), Width, Wid-3, HaveWindow, Rs);

    if HaveWindow then begin
      {Remove window}
      EdRestoreWindow(W, Xp, Yp, Width, 3);
      {Restore cursor}
      SolidCursor := CursorState;
      EdSetCursorOff;
      if EdPtrIsNil(CurrMenu) then
        EdUpdateCursor;
    end;
    if Abortcmd then
      Exit;
    AbortEnable := True;

  end;                       {EdAskfor}

  procedure EdArg2Integer(Arg : String255; Min, Max : Integer; var V);
    {-Return an integer value corresponding to command parameter}
  var
    Value : Integer absolute V;
    I : Integer;
    Code : Word;

  begin                      {EdArg2Integer}
    {Delete leading blanks}
    EdDeleteLeadingBlanks(Arg);
    {Delete all but first word}
    EdDeleteTrailers(Arg);
    Val(Arg, I, Code);
    if (Code = 0) and (I >= Min) and (I <= Max) then
      Value := I;
  end;                       {EdArg2Integer}

  procedure EdString2integer(Src : VarString; var R);
    {-Convert string to integer}
    {-Note 0 returned may mean ERROR - also check GotError}
  var
    Result : Integer absolute R;
    V : Integer;
    Code : Word;

  begin                      {EdString2integer}
    Val(Src, V, Code);
    if Code = 0 then
      Result := V
    else begin
      Result := 0;
      EdErrormsg(36);
    end;
  end;                       {EdString2integer}

  function EdYcenterWindow(Rows : Byte) : Byte;
    {-Return a legal row number centered in the current window}
  var
    R : Byte;

  begin                      {EdYcenterWindow}
    if WindowCount <= 0 then
      EdYcenterWindow := 20
    else begin
      with Curwin^ do
        R := (Firstlineno+Lastlineno-Rows) shr 1;
      if R < LogtopScr then
        R := LogtopScr
      else if R > LogscrRows-Rows then
        R := LogscrRows-Rows;
      EdYcenterWindow := R;
    end;
  end;                       {EdYcenterWindow}

  function EdGetnumber(Prompt : VarString; Default : Integer) : Integer;
    {-Prompt for and return a number, 0 if invalid or empty}
    {-Plus or minus in input strings return results relative to default}
  var
    St : VarString;
    Result : Integer;
    PlusPos, MinusPos : Byte;

  begin                      {EdGetnumber}
    Str(Default, St);
    EdAskfor(Prompt, 10, EdYcenterWindow(3), 30, St);

    if Abortcmd or EdStringEmpty(St) then
      Result := 0
    else begin

      {Check for relative indicators}
      PlusPos := Pos('+', St);
      if PlusPos <> 0 then
        Delete(St, PlusPos, 1);
      MinusPos := Pos('-', St);
      if MinusPos <> 0 then
        Delete(St, MinusPos, 1);

      {Convert string to number}
      EdString2integer(St, Result);

      if Result > 0 then begin
        {Apply relative offsets}
        if PlusPos <> 0 then
          Result := Default+Result
        else if MinusPos <> 0 then
          Result := Default-Result;
      end;

    end;
    EdGetnumber := Result;

  end;                       {EdGetNumber}

  procedure EdSetNumber(var Num; msg, Min, Max : Integer; var Empty : Boolean);
    {-Set an integer value}
  var
    Number : Integer absolute Num;
    St : VarString;
    Temp : Integer;

  begin                      {EdSetNumber}
    with Curwin^ do begin
      Empty := False;
      Str(Number, St);
      EdAskfor(EdGetMessage(msg), 32, EdYcenterWindow(3), 10, St);
      if Abortcmd then
        Exit;
      if EdStringEmpty(St) then begin
        Empty := True;
        Exit;
      end;
      EdString2integer(St, Temp);
      if Goterror then
        Exit;
      if (Temp >= Min) and (Temp <= Max) then
        Number := Temp
      else
        {Out of range}
        EdErrormsg(72);
    end;
  end;                       {EdSetNumber}