home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2000 August / DPPCPRO0800.ISO / RWC / Prog70Disk.exe / ListBoxEx.pas
Encoding:
Pascal/Delphi Source File  |  2000-04-25  |  2.1 KB  |  82 lines
  1. unit ListBoxEx;
  2.  
  3. interface
  4.  
  5. uses Windows, Messages, Classes, Controls, Graphics, StdCtrls, Forms;
  6.  
  7. type
  8.     TListBoxOptions = class (TPersistent)
  9.     private
  10.         fHintColor: TColor;
  11.     published
  12.         property HintColor: TColor read fHintColor write fHintColor default clInfoBk;
  13.     end;
  14.  
  15.     TListBoxEx = class (TListBox)
  16.     private
  17.         fLastHintIdx: Integer;
  18.         fOptions: TListBoxOptions;
  19.         procedure CMHintShow (var Msg: TCMHintShow); message cm_HintShow;
  20.     protected
  21.         procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
  22.     public
  23.         constructor Create (AOwner: TComponent); override;
  24.         destructor Destroy; override;
  25.     published
  26.         property Advanced: TListBoxOptions read fOptions write fOptions;
  27.     end;
  28.  
  29. procedure Register;
  30.  
  31. implementation
  32.  
  33. constructor TListBoxEx.Create (AOwner: TComponent);
  34. begin
  35.     Inherited Create (AOwner);
  36.     fOptions := TListBoxOptions.Create;
  37.     fOptions.fHintColor := clInfoBk;
  38.     fLastHintIdx := -1;
  39. end;
  40.  
  41. destructor TListBoxEx.Destroy;
  42. begin
  43.     fOptions.Free;
  44.     Inherited Destroy;
  45. end;
  46.  
  47. procedure TListBoxEx.CMHintShow (var Msg: TCMHintShow);
  48. var
  49.     ShowHint: Boolean;
  50. begin
  51.     ShowHint := False;
  52.     with Msg.HintInfo^ do if Self = HintControl then begin
  53.         HintStr := '';
  54.         HintColor := fOptions.fHintColor;
  55.         fLastHintIdx := CursorPos.y div ItemHeight;
  56.         if Items.Count > TopIndex + fLastHintIdx then HintStr := Items [TopIndex + fLastHintIdx];
  57.         HintPos := ClientToScreen (Point (0, (ItemHeight * fLastHintIdx) - 2));
  58.         ShowHint := Width < Canvas.TextWidth (HintStr) + 10;
  59.     end;
  60.  
  61.     Msg.Result := Ord (not ShowHint);
  62. end;
  63.  
  64. procedure TListBoxEx.MouseMove (Shift: TShiftState; X, Y: Integer);
  65. begin
  66.     if (fLastHintIdx >= 0) and (Y div ItemHeight <> fLastHintIdx) then begin
  67.     Application.CancelHint;
  68.         fLastHintIdx := -1;
  69.     end;
  70.  
  71.     Inherited MouseMove (Shift, X, Y);
  72. end;
  73.  
  74. procedure Register;
  75. begin
  76.     RegisterComponents ('Uncommon', [TListBoxEx]);
  77. end;
  78.  
  79. end.
  80.  
  81.  
  82.