home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DBRWS102.ZIP / DBROWSE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-12-11  |  12.2 KB  |  362 lines
  1. {$D+,F+,O+,R+,S-}
  2. {$DEFINE VBROWSER}  {If activated, descend from VBrowser instead of FBrowser.}
  3.  
  4.  
  5. UNIT DBrowse;
  6.  
  7.  
  8. {
  9.          Version 1.00 released on 14 February 1991
  10.          Version 1.01 released on  4 July     1991
  11.          Version 1.02 released on 11 December 1992
  12.  
  13.          Written by a guy named Rob Rosenberger (who?)
  14.                                 Barn Owl Software
  15.                                 P.O. Box 1115
  16.                                 O'Fallon, IL 62269
  17.  
  18.          CompuServe userID 74017,1344
  19.  
  20.    An OOP descendent unit for TurboPower Software FBROWSE.TPU users who want
  21. to offer an incremental-key positioning capability by overriding the default
  22. CharHook() method in FBrowse objects.
  23.  
  24.    DBrowse offers one descendent object called DataDefBrowser for overriding
  25. the FBrowser CharHook() method.
  26.  
  27.    DataDefBrowser implements a SetCurrentRecordAndPos() method used by the
  28. replacement CharHook() to display the incremental record in the center of the
  29. screen or to move the highlight bar if already on the screen.
  30.  
  31.    By default, DataDefBrowser uses header index zero, the first AddHeader()
  32. command you issue, to display the current incremental key string.  You can
  33. make DataDefBrowser use a different header index by issuing the following
  34. commands:
  35.  
  36.     MyDBrowser.wFrame.AddHeader(...);
  37.     MyDBrowser.dbrHdrIndex := MyDBrowser.wFrame.GetLastHeaderIndex;
  38.  
  39.    You can disable header updates by setting dbrHdrIndex to a value of 255 or
  40. by simply not adding any headers to the frame.
  41.  
  42.    DBrowse's initialization code modifies the FBrowserCommands object so it
  43. recognizes the backspace key as a ccChar command.  This lets DBrowse intercept
  44. it via the CharHook() method so the user can correct any typing mistakes.  If
  45. you Load() FBrowserCommands from disk (like I do) or use an alternate command
  46. processor, you must issue an appropriate call to AddCommand() to change the
  47. backspace to a ccChar.
  48.  
  49.  
  50. Version 1.01 changes:
  51.    Corrected occasional tendency to leave frame droppings behind.
  52.    Renamed InitCustom()'s "ValidKeys" variable to "IncrKeys" for readability.
  53.      Has no effect on anyone who uses InitCustom().
  54.  
  55. Version 1.02 changes:
  56.    Upgraded the source code to compile under BP7 and BTREE 5.4x.  Also, the
  57.      new 5.4x docs claim MaxNrOfKeys now goes up only to 254, meaning we can
  58.      service the entire range.  (Previous BTREE versions let you use up to
  59.      750 keys at once.  I assume TurboPower switched it to a byte variable in
  60.      order to achieve memory savings somewhere.  Besides, I can't conceive of
  61.      a situation where you'd need >254 keys!)}
  62.  
  63.  
  64. INTERFACE {section}
  65.  
  66.  
  67. USES
  68.    OpKey,
  69.    OpString,
  70.      OpCRT,
  71.        OpCmd,
  72.  
  73.    Filer,
  74.      FBrowse;
  75.  
  76.  
  77. TYPE
  78.    KeySeriesSet = SET OF 1..MaxNrOfKeys;
  79.  
  80.    DataDefBrowserPtr = ^DataDefBrowser;
  81.    DataDefBrowser
  82. {$IFDEF VBROWSER}
  83.      = OBJECT(VBrowser)
  84. {$ELSE}
  85.      = OBJECT(FBrowser)
  86. {$ENDIF}
  87.        dbrHdrIndex    : BYTE;
  88.        IncrementalKey : IsamKeyStr;
  89.        MaxIncKeyLen   : BYTE;
  90.        ValidIncKeys   : KeySeriesSet;
  91.  
  92.        CONSTRUCTOR InitCustom(X1          : BYTE;
  93.                               Y1          : BYTE;
  94.                               X2          : BYTE;
  95.                               Y2          : BYTE;
  96.                           VAR Colors      : ColorSet;
  97.                               Options     : LONGINT;
  98.                               IFBPtr      : IsamFileBlockPtr;
  99.                               KeyNum      : INTEGER;
  100.                           VAR DatS;
  101.                               MaxRows     : BYTE;
  102.                               RowsPerItem : BYTE;
  103.                               MaxCols     : WORD;
  104.                               MaxIncLen   : BYTE;
  105.                               IncrKeys    : KeySeriesSet);
  106.  
  107.        PROCEDURE Process; VIRTUAL;
  108.        PROCEDURE SetCurrentRecordAndPos(Key     : IsamKeyStr;
  109.                                         Ref     : LONGINT;
  110.                                         ItemPos : BYTE);
  111.  
  112.        {Following public methods not for application programs.}
  113.        PROCEDURE CharHook; VIRTUAL;
  114.        PROCEDURE UpdateHeaders; VIRTUAL;
  115.        END;
  116.  
  117.  
  118. IMPLEMENTATION {section}
  119.  
  120.  
  121. CONST
  122.    NullChar   = #0;
  123.    NullString = '';
  124.    SpaceChar  = ' ';
  125.  
  126.  
  127. {============================================================================}
  128. CONSTRUCTOR DataDefBrowser.InitCustom(X1          : BYTE;
  129.                                       Y1          : BYTE;
  130.                                       X2          : BYTE;
  131.                                       Y2          : BYTE;
  132.                                   VAR Colors      : ColorSet;
  133.                                       Options     : LONGINT;
  134.                                       IFBPtr      : IsamFileBlockPtr;
  135.                                       KeyNum      : INTEGER;
  136.                                   VAR DatS;
  137.                                       MaxRows     : BYTE;
  138.                                       RowsPerItem : BYTE;
  139.                                       MaxCols     : WORD;
  140.                                       MaxIncLen   : BYTE;
  141.                                       IncrKeys    : KeySeriesSet);
  142.  
  143. BEGIN {DataDefBrowser.InitCustom}
  144. IF INHERITED InitCustom(X1,Y1,X2,Y2,
  145.                         Colors,
  146.                         Options,
  147.                         IFBPtr,
  148.                         KeyNum,
  149.                   {VAR} DatS,
  150.                         MaxRows,
  151.                         RowsPerItem,
  152.                         MaxCols)
  153.  THEN
  154.     BEGIN
  155.     dbrHdrIndex    := 0;
  156.     IncrementalKey := NullString;
  157.     IF (MaxIncLen = 0)
  158.      THEN MaxIncKeyLen := MaxKeyLen
  159.      ELSE MaxIncKeyLen := MaxIncLen;
  160.     ValidIncKeys   := IncrKeys
  161.     END
  162.  ELSE
  163.     FAIL
  164. END; {DataDefBrowser.InitCustom}
  165. {============================================================================}
  166.  
  167. {============================================================================}
  168. PROCEDURE DataDefBrowser.Process;
  169.  
  170. BEGIN {DataDefBrowser.Process}
  171. IncrementalKey := NullString;
  172. UpdateHeaders;
  173. INHERITED Process;
  174. UpdateHeaders
  175. END; {DataDefBrowser.Process}
  176. {============================================================================}
  177.  
  178. {============================================================================}
  179. PROCEDURE DataDefBrowser.SetCurrentRecordAndPos(Key     : IsamKeyStr;
  180.                                                 Ref     : LONGINT;
  181.                                                 ItemPos : BYTE);
  182.  
  183.     {Set the current record to a specific position on the screen.  NOTE: this
  184. does no repositioning if a given record is on the screen at a different spot.
  185. This helps avoid needless screen repositioning.}
  186.  
  187. VAR
  188.    DI    : WORD;
  189.    Index : WORD;
  190.  
  191. BEGIN {DataDefBrowser.SetCurrentRecordAndPos}
  192. {Initialize.}
  193. IF (ItemPos < 1)
  194.  THEN ItemPos := 1;
  195. IF (ItemPos > (Height DIV fbRowsPerItem))
  196.  THEN ItemPos := (Height DIV fbRowsPerItem);
  197.  
  198. {Is record already displayed?}
  199. DI := fbDisplayItems;
  200. IF (fbItemRecs^[1].irRef <> 0)
  201.  THEN
  202.     FOR Index := 1 TO DI
  203.      DO WITH fbItemRecs^[Index]
  204.          DO IF ((irRef = Ref) AND (Key = irKey))
  205.              THEN
  206.                 BEGIN
  207.                 IF (Index <> fbCurItem)
  208.                  THEN fbGotoItem(Index);
  209.                 EXIT {no need to hang around here, eh?}
  210.                 END;
  211.  
  212. {Set current item, etc.}
  213. IF (Ref <> fbCurRef)
  214.  THEN fbCurItem := ItemPos;
  215. fbCurKey := Key;
  216. fbCurRef := Ref;
  217.  
  218. {Mark the screen as empty.}
  219. fbEmptyBrowScreen;
  220.  
  221. {Update the screen if the window is current.}
  222. IF IsCurrent
  223.  THEN UpdateContents
  224. END; {DataDefBrowser.SetCurrentRecordAndPos}
  225. {============================================================================}
  226.  
  227. {============================================================================}
  228. PROCEDURE DataDefBrowser.CharHook;
  229.  
  230.    {Translate keyboard chars into incremental key searches.  Notice how we
  231. first convert a space to a null char, and convert it back to a space only if
  232. we don't find a match?
  233.    Suppose the user searches for "xxxx<null>yyy" and it happens to exist as
  234. the very last key.  If we searched for "xxxx<space>" first, we'd get error
  235. 10210 telling us no key exists AND NO GREATER KEY EXISTED as a substitute!  A
  236. rather obscure condition, of course, but it pays to convert to a null first
  237. and convert back to the original space only if necessary.  Otherwise people
  238. might call you with bug reports.}
  239.  
  240. VAR
  241.    TempKeyStr : IsamKeyStr;
  242.    TempRecord : LONGINT;
  243.  
  244. BEGIN {DataDefBrowser.CharHook}
  245. {Is this a valid key for incremental searching?}
  246. IF NOT (GetKeyNumber IN ValidIncKeys)
  247.  THEN EXIT; {no need to hang around here, eh?}
  248.  
  249. {Deal with incremental keystroke.}
  250. CASE GetLastKey OF
  251.   BkSp :
  252.     IF (LENGTH(IncrementalKey) >= 1)
  253.      THEN DEC(IncrementalKey[0]);
  254.   Space :
  255.     IncrementalKey := (IncrementalKey + NullChar)
  256.   ELSE
  257.     IncrementalKey := (IncrementalKey + UPCASE(CHAR(LO(GetLastKey))))
  258.  END; {CASE}
  259.  
  260. {Trim the incremental key if it's too long.}
  261. IF (LENGTH(IncrementalKey) > MaxIncKeyLen)
  262.  THEN BYTE(IncrementalKey[0]) := MaxIncKeyLen;
  263.  
  264. UpdateHeaders;
  265.  
  266. {Move to closest match if we have an incremental key.}
  267. IF (IncrementalKey > NullString)
  268.  THEN
  269.     BEGIN
  270.     TempKeyStr := IncrementalKey;
  271.     BTSearchKey(fbIFB,GetKeyNumber,{VAR} TempRecord,{VAR} TempKeyStr);
  272.     IF IsamOK
  273.      THEN
  274.         IF (POS(StUpCase(IncrementalKey),StUpCase(TempKeyStr)) = 1)
  275.          THEN
  276.             SetCurrentRecordAndPos(TempKeyStr,TempRecord,(Height DIV 2))
  277.          ELSE
  278.             BEGIN
  279.             DEC(IncrementalKey[0]);
  280.  
  281.             {Maybe they typed a space and really meant a space char?}
  282.             IF (CHAR(LO(GetLastKey)) = SpaceChar)
  283.              THEN
  284.                 BEGIN
  285.                 IncrementalKey := (IncrementalKey + SpaceChar);
  286.                 {Trim the incremental key if it's too long.}
  287.                 IF (LENGTH(IncrementalKey) > MaxIncKeyLen)
  288.                  THEN BYTE(IncrementalKey[0]) := MaxIncKeyLen;
  289.  
  290.                 {Move to closest match.}
  291.                 TempKeyStr := IncrementalKey;
  292.                 BTSearchKey(fbIFB,
  293.                              GetKeyNumber,
  294.                        {VAR} TempRecord,
  295.                        {VAR} TempKeyStr);
  296.                 IF IsamOK
  297.                  THEN
  298.                     IF (POS(StUpCase(IncrementalKey),
  299.                             StUpCase(TempKeyStr)) = 1)
  300.                      THEN
  301.                         SetCurrentRecordAndPos(TempKeyStr,
  302.                                                TempRecord,
  303.                                                (Height DIV 2))
  304.                      ELSE
  305.                         BEGIN
  306.                         DEC(IncrementalKey[0]);
  307.                         RingBell
  308.                         END
  309.                 END
  310.              ELSE
  311.                 RingBell;
  312.  
  313.             UpdateHeaders
  314.             END
  315.      ELSE
  316.         BEGIN
  317.         {Probably error 10210, no matching key & no greater key.}
  318.         DEC(IncrementalKey[0]);
  319.         RingBell;
  320.         UpdateHeaders
  321.         END
  322.     END
  323.  {ELSE don't move anywhere}
  324. END; {DataDefBrowser.CharHook}
  325. {============================================================================}
  326.  
  327. {============================================================================}
  328. PROCEDURE DataDefBrowser.UpdateHeaders;
  329.  
  330. VAR
  331.    Redraw : BOOLEAN;
  332.  
  333. BEGIN {DataDefBrowser.UpdateHeaders}
  334. WITH wFrame
  335.  DO IF ((dbrHdrIndex < 255)
  336.      AND (GetLastHeaderIndex < 255)
  337.      AND IsCurrent)
  338.      THEN
  339.         BEGIN
  340.         {Modify dbrHdrIndex'th string to show the incremental key.}
  341.         IF (IncrementalKey = NullString)
  342.          THEN
  343.             IF ((GetKeyNumber IN ValidIncKeys) AND IsCurrent)
  344.              THEN ChangeHeaderString(dbrHdrIndex,'╡INCR KEY╞',{VAR} Redraw)
  345.              ELSE ChangeHeaderString(dbrHdrIndex,NullString,{VAR} Redraw)
  346.          ELSE
  347.             ChangeHeaderString(dbrHdrIndex,
  348.                                ('╡KEY "' + IncrementalKey + '"╞'),
  349.                          {VAR} Redraw);
  350.  
  351.         IF Redraw
  352.          THEN UpdateFrame
  353.          ELSE DrawHeader(dbrHdrIndex)
  354.         END
  355. END; {DataDefBrowser.UpdateHeaders}
  356. {============================================================================}
  357.  
  358.  
  359. BEGIN
  360. FBrowserCommands.AddCommand(ccChar,1,BkSp,0)
  361. END. {DBrowse}
  362.