dsListBox (part 2) |
{
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;