Programmer 7500/MAX_PROGRAMMERS.iso/PROGRAMS/UTILS/DSKCACHE/EVALCACH.ZIP/CONTROLS.PAS

Pascal/Delphi Source File | 1989-10-26 | 5.1 KB | 210 lines

{
**************************************************************************
CONTROLS.PAS -- Text-based controls for screen-oriented programs
Copyright 1989 L. Brett Glass -- All rights reserved.
**************************************************************************
}
unit Controls;

interface

uses CRT,CharScrn;

type
  ControlPtr = ^Control;
  Control = object (TitledCharObject)
    next : ControlPtr;
    {Methods}
    procedure Draw; virtual;
    procedure DispTitle; virtual;
    procedure CheckChar(c : Char);
    procedure Manipulate; virtual;
    end;

  ButtonCtrl = object (Control)
    proc : Procedure;
    {Methods}
    constructor Init;
    procedure Draw; virtual;
    procedure DispTitle; virtual;
    procedure Manipulate; virtual;
    end;

  WordCtrl = object (Control)
    value, fieldSize, max, min, increment, bigIncrement : Word;
    unitStr : String[12];
    {Methods}
    procedure Draw; virtual;
    procedure DispTitle; virtual;
    procedure Manipulate; virtual;
    end;

const
  firstHelpLine : Word = 0; {Line on which help message should appear
                             when control is active. 0 means no message.}
var
  helpLineLeft : ColType;
  helpLineWidth : ColType;

procedure DrawChain(head : ControlPtr);

implementation

{$F+}
procedure DoNothing;
  begin {DoNothing}
  end;  {DoNothing}
{$F-}

procedure DrawChain(head : ControlPtr);
  begin {DrawChain}
  while head <> NIL do
    begin
    head^.Draw;
    head := head^.next
    end
  end;  {DrawChain}

procedure WriteWithFirstHigh(x : ColType; y : RowType; s : String);
  var
    p : ScreenParms;
    i : Word;
  begin {WriteWithFirstHigh}
  GoToXY(x,y);
  if Length(s) > 0 then
    begin
    HighVideo;
    Write(s[1]);
    LowVideo;
    for i := 2 to Length(s) do
      Write(s[i]);
    end
  end;  {WriteWithFirstHigh}

procedure Control.Draw;
  begin {Control.Draw}
  textAttr := color;
  WriteWithFirstHigh(x,y,title);
  end;  {Control.Draw}

procedure Control.DispTitle;
  begin {Control.DispTitle}
  Control.Draw
  end;  {Control.DispTitle}

procedure Control.CheckChar(c : Char);
  begin {Control.CheckChar}
  if (Length(title) > 0) and (c = title[1]) then
    Manipulate
  else
    if next <> NIL then
      next^.CheckChar(c);
  end;  {Control.CheckChar}

procedure Control.Manipulate; {Dummy}
  begin {Manipulate}
  end;  {Manipulate}


constructor ButtonCtrl.Init;
  begin {ButtonCtrl.Init}
  proc := DoNothing;
  end;  {ButtonCtrl.Init}

procedure ButtonCtrl.Draw;
  begin {ButtonCtrl.Draw}
  Control.Draw
  end;  {ButtonCtrl.Draw}

procedure ButtonCtrl.DispTitle;
  begin {ButtonCtrl.DispTitle}
  Control.Draw
  end;  {ButtonCtrl.DispTitle}

procedure ButtonCtrl.Manipulate;
  begin {ButtonCtrl.Manipulate}
  proc
  end;  {ButtonCtrl.Manipulate}


procedure WordCtrl.Draw;
  begin {WordCtrl.Draw}
  Control.Draw;
  Write(value:fieldSize,' ',unitStr);
  end; {WordCtrl.Draw}

procedure WordCtrl.DispTitle;
  begin {WordCtrl.DispTitle}
  Control.Draw
  end;  {WordCtrl.DispTitle}

procedure WordCtrl.Manipulate;
  const
    helpMsg : String[59] = 'Use '#27' and '#26' to set value. Hold Ctrl to change value faster.';
    helpMsg2 : String[48] = 'Press Enter to accept, ESC to restore old value.';
  var
    modValue : LongInt;
    start1, start2 : Byte;
    valueX : ColType;
    valueY : RowType;

  procedure EraseHelp;
    begin {EraseHelp}
    FillBox(start1,firstHelpLine,Length(helpMsg),1,' ');
    FillBox(start2,Succ(firstHelpLine),Length(helpMsg2),1,' ');
    end;  {EraseHelp}

  begin {WordCtrl.Manipulate}
  if firstHelpLine <> 0 then
    begin
    TextAttr := color;
    LowVideo;
    start1 := Pred((SCREENWIDTH div 2) + FIRSTCOL) - Length(helpMsg) div 2;
    CharsToScreen(start1,firstHelpLine,Length(helpMsg),helpMsg[1]);
    start2 := Pred((SCREENWIDTH div 2) + FIRSTCOL) - Length(helpMsg2) div 2;
    CharsToScreen(start2,Succ(firstHelpLine),Length(helpMsg2),helpMsg2[1]);
    Control.Draw;
    HighVideo;
    modValue := value;
    valueX := WhereX;
    valuey := WhereY;
    repeat
      Write(modValue:fieldSize,' ',unitStr);
      case ReadKey of
        #27 : {ESC}
          begin
          EraseHelp;
          Draw;
          Exit
          end;
        #13 : {Enter}
          begin
          EraseHelp;
          value := modValue;
          Draw;
          Exit
          end;
        #0 : {Special key}
          begin
          case ReadKey of
            #75 : {Left Arrow}
              Dec(modValue,increment);
            #77 : {Right Arrow}
              Inc(modValue,increment);
            #115 : {Ctrl-Left Arrow}
              Dec(modValue,bigIncrement);
            #116 : {Ctrl-Right Arrow}
              Inc(modValue,bigIncrement);
            end;
          if modValue > max then
            modValue := max
          else
            if modValue < min then
              modValue := min;
          end
        end;
      GoToXY(valueX,valueY)
      until FALSE;
    end
  end;  {WordCtrl.Manipulate}
end.