Power-Programmierung/CD1.mdf/pascal/library/dos/packer/arc/arctool/tppick.pas

Pascal/Delphi Source File | 1988-09-29 | 7.2 KB | 248 lines

{
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
General-purpose scrolling window unit.

* ASSOCIATED FILES
TPDIR.PAS
DEMO1.PAS
DEMO1.EXE
TPDIR.TPU
TPPICK.PAS
TPPICK.TPU
}
{
Copyright (c) 1987 by TurboPower Software. May be freely used by and
distributed to owners of Turbo Professional 4.0.

See TPDir for an example of using the TPPick unit.
}

{$R-,I-,S-,V-}

unit TPPick;
  {-Manage scrolling pick windows}

interface

uses
  TPString,
  TPCrt,
  TPWindow;

type
  CharSet = set of Char;

function PickWindow
  (StringFunc : pointer;     {Pointer to function to return each item string}
   NumItems : Word;          {Number of items to pick from}
   XLow, YLow : Byte;        {Window coordinates, including frame if any}
   XHigh, YHigh : Byte;      {Window coordinates, including frame if any}
   DrawFrame : Boolean;      {True to draw a frame around window}
   WindowAttr : Byte;        {Video attribute for body of window}
   FrameAttr : Byte;         {Video attribute for frame}
   HeaderAttr : Byte;        {Video attribute for header}
   SelectAttr : Byte;        {Video attribute for selected item}
   Header : string;          {Title for window}
   PickSet : CharSet;        {Selection characters}
   var Choice : Word;        {The item selected, in the range 1..NumItems}
   var PickChar : Char       {Character used to perform selection}
   ) : Boolean;              {True if PickWindow was successful}

  {-Display a window, let user scroll around in it, and return choice.
    Choice returned is in the range 1..NumItems.
    PickChar is an element of PickSet.
    }

  {=========================================================================}

implementation

var
  XSize : Byte;              {Active width of pick window (no frame)}
  YSize : Byte;              {Active height of pick window}
  W : WindowPtr;             {Window descriptor of pick window}
  PickFunc : pointer;        {Pointer to function that returns each string}

  function GetString(Item : word) : string;
    {-Return the name of each item}
  inline($FF/$1E/>PickFunc); {CALL DWORD PTR [>PickFunc]}

  function PickWindow
    (StringFunc : pointer;     {Pointer to function to return each item string}
     NumItems : Word;          {Number of items in PickArray}
     XLow, YLow : Byte;        {Window coordinates, including frame if any}
     XHigh, YHigh : Byte;      {Window coordinates, including frame if any}
     DrawFrame : Boolean;      {True to draw a frame around window}
     WindowAttr : Byte;        {Video attribute for body of window}
     FrameAttr : Byte;         {Video attribute for frame}
     HeaderAttr : Byte;        {Video attribute for header}
     SelectAttr : Byte;        {Video attribute for selected item}
     Header : string;          {Title for window}
     PickSet : CharSet;        {Selection characters}
     var Choice : Word;        {The item selected, in the range 1..NumItems}
     var PickChar : Char       {Character used to perform selection}
     ) : Boolean;              {True if PickWindow was successful}
  var
    SaveBreak : Boolean;
    Done : Boolean;
    KW : Word;
    Row : Byte;
    Correction : integer;

    procedure DrawItem(ItemNum : Word; Row, Attr : Byte);
      {-Draw the specified item}
    begin
      FastWriteWindow(pad(' '+GetString(ItemNum), XSize), Row, 1, Attr);
    end;

    procedure DrawPage(Top : Word);
      {-Draw a full page of items, starting with Top}
    var
      I : Word;
    begin
      for I := 1 to YSize do
        DrawItem(Pred(Top+I), I, WindowAttr);
    end;

  begin

    {Assume failure}
    PickWindow := False;

    {Validate item information}
    if (NumItems = 0) or (StringFunc = nil) then
      Exit;

    {Initialize variables we'll use for display}
    PickFunc := StringFunc;
    if DrawFrame then
      Correction := -1
    else
      Correction := +1;
    XSize := XHigh-XLow+Correction;
    YSize := YHigh-YLow+Correction;
    if YSize > NumItems then begin
      YSize := NumItems;
      YHigh := YLow+NumItems-Correction;
    end;

    {Initialize the window}
    if not MakeWindow(W, XLow, YLow, XHigh, YHigh,
                      DrawFrame, True, False,
                      WindowAttr, FrameAttr, HeaderAttr,
                      Header) then Exit;

    {Display the window and turn off the cursor}
    if not DisplayWindow(W) then
      Exit;
    HiddenCursor;
    SaveBreak := CheckBreak;
    CheckBreak := False;

    {Initial item is the first one}
    Choice := 1;
    Row := 1;
    DrawPage(Choice);

    {Loop getting characters}
    Done := False;
    repeat
      {Highlight the selected entry}
      DrawItem(Choice, Row, SelectAttr);
      {Get a command}
      KW := ReadKeyWord;

      case KW of
        $4700 :              {Home}
          if Choice > 1 then begin
            Choice := 1;
            Row := 1;
            DrawPage(Choice);
          end;

        $4800 :              {Up arrow}
          if Choice > 1 then begin
            {Erase the last choice}
            DrawItem(Choice, Row, WindowAttr);
            {Move to previous item}
            Dec(Choice);
            if Row = 1 then
              {Scroll}
              InsLine
            else
              {Move selection bar}
              Dec(Row);
          end else if YSize = NumItems then begin
            {Wrap to end}
            Choice := NumItems;
            Row := YSize;
            DrawPage(Succ(Choice-Row));
          end;

        $4900 :              {PgUp}
          if Choice > 1 then begin
            if Choice > YSize then
              Dec(Choice, YSize)
            else
              Choice := 1;
            Row := 1;
            DrawPage(Choice);
          end;

        $4F00 :              {End}
          if Choice < NumItems then begin
            Choice := NumItems;
            Row := YSize;
            DrawPage(Succ(Choice-Row));
          end;

        $5000 :              {Down arrow}
          if Choice < NumItems then begin
            {Erase the last choice}
            DrawItem(Choice, Row, WindowAttr);
            {Move to next item}
            Inc(Choice);
            if Row = YSize then
              {Scroll}
              DelLine
            else
              {Move selection bar}
              Inc(Row);
          end else if YSize = NumItems then begin
            {Wrap to begin}
            Choice := 1;
            Row := 1;
            DrawPage(Choice);
          end;

        $5100 :              {PgDn}
          if Choice < NumItems then begin
            Inc(Choice, YSize);
            if Choice > NumItems then
              Choice := NumItems;
            Row := YSize;
            DrawPage(Succ(Choice-Row));
          end;

      else
        {See if a pick character}
        PickChar := Char(lo(KW));
        if PickChar in PickSet then
          Done := True;
      end;
    until Done;

    {Restore the screen and deallocate the window}
    W := EraseTopWindow;
    DisposeWindow(W);
    CheckBreak := SaveBreak;

    {If we get to here, all was well}
    PickWindow := True;
  end;

end.