home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPFLEX.ZIP / PICK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-24  |  7.2 KB  |  272 lines
  1. {
  2.  
  3.     picklist.pas
  4.     4-25-90
  5.  
  6.     Copyright 1990
  7.     John W. Small
  8.     All rights reserved
  9.  
  10.     PSW / Power SoftWare
  11.     P.O. Box 10072
  12.     McLean, Virginia 22102 8072
  13.  
  14. }
  15.  
  16. unit pick;
  17.  
  18. interface
  19.  
  20.     uses crt, crtplus, flex;
  21.  
  22.     type
  23.  
  24.         PickAttr = (PICK_TITLE_ATTR, PICK_BORDER_ATTR,
  25.                     PICK_SCROLL_ATTR, PICK_NORMAL_ATTR,
  26.                     PICK_SELECT_ATTR, PICK_HILITE_ATTR);
  27.  
  28.         PickAttrs = array[PickAttr] of byte;
  29.  
  30.         PAptr = ^PickAttrs;
  31.  
  32.         PickList = object(FlexList)
  33.             color, mono, attrs : PAptr;
  34.             x, y, rows, cols, clen, startRow,
  35.             crow, ccol : integer;
  36.             update, finished : boolean;
  37.             title : string;
  38.             w : FramedTextWindow;
  39.             constructor init(pdlen,px,py,
  40.                 prows,pcols,pclen : integer;
  41.                 ptitle : string);
  42.             procedure   showItem; virtual;
  43.             function    doItem : boolean; virtual;
  44.             procedure   query;
  45.             destructor  done; virtual;
  46.             end;
  47.  
  48.     var
  49.  
  50.         PickColorDefaults,
  51.         PickMonoDefaults : PickAttrs;
  52.  
  53.  
  54. implementation
  55.  
  56.     constructor PickList.init(pdlen,px,py,
  57.                 prows,pcols,pclen : integer;
  58.                 ptitle : string);
  59.         begin
  60.             FlexList.init(pdlen);
  61.             color := @PickColorDefaults;
  62.             mono := @PickMonoDefaults;
  63.             if TxtScr.ColorAttrs then
  64.                 attrs := color
  65.             else
  66.                 attrs := mono;
  67.             x := px;
  68.             y := py;
  69.             rows := prows;
  70.             cols := pcols;
  71.             clen := pclen;
  72.             title := ptitle
  73.         end;
  74.  
  75.     procedure   PickList.showItem;
  76.         begin
  77.         end;
  78.  
  79.     function    PickList.doItem : boolean;
  80.         begin
  81.         end;
  82.  
  83.     procedure   PickList.query;
  84.         var i : integer;
  85.         begin
  86.             if nodes = 0 then exit;
  87.             if TxtScr.ColorAttrs then
  88.                 attrs := color
  89.             else
  90.                 attrs := mono;
  91.             w.window(x,y,x+cols*(clen+3),y+rows+1);
  92.             cursor.Off;
  93.             w.frame(attrs^[PICK_BORDER_ATTR],svsh);
  94.             w.titleFooter(true,attrs^[PICK_TITLE_ATTR],title);
  95.             startRow := 1;
  96.             ccol := 1;
  97.             crow := 1;
  98.             update := true;
  99.             finished := false;
  100.             while not finished  do begin
  101.                 if update then begin
  102.                     update := false;
  103.                     crt.textAttr := attrs^[PICK_NORMAL_ATTR];
  104.                     clrscr;
  105.                     i := (startRow-1)*cols+1;
  106.                     mkcur(i);
  107.                     while ok and
  108.                         (i <= (startRow-1)*cols+rows*cols)
  109.                         do begin
  110.                         gotoxy(((curNum-1) mod cols) * (clen + 3) + 2,
  111.                                 (curNum-1) div cols - startRow + 2);
  112.                         showItem;
  113.                         inc(i);
  114.                         mkcur(i)
  115.                         end;
  116.                     TxtScr.windLightBar((ccol-1)*(clen+3)+1,
  117.                         crow-startRow+1,clen+2,attrs^[PICK_SELECT_ATTR]);
  118.                     w.scrollBar(true,attrs^[PICK_BORDER_ATTR],svsh,
  119.                         attrs^[PICK_SCROLL_ATTR],crow,(nodes-1) div cols + 1)
  120.                     end;
  121.                 case crtplus.readkey of
  122.                     #0: begin
  123.                         mkcur((crow-1)*cols+ccol);
  124.                         TxtScr.windLightBar((ccol-1)*
  125.                             (clen+3)+1, crow-startRow+1,
  126.                             clen+2,attrs^[PICK_NORMAL_ATTR]);
  127.                         gotoxy(((curNum-1) mod cols) * (clen + 3) + 2,
  128.                             (curNum-1) div cols - startRow + 2);
  129.                         showItem;
  130.                         case char(hi(crtplus.asciiScan)) of
  131.                             PgUp: begin
  132.                                 dec(crow,rows);
  133.                                 if crow < 1 then crow := 1;
  134.                                 if crow < startRow then begin
  135.                                     startRow := crow;
  136.                                     update := true
  137.                                     end
  138.                                 end;
  139.                             PgDn: begin
  140.                                 inc(crow,rows);
  141.                                 if crow > ((nodes-1) div cols + 1) then
  142.                                     crow := (nodes-1) div cols+1;
  143.                                 if crow = (nodes-1) div cols+1 then
  144.                                     if ccol > ((nodes-1) mod cols + 1) then
  145.                                         dec(crow);
  146.                                 if (crow - startRow) >= rows then begin
  147.                                     startRow := crow - rows + 1;
  148.                                     update := true
  149.                                     end
  150.                                 end;
  151.                             Home: begin
  152.                                 ccol := 1;
  153.                                 crow := 1;
  154.                                 if startRow <> 1 then begin
  155.                                     startRow := 1;
  156.                                     update := true
  157.                                     end
  158.                                 end;
  159.                             EndKey: begin
  160.                                 ccol := (nodes-1) mod cols + 1;
  161.                                 crow := (nodes-1) div cols + 1;
  162.                                 if (crow - startRow) >= rows then begin
  163.                                     startRow := crow - rows + 1;
  164.                                     update := true
  165.                                     end
  166.                                 end;
  167.                             UpArr: begin
  168.                                 if crow > 1 then dec(crow);
  169.                                 if crow < startRow then begin
  170.                                     startRow := crow;
  171.                                     update := true
  172.                                     end
  173.                                 end;
  174.                             DnArr: begin
  175.                                 if crow < ((nodes-1) div cols + 1)  then begin
  176.                                     if (crow+1) = ((nodes-1) div cols+1)  then begin
  177.                                         if ccol <= ((nodes-1) mod cols+1) then
  178.                                             inc(crow)
  179.                                         end
  180.                                     else
  181.                                         inc(crow);
  182.                                     if (crow - startRow) >= rows then begin
  183.                                         startRow := crow - rows + 1;
  184.                                         update := true
  185.                                         end
  186.                                     end
  187.                                 end;
  188.                             LArr: begin
  189.                                 if ccol > 1 then
  190.                                     dec(ccol)
  191.                                 else if crow > 1 then begin
  192.                                     dec(crow);
  193.                                     ccol := cols;
  194.                                     if crow < startRow then begin
  195.                                         startRow := crow;
  196.                                         update := true
  197.                                         end
  198.                                     end
  199.                                 end;
  200.                             RArr: begin
  201.                                 if crow = ((nodes-1) div cols + 1) then begin
  202.                                     if ccol < ((nodes-1) mod cols + 1) then
  203.                                         inc(ccol)
  204.                                     end
  205.                                 else if ccol < cols then
  206.                                     inc(ccol)
  207.                                 else begin
  208.                                     inc(crow);
  209.                                     ccol := 1;
  210.                                     if (crow - startRow) >= rows then begin
  211.                                         startRow := crow - rows + 1;
  212.                                         update := true
  213.                                         end
  214.                                     end
  215.                                 end;
  216.                         end; { case hi(asciiScan) }
  217.                         if not update then begin
  218.                             TxtScr.windLightBar((ccol-1)*(clen+3)+1,
  219.                                 crow-startRow+1,clen+2,attrs^[PICK_SELECT_ATTR]);
  220.                             w.scrollBar(true,attrs^[PICK_BORDER_ATTR],svsh,
  221.                                 attrs^[PICK_SCROLL_ATTR],crow,(nodes-1) div cols + 1)
  222.                             end
  223.                         end; { #0: }
  224.                     ESC: begin
  225.                         w.done;
  226.                         finished := true
  227.                         end;
  228.                     CR: begin
  229.                         mkcur((crow-1)*cols+ccol);
  230.                         if doItem then
  231.                            finished := true
  232.                         else if nodes = 0 then
  233.                              finished := true
  234.                         else begin
  235.                              startRow := 1;
  236.                              crow := 1;
  237.                              ccol := 1;
  238.                              update := true;
  239.                              w.frame(attrs^[PICK_BORDER_ATTR],svsh);
  240.                              w.titleFooter(true,attrs^[PICK_TITLE_ATTR],title)
  241.                              end;
  242.                         if finished then
  243.                            w.done;
  244.                         end;
  245.                 end { case crtplus.readkey }
  246.                 end { while not finished }
  247.         end;
  248.  
  249.     destructor  PickList.done;
  250.         begin
  251.             FlexList.done
  252.         end;
  253.  
  254.     begin
  255.         PickColorDefaults[PICK_TITLE_ATTR]  := TxtScr.svideo(BLACK,LIGHTGRAY);
  256.         PickColorDefaults[PICK_BORDER_ATTR] := TxtScr.svideo(BLACK,LIGHTGRAY);
  257.         PickColorDefaults[PICK_SCROLL_ATTR] := TxtScr.svideo(RED  ,LIGHTGRAY);
  258.         PickColorDefaults[PICK_NORMAL_ATTR] := TxtScr.svideo(BLACK,LIGHTGRAY);
  259.         PickColorDefaults[PICK_SELECT_ATTR] := TxtScr.svideo(WHITE,BLACK    );
  260.         PickColorDefaults[PICK_HILITE_ATTR] := TxtScr.svideo(RED  ,LIGHTGRAY);
  261.         PickMonoDefaults[PICK_TITLE_ATTR]   := TxtScr.svideo(BLACK,LIGHTGRAY);
  262.         PickMonoDefaults[PICK_BORDER_ATTR]  := TxtScr.svideo(BLACK,LIGHTGRAY);
  263.         PickMonoDefaults[PICK_SCROLL_ATTR]  := TxtScr.svideo(WHITE,LIGHTGRAY);
  264.         PickMonoDefaults[PICK_NORMAL_ATTR]  := TxtScr.svideo(BLACK,LIGHTGRAY);
  265.         PickMonoDefaults[PICK_SELECT_ATTR]  := TxtScr.svideo(WHITE,BLACK    );
  266.         PickMonoDefaults[PICK_HILITE_ATTR]  := TxtScr.svideo(WHITE,LIGHTGRAY);
  267.     end.
  268.  
  269.  
  270.  
  271.  
  272.