home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / MULTPICK.LZH / MULTTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-04-09  |  4.3 KB  |  122 lines
  1. {
  2.  This program demonstrates the MULTPICK unit. MULTPICK provides a
  3.  MultiLinePickList object derived from the PickList. MultiLinePickList is good
  4.  for displaying and getting selections from a list where each item needs more
  5.  than one line for display. An example would be making a selection from a
  6.  mailing list; this test program demonstrates such an example.
  7.  
  8.  To work with MultiLinePickList, you must write a specialized user string
  9.  procedure, as shown in the example below. The procedure is passed the record
  10.  number, the field number within the record, and whether the record is the
  11.  currently highlighted one. The procedure must always initialize the IString
  12.  parameter with an appropriate value for those parameters. Field numbers range
  13.  from 1 to the number of fields; record numbers range from 1 to the number of
  14.  records.
  15.  
  16.  A MultiLinePickList is initialized with the InitDeluxe constructor. This
  17.  constructor takes the following parameters:
  18.  
  19.   InitDeluxe(X1, Y1, X2, Y2 : Byte;     -Window coordinates
  20.              var Colors : ColorSet;     -Colors to use
  21.              Options : LongInt;         -Window options
  22.              ItemWidth : Byte;          -Width of each column
  23.              NumRecords : Word;         -Total number of records
  24.              NumFields : Word;          -Number of fields in each record
  25.              StringProc : mlStringProc; -The string procedure
  26.              PickOptions : Word);       -Pick options
  27.  
  28.  The MultiLinePickList is designed only for single choice picklists and
  29.  requires the PickSnaking orientation for proper operation. Therefore, related
  30.  PickList options are not available to MultiLinePickList. The object also uses
  31.  protected items internally, so the user routine cannot protect entire
  32.  records.
  33.  
  34.  The height of the window should be an exact multiple of NumFields. If it
  35.  isn't, InitDeluxe adjusts Y2 until the nearest multiple is reached. If this
  36.  isn't possible, InitDeluxe will fail.
  37.  
  38.  String searching applied to such a pick list will be limited to searching the
  39.  first field of each record.
  40.  
  41.  Item2Record returns the record number corresponding to a given item. This
  42.  will often be used in combination with GetLastChoice, as shown in the example
  43.  below.
  44.  
  45.  If you are reading the records directly from disk, you should consider using
  46.  the technique demonstrated in CACHE.LZH for improving performance.
  47.  
  48.  Written by TurboPower Software, 4/8/90.
  49.  Requires Object Professional 1.01 or later to compile and run.
  50. }
  51.  
  52. program MultTest;
  53. uses
  54.   OpInline,
  55.   OpString,
  56.   OpRoot,
  57.   OpCrt,
  58.   {$IFDEF UseMouse}
  59.   OpMouse,
  60.   {$ENDIF}
  61.   OpCmd,
  62.   OpFrame,
  63.   OpWindow,
  64.   OpPick,
  65.   MultPick;
  66.  
  67. var
  68.   MLPL : MultiLinePickList;
  69.  
  70.   {$F+}
  71.   procedure MLStringProc(RecNum : Word;
  72.                          FieldNum : Word;
  73.                          RecIsCurrent : Boolean;
  74.                          var IString : String;
  75.                          MLPickPtr : MultiLinePickListPtr);
  76.   var
  77.     PadLen : Byte;
  78.   begin
  79.     if RecNum > 999 then
  80.       PadLen := 6
  81.     else if RecNum > 99 then
  82.       PadLen := 5
  83.     else if RecNum > 9 then
  84.       PadLen := 4
  85.     else
  86.       PadLen := 3;
  87.     case FieldNum of
  88.       1: IString := Long2Str(RecNum)+'. First Last Name';
  89.       2: IString := CharStr(' ', PadLen)+'Address '+Long2Str(RecNum);
  90.       3: IString := CharStr(' ', PadLen)+'City, State ZIP '+Long2Str(RecNum);
  91.     else
  92.       IString := '';
  93.       Exit;
  94.     end;
  95.     if RecIsCurrent then
  96.       IString[PadLen] := #16;
  97.   end;
  98.   {$F-}
  99.  
  100. begin
  101.   ClrScr;
  102.   if not MLPL.InitDeluxe(3, 5, 77, 16, DefaultColorSet,
  103.                          DefWindowOptions or wBordered,
  104.                          25,           {Each column is 25 characters wide}
  105.                          100,          {There are 100 records total}
  106.                          4,            {Each record has 4 fields}
  107.                          MLStringProc,
  108.                          DefPickOptions) then Halt;
  109.   MLPL.wFrame.AddScrollBar(frBB, 0, MaxLongInt, DefaultColorSet);
  110.   MLPL.wFrame.AddHeader(' Mailing Label Pick List ', heTC);
  111.   MLPL.AddMoreHeader('    ', heTR, #27, #26, '', 2, 3, 0);
  112.   MLPL.SetPadSize(1, 1);
  113.   MLPL.SetSearchMode(PickAltStringSearch);
  114.   MLPL.Process;
  115.   MLPL.Erase;
  116.   if MLPL.GetLastCommand = ccSelect then
  117.     WriteLn('You chose record ', MLPL.Item2Record(MLPL.GetLastChoice));
  118.   MLPL.Done;
  119. end.
  120.  
  121.  
  122.