{
This list box shows hints for items that are too long. OnMouseLeave is
also implemented.
}

{
TdsListBox2 (hint for long strings)

Let's start with a new project, save it into desired folder and declare
some vital things for our list box.
}

type
  TdsListBox2 = class(TListBox)
  private
    ItemOldPos: Integer;
    FClickedItem: Integer;

    FHintWinVisible: Boolean;
    FHintForLongStrings: Boolean;

    FOnMouseLeave: TNotifyEvent;
  protected
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure DoMouseLeave;
  public
    HintWin: THintWindow;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure DefaultHandler(var Message); override;
  published
    property HintForLongStrings: Boolean read FHintForLongStrings write FHintForLongStrings;

    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

{
Ancestor for our TdsListBox1 will be TListBox.

We will have a property for hint for long strings, as well a event for mouse
leave. Why other things are there you'll see later on.

Constructor is one thing I almost always override. This project is no exception.
}

constructor TdsListBox2.Create(AOwner: TComponent);
begin
  inherited;
  FClickedItem := -1;

  FHintForLongStrings := true;

  HintWin := THintWindow.Create(Self);
  HintWin.Color := clInfoBk;
  HintWin.Canvas.Font.Color := clInfoText;
end;

{
We create hint window in here and set show hint for long strings to true by
default. FClickedItem is just a helper.
}

destructor TdsListBox2.Destroy;
begin
  HintWin.Free;

  inherited;
end;

{
As we createded hint window in the constructor, we shold destroy it in the
destructor although it's not neccessary as hint window has it's owner and
will be destroyed when his owner will be destroyed.

For the mouse leave event, we need to do two things. First of all, we have
to write message handler for the CM_MOUSELEAVE.
}

procedure TdsListBox2.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  HintWin.ReleaseHandle;
  FHintWinVisible := false;
  DoMouseLeave;
end;

{
It's nice to write the Delphi way, so we will only call DoMouseLeave here.
This procedure is virtual, so anyone can override it. All that it does,
calls event handler if it's assigned.
}

procedure TdsListBox2.DoMouseLeave;
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

{
Now the big one. We override MouseMove and in there, we must test if item is
too long and if so, show hint. I won't go into details here as code should
be quite clear.
}

procedure TdsListBox2.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  R: TRect;
begin
  inherited;

  if FHintForLongStrings then
  begin
    // Get the index of the item under the mouse pointer
    i := ItemAtPos(Point(X,Y), true);

    if ItemOldPos <> i then FHintWinVisible := false;

    if i = -1 then
    begin
      HintWin.ReleaseHandle;
      FHintWinVisible := false;
      Exit;
    end;

    if i = FClickedItem then
    begin
      Exit;
    end
    else
      FClickedItem := -1;

    // Check if the Item Text is wider then the cliprectangle
    if Canvas.TextWidth(Items[i]) > ((Canvas.ClipRect.Right - Canvas.ClipRect.Left) - 3) then
    begin
      // Get the default item coordinates
      R := ItemRect(i);
      // Stretch it to fit the whole item text
      R.Right := R.Left + Canvas.TextWidth(Items[i]) + 9;
      // Fine tune these values for apperance
      R.Top := R.Top - 3;
      R.Bottom := R.Bottom - 1;
      R.Left := R.left - 1;
      // now convert to screen coordinates so that THintWindow can use them
      R.TopLeft := ClientToScreen(R.TopLeft);
      R.BottomRight := ClientToScreen(R.BottomRight);
      // And show
      if not FHintWinVisible then
      begin
        HintWin.ActivateHint(R, items[i]);
        FHintWinVisible := true;
        ItemOldPos := i;
      end;
    end
    else
    begin
      HintWin.ReleaseHandle;
      FHintWinVisible := false;
    end;
  end;
end;

{
There is one thing we have to override. DefaultHandler. That is the last place
where one could answer to the messages that are sent to the control.
What we want to do here is hide hint window if mouse is over scroll bar.
}

procedure TdsListBox2.DefaultHandler(var Message);
var
  MsgT: TMsg;
begin
  MsgT.message := TMessage(Message).Msg;

  inherited;

  if HintWin = nil then Exit;

  if (MsgT.message = WM_VScroll) or
     (HintWin.IsHintMsg(MsgT) and (MsgT.message <> WM_MouseMove)) then
  begin
    HintWin.ReleaseHandle;
    FHintWinVisible := false;
  end;
end;

{
And one more thing. If user selects an item over which hint window is
displayed, we should hide that hint window. For that, we override MouseDown.
}

procedure TdsListBox2.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  FClickedItem := ItemIndex;
  HintWin.ReleaseHandle;
  FHintWinVisible := false;
  Screen.ActiveForm.Update; //repaint invalidated region of the active form immediately
end;

{
To test our list box, you could write this into forms OnCreate.
}

procedure TForm1.FormCreate(Sender: TObject);
var
  l: TdsListBox2;
begin
  l := TdsListBox2.Create(Self);
  l.Parent := Self;
  l.Left := 50;
  l.top := 50;
  l.Width := 100;
  l.Height := 150;
  l.Items.Add('item 0 should be long');
  l.Items.Add('item 1');
  l.Items.Add('item 2');
  l.Items.Add('item 3 should be long one');
  l.Items.Add('item 4 is long as well');
  l.Items.Add('item 5');
  l.Items.Add('item 6');
  l.Items.Add('item 7');
  l.Items.Add('item 8');
  l.Items.Add('item 9');
  l.Items.Add('item 10 yet another long item');
  l.Items.Add('item 11');
  l.Items.Add('item 12');
  l.Items.Add('item 13');
  l.Items.Add('item 14');
  l.Items.Add('item 15 is the last long item');
end;