home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / LOOKUP.ZIP / LOOKUP.PAS < prev   
Pascal/Delphi Source File  |  1994-02-02  |  4KB  |  109 lines
  1. {*************************************************}
  2. {                                                 }
  3. {  Lookup List Box Object Unit                    }
  4. {  Copyright (c) 1994 Timothy J. Wollin           }
  5. {                                                 }
  6. {  Rev 1.0                                        }
  7. {                                                 }
  8. {  Description: Contains TLookUpListBox Object-   }
  9. {   A ListBox that can search for a string entered}
  10. {   via keyboard and captured via WM_Char for the }
  11. {   closest match. Moves the Caret to the closest }
  12. {   match. Allows quick scaning of a listboxes'   }
  13. {   contents. Has a Type Ahead Buffer of Size 80. }
  14. {                                                 }
  15. {  Objects:                                       }
  16. {                                                 }
  17. {  TLookUpListBox: The Lookup ListBox Object      }
  18. {                                                 }
  19. {*************************************************}
  20.  
  21.  
  22. unit LookUpLB;
  23.  
  24. interface
  25.  
  26. uses WinTypes, WinProcs, Objects, OWindows, ODialogs;
  27.  
  28. type
  29.      PLookUpListBox = ^TLookUpListBox;
  30.      TLookUpListBox = object(TListBox)
  31.       constructor Init(AParent: PWindowsObject; AnId: Integer; X,Y,W,H: Integer);
  32.       constructor InitResource(AParent:PWindowsObject; ResourceID: integer);
  33.       procedure   InitDefs; virtual;
  34.       procedure   WMChar(var Msg: TMessage); virtual wm_First + wm_Char;
  35.      private
  36.       OldSel: Longint;          {The Old Selection of the List Box}
  37.       CharCount: Boolean;       {Have We Recursed throught WMChar Already?}
  38.       Buffer: array[0..79] of char;   {Type Ahead Buffer}
  39.      end;
  40.  
  41. implementation
  42.  
  43. uses Strings;
  44.  
  45. constructor TLookUpListBox.Init(AParent: PWindowsObject; AnId: Integer; X,Y,W,H: Integer);
  46. begin
  47.      inherited Init(AParent, AnId, X,Y,W,H);
  48.      InitDefs  {Set the Defaults}
  49. end;
  50.  
  51. constructor TLookUpListBox.InitResource(AParent:PWindowsObject; ResourceID: integer);
  52. begin
  53.      inherited InitResource(AParent, ResourceID);
  54.      InitDefs; {Set the Defaults}
  55. end;
  56.  
  57. procedure TLookUpListBox.InitDefs;
  58. begin
  59.      OldSel := LB_ERR;           {Set OldSel to LB_ERR = -1}
  60.      CharCount := False;         {Have not Recursed throught WMChar yet}
  61. end;
  62.  
  63. procedure TLookUpListBox.WMChar(var Msg: TMessage);
  64. var Result: Longint; {SendMessage() Result}
  65. begin
  66.      if UpCase(Char(Msg.wParam)) in['A'..'Z'] then
  67.       {Check if Char is an Alpha Character}
  68.      begin
  69.        {Get the Current ListBox Selection}
  70.        Result := SendMessage(HWindow, LB_GetCurSel, 0, 0);
  71.        if Result <> LB_ERR then      {Check to See if an Item in LB Selected}
  72.         if OldSel <> Result then     {Is it a Different Selection than Old}
  73.         begin
  74.           Buffer[0] := #0;           {If So then Reset Buffer}
  75.           OldSel := Result;          {UpDate OldSel to the New Selection}
  76.           StrCat(Buffer, PChar(@Char(Msg.wParam))) {Store New Char in Buffer}
  77.         end
  78.         else {if Same Selection...}
  79.         begin
  80.           if StrLen(Buffer) < 80 then  {Add Char to Buffer End if Buffer}
  81.             StrCat(Buffer, PChar(@Char(Msg.wParam))) {is not Full Else}
  82.           else
  83.             Buffer[0] := #0;                         {Reset Buffer}
  84.         end;
  85.      end;
  86.  
  87.      {Tell ListBox to Find the Closest Match to Buffer.}
  88.      {Start at List Begining}
  89.      Result := SendMessage(HWindow, LB_FindString, Word(LB_ERR), Longint(@Buffer));
  90.      if Result <> LB_ERR then {If Match then Set Current Selection to Match}
  91.      begin
  92.        Result := SendMessage(HWindow, LB_SetCurSel, Lo(Result), 0);
  93.        OldSel := Result;              {UpDate OldSel to New Selection}
  94.        CharCount := False;            {Set Recursive indicator to False}
  95.      end
  96.      else  {No Match Found So...}
  97.      begin
  98.       OldSel := Result;  {Set OldSel to New Selection; ie LB_ERR}
  99.       if not CharCount then {Have We been Here Before???}
  100.       begin
  101.         CharCount := True;  {No, So set Recursive Indicator to True and}
  102.         SendMessage(HWindow, WM_Char, Msg.wParam, 0); {Call Self w/ Char}
  103.       end
  104.       else
  105.         CharCount := False; {Have Been Here Before So Reset Process}
  106.      end;
  107. end;
  108.  
  109. end.