home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PJ8_3.ZIP / USELECT.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-15  |  6KB  |  230 lines
  1. (* uselect.pas -- (c) 1990 by Tom Swan *)
  2.  
  3. unit uselect;
  4. interface
  5. uses crt, ukeys, uscreen, uitem, ustritem, ulist;
  6.  
  7. type
  8.  
  9.    keySet = set of char;
  10.  
  11.    selectableItemPtr = ^selectableItem;
  12.    selectableItem = object( strItem )
  13.       selected : Boolean;
  14.       constructor init( s : string; initial : Boolean );
  15.       procedure setSelection( setting : Boolean );
  16.       procedure toggleSelection;
  17.       function getMarkedString : string; virtual;
  18.    end; { selectableItem }
  19.  
  20.    selectionListPtr = ^selectionList;
  21.    selectionList = object( list )
  22.       xmin, ymin, xmax, ymax : word;   { Display coordinates }
  23.       constructor init( x1, y1, x2, y2 : word );
  24.       procedure firstSelectedItem( var noItems : Boolean );
  25.       procedure nextSelectedItem( var pastHead : Boolean );
  26.       procedure setAll( setting : Boolean );
  27.       procedure toggleAll;
  28.       procedure displayItems; virtual;
  29.       procedure selectItems( exitKeys : keySet; 
  30.          var lastKey : char ); virtual;
  31.    end; { selectionList }
  32.  
  33. implementation
  34.  
  35. const
  36.  
  37.    DIM      = FALSE;    { ShowItem arguments }
  38.    BRIGHT   = TRUE;
  39.    ENTER    = #13;      { Various character constants }
  40.    ESC      = #27;
  41.    BLANK    = #32;
  42.    KEY_UP   = 'H';
  43.    KEY_DOWN = 'P';
  44.  
  45. { ----- Initialize selectableItem object. }
  46. constructor selectableItem.init( s : string; initial : Boolean );
  47. begin
  48.    selected := initial;
  49.    strItem.Init( s )
  50. end; { selectableItem.init }
  51.  
  52. { ----- Set selected switch to 'setting'. }
  53. procedure selectableItem.setSelection( setting : Boolean );
  54. begin
  55.    selected := setting
  56. end; { selectableItem.setSelection }
  57.  
  58. { ----- Toggle this item on/off }
  59. procedure selectableItem.toggleSelection;
  60. begin
  61.    selected := not selected
  62. end; { selectableItem.toggleSelection }
  63.  
  64. { ----- Return string with selected marker on or off }
  65. function selectableItem.getMarkedString : string;
  66. var
  67.    s2 : string[2];
  68. begin
  69.    if selected
  70.       then s2 := '> '
  71.       else s2 := '  ';
  72.    getMarkedString := s2 + getString
  73. end; { selectableItem.getMarkedString }
  74.  
  75. { ----- Initialize selectionList object }
  76. constructor selectionList.init( x1, y1, x2, y2 : word );
  77. begin
  78.    list.init;
  79.    xmin := x1;
  80.    ymin := y1;
  81.    xmax := x2;
  82.    ymax := y2
  83. end; { selectionList.init }
  84.  
  85. { ----- Advance list to first item where selected=TRUE. If noItems is
  86. TRUE, then the list contains no selected items. }
  87. procedure selectionList.firstSelectedItem( var noItems : Boolean );
  88. begin
  89.    noItems := listEmpty;   { i.e. noItems = TRUE if list is empty }
  90.    if noItems then exit;
  91.    resetList;
  92.    if selectableItemPtr( currentItem )^.selected then exit;
  93.    nextSelectedItem( noItems )
  94. end; { selectionList.firstSelectedItem }
  95.  
  96. { ----- Advance list to next item where selected=TRUE. If pastHead
  97. returns TRUE, then the search has gone full circle around the list. }
  98. procedure selectionList.nextSelectedItem( var pastHead : Boolean );
  99. begin
  100.    pastHead := listEmpty;
  101.    while not pastHead do
  102.    begin
  103.       nextItem;
  104.       pastHead := atHeadOfList;
  105.       if selectableItemPtr( currentItem )^.selected then exit
  106.    end { while }
  107. end; { selectionList.nextSelectedItem }
  108.  
  109. { ----- Set all select switches to 'setting.' }
  110. procedure selectionList.setAll( setting : Boolean );
  111. begin
  112.    if listEmpty then exit;
  113.    resetList;
  114.    repeat
  115.       selectableItemPtr( currentItem )^.setSelection( setting );
  116.       nextItem
  117.    until atHeadOfList
  118. end; { selectionList.setAll }
  119.  
  120. { ----- Toggle all select switches for all listed items. }
  121. procedure selectionList.toggleAll;
  122. begin
  123.    if listEmpty then exit;
  124.    resetList;
  125.    repeat
  126.       selectableItemPtr( currentItem )^.toggleSelection;
  127.       nextItem
  128.    until atHeadOfList
  129. end; { selectionList.toggleAll }
  130.  
  131. { ----- Display all selectableItem objects }
  132. procedure selectionList.displayItems;
  133. var
  134.    line : integer;
  135. begin
  136.    clearWindow( xmin, ymin, xmax, ymax );
  137.    gotoxy( xmin, ymin );
  138.    line := ymin;
  139.    if listEmpty then exit;    { Leaving window clear }
  140.    resetList;
  141.    repeat
  142.       gotoxy( xmin, line );
  143.       write( selectableItemPtr( currentItem )^.getMarkedString );
  144.       nextItem;
  145.       inc( line )
  146.    until atHeadOfList or ( line > ymax )
  147. end; { selectionList.displayItems }
  148.  
  149. { ----- Let user select one or more items from the list. }
  150. procedure selectionList.selectItems( 
  151.    exitKeys : keySet; var lastKey : char );
  152. var
  153.    line : integer;            { Line number (absolute) }
  154.    exitKeyPressed : Boolean;  { True if any exit key pressed }
  155.  
  156.    procedure showItem( ip : ItemPtr; highlight : Boolean );
  157.    begin
  158.       gotoxy( xmin, line );
  159.       clrEol;
  160.       if highlight
  161.          then highVideo
  162.          else normVideo;
  163.       if ip <> nil
  164.          then write( selectableItemPtr( ip )^.getMarkedString );
  165.       normVideo
  166.    end; { showItem }
  167.  
  168.    procedure startList;
  169.    begin
  170.       displayItems;
  171.       line := ymin;
  172.       resetList;
  173.       showItem( currentItem, BRIGHT )
  174.    end; { startList }
  175.  
  176.    procedure moveUp;
  177.    begin
  178.       if (not listEmpty) and (not atHeadOfList) then
  179.       begin
  180.          showItem( currentItem, DIM );
  181.          if line > ymin
  182.             then dec( line )
  183.             else scrollDown( xmin, ymin, xmax, ymax );
  184.          prevItem;
  185.          showItem( currentItem, BRIGHT )
  186.       end { if }
  187.    end; { moveUp }
  188.  
  189.    procedure moveDown;
  190.    begin
  191.       if (not listEmpty) and (not atEndOfList) then
  192.       begin
  193.          showItem( currentItem, DIM );
  194.          if line < ymax 
  195.             then inc( line )
  196.             else scrollUp( xmin, ymin, xmax, ymax );
  197.          nextItem;
  198.          showItem( currentItem, BRIGHT )
  199.       end { if }
  200.    end; { moveDown }
  201.  
  202.    procedure toggle;
  203.    var
  204.       sip : selectableItemPtr;
  205.    begin
  206.       sip := selectableItemPtr( currentItem );
  207.       if sip <> nil
  208.          then sip^.toggleSelection;
  209.       showItem( sip, BRIGHT )
  210.    end; { toggle }
  211.  
  212. begin
  213.    startList;
  214.    exitKeys := exitKeys + [ ESC ];    { Escape always exits }
  215.    exitKeyPressed := FALSE;
  216.    repeat
  217.       lastKey := upcase( getKey );
  218.       case lastKey of
  219.          KEY_UP      : moveUp;
  220.          KEY_DOWN    : moveDown;
  221.          BLANK,ENTER : toggle;
  222.       else 
  223.          exitKeyPressed := lastKey in exitKeys
  224.       end
  225.    until exitKeyPressed;
  226.    showItem( currentItem, DIM )
  227. end; { selectionList.selectItems }
  228.  
  229. end. { uselect }
  230.