Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/BINED.ZIP/DEMO.INC

Text File | 1987-12-21 | 6KB | 209 lines

{                             DEMO.INC
             Copyright (c) 1985, 87 by Borland International, Inc.            }

  procedure DrawBox(Border : BorderChars; x1, y1, x2, y2 : byte);
    {-Draw a box around an editor window}
  var
    i : Word;
    bar : String;
    barlen : Byte absolute bar;

  begin                       {DrawBox}

    {Build horizontal bar}
    barlen := 3+X2-X1;
    FillChar(bar[1], barlen, Border[horiz]);

    {Draw top bar}
    bar[1] := Border[topleft];
    bar[barlen] := Border[topright];
    CRTputFast(X1, Y1, bar);

    {Draw bottom bar}
    bar[1] := Border[botleft];
    bar[barlen] := Border[botright];
    CRTputFast(X1, Y2+2, bar);

    {Vertical bars}
    for i := Succ(Y1) to Succ(Y2) do begin
      CRTputFast(X1, i, Border[vert]);
      CRTputFast(X2+2, i, Border[vert]);
    end;
  end;                        {DrawBox}

  procedure WriteStatus(msg : String);
    {-Write a status message to the bottom line of the screen}
  var
    msglen : Byte absolute msg;

  begin                       {WriteStatus}
    FillChar(msg[Succ(msglen)], 80-msglen, #32);
    msglen := 80;
    CRTputFast(1, 25, CAerr+msg);
  end;                        {WriteStatus}

  procedure CheckInitBinary(ExitCode : Word);
    {-Check the results of the editor load operation}

  begin                       {CheckInitBinary}
    if ExitCode <> 0 then begin
      {Couldn't initialize editor}
      GoToXY(1, 25);
      case ExitCode of
        1 : WriteLn('Insufficient heap space for text buffer');
      else
        WriteLn('Unknown load error');
      end;
      Halt(1);
    end;
  end;                        {CheckInitBinary}

  procedure CheckReadFile(ExitCode : Word; Fname : String);
    {-Check the results of the file read}
  var
    f : file;

  begin                       {CheckReadFile}
    if ExitCode <> 0 then begin
      {Couldn't read file}
      case ExitCode of
        1 : begin
              {New file, assure valid file name}
              {$I-}
              Assign(f, Fname);
              Rewrite(f);
              if IOResult <> 0 then begin
                Close(f);
                WriteStatus('Illegal file name '+Fname);
              end else begin
                Close(f);
                Erase(f);
                Write('New File');
                Delay(2000);
                Write(^M);
                ClrEol;
                GoToXY(1, 1);
                ClrEol;
                Exit;
              end;
              {$I+}
            end;
        2 : WriteStatus('Insufficient text buffer size');
      else
        WriteStatus('Unknown read error');
      end;
      GoToXY(1, 25);
      Halt(1);
    end;
    GoToXY(1, 1);
    ClrEol;
  end;                        {CheckReadFile}

  procedure CheckSaveFile(ExitCode : Word; Fname : String);
    {-Check the results of a file save}

  begin                       {CheckSaveFile}
    if ExitCode <> 0 then begin
      {Couldn't save file}
      case ExitCode of
        1 : WriteStatus('Unable to create output file '+Fname);
        2 : WriteStatus('Error while writing output to '+Fname);
        3 : WriteStatus('Unable to close output file '+Fname);
      else
        WriteStatus('Unknown write error');
      end;
      GoToXY(1, 25);
      Halt(1);
    end;
  end;                        {CheckSaveFile}

  procedure WriteKeyboardToggles(info : Word);
    {-Write the status of the keyboard toggles}
  var
    s : String;

  begin                       {WriteKeyboardToggles}
    s := CAerr;
    if (info and $40) <> 0 then
      s := s+'CL'
    else
      s := s+'  ';
    if (info and $20) <> 0 then
      s := s+' NL'
    else
      s := s+'   ';
    if (info and $10) <> 0 then
      s := s+' SL'
    else
      s := s+'   ';
    CRTputFast(72, 25, s);
  end;                        {WriteKeyboardToggles}

type
  string20 = string[20];
var
  TickCount : Word;        {Counter used to support on-screen clock}
  TickMax : Word;          {Count when on-screen clock is updated}
  LastTime : String20;     {Current time showing on screen}

{Note the user event handler must have a FAR attribute}
{$F+}

  procedure UserEventCheck(EventNo, KbdFlagInfo : Word);
    {-User hook for a background process called at every keypressed check}
  var
    NewTime : String20;

    function Time : String20;
      {-Return a string holding the current time}
    type
      string2 = string[2];
    var
      hours, mins : string2;
      hiclock, loclock : Word;
      regs : registers;

      function ZeroPad(s : string2) : string2;
        {-Left pad a numeral with a zero}

      begin                   {ZeroPad}
        if s[0] = #1 then
          s := '0'+s;
        ZeroPad := s;
      end;                    {ZeroPad}

    begin                     {Time}

      {Get the time from DOS}
      regs.ah := $2C;
      intr($21, regs);
      hiclock := regs.cx;
      loclock := regs.dx;

      {Convert to string}
      Str(Hi(hiclock), hours);
      Str(Lo(hiclock), mins);
      Time := ' '+ZeroPad(hours)+':'+ZeroPad(mins)+' ';
    end;                      {Time}

  begin                       {UserEventCheck}

    {Update on-screen clock once a minute}
    if TickCount > TickMax then begin
      TickCount := 0;
      NewTime := Time;
      if NewTime <> LastTime then begin
        CRTputFast(65, 25, CAerr+NewTime);
        LastTime := NewTime;
      end;
    end else
      TickCount := Succ(TickCount);

    if eventno = EventKBflag then
      {Update keyboard toggles whenever changed}
      WriteKeyboardToggles(kbdflaginfo);

  end;                        {UserEventCheck}

{$F-}