home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / tppick.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-14  |  8.8 KB  |  286 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. General-purpose scrolling window unit.
  37.  
  38. * ASSOCIATED FILES
  39. TPDIR.PAS
  40. DEMO1.PAS
  41. DEMO1.EXE
  42. TPDIR.TPU
  43. TPPICK.PAS
  44. TPPICK.TPU
  45.  
  46. * CHECKED BY
  47. DRM - 08/14/88
  48.  
  49. * KEYWORDS
  50. TURBO PASCAL V4.0 PROGRAM DIRECTORY DEMO MENU
  51.  
  52. ==========================================================================
  53. }
  54. {
  55. Copyright (c) 1987 by TurboPower Software. May be freely used by and
  56. distributed to owners of Turbo Professional 4.0.
  57.  
  58. See TPDir for an example of using the TPPick unit.
  59. }
  60.  
  61. {$R-,I-,S-,V-}
  62.  
  63. unit TPPick;
  64.   {-Manage scrolling pick windows}
  65.  
  66. interface
  67.  
  68. uses
  69.   TPString,
  70.   TPCrt,
  71.   TPWindow;
  72.  
  73. type
  74.   CharSet = set of Char;
  75.  
  76. function PickWindow
  77.   (StringFunc : pointer;     {Pointer to function to return each item string}
  78.    NumItems : Word;          {Number of items to pick from}
  79.    XLow, YLow : Byte;        {Window coordinates, including frame if any}
  80.    XHigh, YHigh : Byte;      {Window coordinates, including frame if any}
  81.    DrawFrame : Boolean;      {True to draw a frame around window}
  82.    WindowAttr : Byte;        {Video attribute for body of window}
  83.    FrameAttr : Byte;         {Video attribute for frame}
  84.    HeaderAttr : Byte;        {Video attribute for header}
  85.    SelectAttr : Byte;        {Video attribute for selected item}
  86.    Header : string;          {Title for window}
  87.    PickSet : CharSet;        {Selection characters}
  88.    var Choice : Word;        {The item selected, in the range 1..NumItems}
  89.    var PickChar : Char       {Character used to perform selection}
  90.    ) : Boolean;              {True if PickWindow was successful}
  91.  
  92.   {-Display a window, let user scroll around in it, and return choice.
  93.     Choice returned is in the range 1..NumItems.
  94.     PickChar is an element of PickSet.
  95.     }
  96.  
  97.   {=========================================================================}
  98.  
  99. implementation
  100.  
  101. var
  102.   XSize : Byte;              {Active width of pick window (no frame)}
  103.   YSize : Byte;              {Active height of pick window}
  104.   W : WindowPtr;             {Window descriptor of pick window}
  105.   PickFunc : pointer;        {Pointer to function that returns each string}
  106.  
  107.   function GetString(Item : word) : string;
  108.     {-Return the name of each item}
  109.   inline($FF/$1E/>PickFunc); {CALL DWORD PTR [>PickFunc]}
  110.  
  111.   function PickWindow
  112.     (StringFunc : pointer;     {Pointer to function to return each item string}
  113.      NumItems : Word;          {Number of items in PickArray}
  114.      XLow, YLow : Byte;        {Window coordinates, including frame if any}
  115.      XHigh, YHigh : Byte;      {Window coordinates, including frame if any}
  116.      DrawFrame : Boolean;      {True to draw a frame around window}
  117.      WindowAttr : Byte;        {Video attribute for body of window}
  118.      FrameAttr : Byte;         {Video attribute for frame}
  119.      HeaderAttr : Byte;        {Video attribute for header}
  120.      SelectAttr : Byte;        {Video attribute for selected item}
  121.      Header : string;          {Title for window}
  122.      PickSet : CharSet;        {Selection characters}
  123.      var Choice : Word;        {The item selected, in the range 1..NumItems}
  124.      var PickChar : Char       {Character used to perform selection}
  125.      ) : Boolean;              {True if PickWindow was successful}
  126.   var
  127.     SaveBreak : Boolean;
  128.     Done : Boolean;
  129.     KW : Word;
  130.     Row : Byte;
  131.     Correction : integer;
  132.  
  133.     procedure DrawItem(ItemNum : Word; Row, Attr : Byte);
  134.       {-Draw the specified item}
  135.     begin
  136.       FastWriteWindow(pad(' '+GetString(ItemNum), XSize), Row, 1, Attr);
  137.     end;
  138.  
  139.     procedure DrawPage(Top : Word);
  140.       {-Draw a full page of items, starting with Top}
  141.     var
  142.       I : Word;
  143.     begin
  144.       for I := 1 to YSize do
  145.         DrawItem(Pred(Top+I), I, WindowAttr);
  146.     end;
  147.  
  148.   begin
  149.  
  150.     {Assume failure}
  151.     PickWindow := False;
  152.  
  153.     {Validate item information}
  154.     if (NumItems = 0) or (StringFunc = nil) then
  155.       Exit;
  156.  
  157.     {Initialize variables we'll use for display}
  158.     PickFunc := StringFunc;
  159.     if DrawFrame then
  160.       Correction := -1
  161.     else
  162.       Correction := +1;
  163.     XSize := XHigh-XLow+Correction;
  164.     YSize := YHigh-YLow+Correction;
  165.     if YSize > NumItems then begin
  166.       YSize := NumItems;
  167.       YHigh := YLow+NumItems-Correction;
  168.     end;
  169.  
  170.     {Initialize the window}
  171.     if not MakeWindow(W, XLow, YLow, XHigh, YHigh,
  172.                       DrawFrame, True, False,
  173.                       WindowAttr, FrameAttr, HeaderAttr,
  174.                       Header) then Exit;
  175.  
  176.     {Display the window and turn off the cursor}
  177.     if not DisplayWindow(W) then
  178.       Exit;
  179.     HiddenCursor;
  180.     SaveBreak := CheckBreak;
  181.     CheckBreak := False;
  182.  
  183.     {Initial item is the first one}
  184.     Choice := 1;
  185.     Row := 1;
  186.     DrawPage(Choice);
  187.  
  188.     {Loop getting characters}
  189.     Done := False;
  190.     repeat
  191.       {Highlight the selected entry}
  192.       DrawItem(Choice, Row, SelectAttr);
  193.       {Get a command}
  194.       KW := ReadKeyWord;
  195.  
  196.       case KW of
  197.         $4700 :              {Home}
  198.           if Choice > 1 then begin
  199.             Choice := 1;
  200.             Row := 1;
  201.             DrawPage(Choice);
  202.           end;
  203.  
  204.         $4800 :              {Up arrow}
  205.           if Choice > 1 then begin
  206.             {Erase the last choice}
  207.             DrawItem(Choice, Row, WindowAttr);
  208.             {Move to previous item}
  209.             Dec(Choice);
  210.             if Row = 1 then
  211.               {Scroll}
  212.               InsLine
  213.             else
  214.               {Move selection bar}
  215.               Dec(Row);
  216.           end else if YSize = NumItems then begin
  217.             {Wrap to end}
  218.             Choice := NumItems;
  219.             Row := YSize;
  220.             DrawPage(Succ(Choice-Row));
  221.           end;
  222.  
  223.         $4900 :              {PgUp}
  224.           if Choice > 1 then begin
  225.             if Choice > YSize then
  226.               Dec(Choice, YSize)
  227.             else
  228.               Choice := 1;
  229.             Row := 1;
  230.             DrawPage(Choice);
  231.           end;
  232.  
  233.         $4F00 :              {End}
  234.           if Choice < NumItems then begin
  235.             Choice := NumItems;
  236.             Row := YSize;
  237.             DrawPage(Succ(Choice-Row));
  238.           end;
  239.  
  240.         $5000 :              {Down arrow}
  241.           if Choice < NumItems then begin
  242.             {Erase the last choice}
  243.             DrawItem(Choice, Row, WindowAttr);
  244.             {Move to next item}
  245.             Inc(Choice);
  246.             if Row = YSize then
  247.               {Scroll}
  248.               DelLine
  249.             else
  250.               {Move selection bar}
  251.               Inc(Row);
  252.           end else if YSize = NumItems then begin
  253.             {Wrap to begin}
  254.             Choice := 1;
  255.             Row := 1;
  256.             DrawPage(Choice);
  257.           end;
  258.  
  259.         $5100 :              {PgDn}
  260.           if Choice < NumItems then begin
  261.             Inc(Choice, YSize);
  262.             if Choice > NumItems then
  263.               Choice := NumItems;
  264.             Row := YSize;
  265.             DrawPage(Succ(Choice-Row));
  266.           end;
  267.  
  268.       else
  269.         {See if a pick character}
  270.         PickChar := Char(lo(KW));
  271.         if PickChar in PickSet then
  272.           Done := True;
  273.       end;
  274.     until Done;
  275.  
  276.     {Restore the screen and deallocate the window}
  277.     W := EraseTopWindow;
  278.     DisposeWindow(W);
  279.     CheckBreak := SaveBreak;
  280.  
  281.     {If we get to here, all was well}
  282.     PickWindow := True;
  283.   end;
  284.  
  285. end.
  286.