Mega Code Archive
The list box got a new face
<![CDATA[
Title: The list box got a new face
Question: I am tiered of the old same looking style of the ListBox control. I want something with a modern look and feel as found it in current commercial software?
Answer:
Here I am continuing the series I started on how to give your common used
controls a better look and feel. See my previous articles:
Give
your menu Office XP style (2246)
Transparent Grid (1921)
The code I presenting here targeting the ListBox control. If you are
test-then-read person (like me) then go direct to the code listing , or just
download the example project files: http://www.shagrouni.com/english/software/xlist.html
Little intro:
Windows native implementation of the list box control doesn't change much in
visual aspects since version 3.1 (except for 3D border and scroll bar, I guess),
fortunately, Windows leaves the door open for us to introduce our own painting
and override the default through OWNER-DRAW style. Borland made a good decision,
since Delphi 1, to incorporate methods to deal with this style for most of the
windows owner-draw controls.
The goal:
The code purpose is to provide a list box with appearance and behavior can be
defined and controlled by us from within our application.
The code tries to implement the following characteristics:
Multi-color/font list box to reflect different states.
Multi line items with proportional and varying heights.
Hot tracking style on mouse move.
Bitmaps associated with items.
Near to zero flickering.
Preserve Bi-Directional functionality.
The method:
The method is simple, and can be applied in many other controls: Whenever
Windows need to paint a control, it will issue messages to the application, so
the application can take the responsibility and provide its own implementation
of drawing the control.
The main information Windows send is the rectangle of the portion of control
to be pained, and the corresponding item identity.
For our case, the list box, we first set the property style of the list box
to either lbOwnerDrawFixed, or lbOwnerDrawVariable, this will
force Delphi to create the list box with the new style, and internally informs
Windows about the procedure that will take care of the painting, so Windows can
take it into account to send the needed information to this procedure whenever a
control needs to be drawn. This procedure is the event handler that we will take
care in onDrawItem event of the list box.
Once we have the coordinates (rect) of the item on the control s surface, we
can apply any drawing methods on it by using Delphi canvas methods, or by a
direct call to Windows API functions.
Code layout:
The code is not just an example or a how-to tip; my intention for the code is
to be a workable solution that can be plugged into a real application without
extra hassles. For this reason, you will see that the main procedures are
independent to the form class, global variables are avoided, the procedures can
be moved to other units (libraries, components,..) with less pain, plus taking
care (as possible) to preserve reliability, and the general list box
functionality. Beginners to Delphi can deal with the code as a black box, aside
from their own event handlers, so they can feel safe while approaching the
code.
Any way, a more dictated work, with less restriction, can be done if we move
this code to be a base for an independent component.
To demonstrate the code we need a ListBox with few items, style property set
to lbOwnerDrawVariabl and an image control with a small bmp picture.
The code has four main procedures, each one will be called from within a list
box respective event (except ListBoxRefresh ).
Procedure: ListBoxDrawItem
To be called from onDrawItem event. This event handler will not
take effect unless we set the style property to lbOwnerDrawFixed or
lbOwnerDrawVariable .
This procedure is responsible for drawing each item according to its state,
it will draw an image alongside each items text.
Procedure: ListBoxMeasureItem
We will call this procedure from onMeasureItem event, This event
will fire upon list box creation, if the list box has
lbOwnerDrawFixed style, the event will occur once for the first item,
the rest items will have the same height. If the style is
lbOwnerDrawVariable, the event will occur for each item in the list
box. The procedure ListBoxMeasureItem will calculate the height of
the corresponding item according to text length/font, list box width and width
of the bitmap.
This procedure will be called by ListBoxRefresh
also.
Procedure: ListBoxMouseMove
Called from onMouseMove event handler, this procedure is
responsible for drawing hot track effect on mouse movement over the item
content, you can bypass it if you want to discard this feature, otherwise,
this is the place where you can put interesting and funny effects upon mouse
move, for example, you can draw shaded text or shift the coordinates of
drawing to get waving effect.
Procedure: ListBoxRefresh
To update the dimensions of the items upon the list box new width.
For each item; the procedure call ListBoxMeasureItem to get the height the
item should have, then pass the new height to Windows through the message
LB_SETITEMHEIGHT .
We only need to call this procedure If the list box is subject to resizing
during the program run, and has a variable item height style
(lbOwnerDrawVariable), in this case we need to refresh the list box
to measure the height of each item according to the new width. Because the
list box in our example is aligned to the client area of a resizable form, we
call ListBoxRefresh from resize event handler of the
form.
Notes:
As I mentioned before, I tried to avoid global variable, the only work
around is the value stored in tag property of the list box, to track the last
painted item.
A multi-columns list box doesnt support owner draw style, instead, it
proceed the default drawing regardless of the list style, and the event
onDrawItem will not be fired.
The decision for the font and color choices is really difficult, so I will
count on you to choose your own. Dont take the code as an example for your
color choice. The colors chosen in the code are just for demonstration purpose
of what we can do in our lists.
The code tested with Delphi 5/ Win98, apparently and hopefully, it will
work in other versions and environments, if not, Ill be obligated to send me
a note/modification.
Hope you'll enjoy it.
Code listing:
unit fXList;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Image1: TImage;
Label1: TLabel;
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormResize(Sender: TObject);
private
public
end;
procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState; Image: TBitmap );
procedure ListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer; Image: TBitmap);
procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: integer; Image: TBitmap);
procedure ListBoxRefresh(Control: TWinControl; Image: TBitmap);
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
ListBoxDrawItem(Control, Index, Rect, State, Image1.Picture.Bitmap );
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl;
Index: Integer;
var Height: Integer);
begin
ListBoxMeasureItem(Control, Index, Height, Image1.Picture.Bitmap);
end;
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ListBoxMouseMove(Sender, Shift, X, Y, Image1.Picture.Bitmap);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
ListBoxRefresh (ListBox1, Image1.Picture.Bitmap);
end;
procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState; Image: TBitmap);
var
s: string;
R: Trect;
lst: TlistBox;
Ident: integer;
sOption: integer;
begin
if Index = -1 then exit;
lst:= TlistBox(Control);
if lst.Style = lbStandard then exit;
R := ARect;
if R.Top lst.Height then exit;
S := lst.Items[Index];
sOption := 0;
case lst.BiDiMode of
bdLeftToRight: sOption := 0;
bdRightToLeft: sOption := DT_RIGHT + DT_RTLREADING;
bdRightToLeftNoAlign: sOption := DT_RTLREADING;
bdRightToLeftReadingOnly: sOption := DT_RTLREADING;
end;
if lst.Style = lbOwnerDrawVariable then
sOption := sOption + DT_WORDBREAK + DT_EDITCONTROL ;
if Image nil then
Ident := Image.Width + 4
else
Ident := 2;
if lst.BiDiMode = bdRightToLeft then
Dec(R.Right, Ident)
else
Inc(R.Left, Ident);
lst.Canvas.Font := lst.Font ;
lst.Canvas.Brush.Color := lst.color;
if odSelected in state then
begin
lst.Canvas.Font.Color := clWhite;
lst.Canvas.Brush.Color := $00E7A66B;
end;
if (odFocused in state) and (odSelected in state) then
begin
lst.Canvas.Brush.Color := $00C4500B;
lst.Canvas.Font.Color := clWhite;
end;
if not (odDefault in state) then
lst.Canvas.FillRect (Arect)
else
lst.Canvas.FillRect (R);
Drawtext(lst.Canvas.Handle, PChar(s), length(s), R, sOption);
R := ARect;
if lst.BiDiMode = bdRightToLeft then
R.Left := R.Right - Ident + 2
else
Inc(R.Left, 2);
R.Right := R.Left + Image.Width;
if not (odDefault in state) then
lst.Canvas.Draw (R.Left, R.top + 1, Image);
end;
procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: integer; Image: TBitmap);
var
APoint: TPoint;
Index: integer;
lst: TListBox;
s: string;
R: Trect;
Ident: integer;
sOption: integer;
X1,X2: integer;
begin
lst:= TlistBox(Sender);
if lst.Style = lbStandard then exit;
X1 := 0; // just to stop editor hint nagging.
X2 := 0;
if Image nil then
Ident := Image.Width + 2
else
Ident := 2;
APoint.X := X;
APoint.Y := Y;
Index := lst.ItemAtPos(APoint, True);
R := lst.ItemRect(Index);
if Index -1 then
begin
X2 := lst.Canvas.TextWidth (lst.Items[Index]);
if lst.BiDiMode = bdRightToLeft then
X1 := r.Right - X2 - Image.Width - 4
else
X1 := r.Left + Image.Width + 4;
X2 := X1 + X2;
end;
if (ssLeft in Shift) then exit;
if (x or (x X2) then
begin
lst.Cursor := crDefault;
if Index = lst.ItemIndex then exit;
if lst.Tag = lst.ItemIndex then exit;
if lst.Tag -1 then
begin
if lst.Selected[lst.Tag] then
ListBoxDrawItem(lst, lst.Tag, lst.ItemRect(lst.Tag),
[odSelected], Image)
else
ListBoxDrawItem(lst, lst.Tag, lst.ItemRect(lst.Tag),
[odDefault], Image);
lst.Tag := -1;
end;
exit;
end;
if (lst.Tag = Index) and (lst.Cursor = crHandPoint) then
exit; // Drawn before
lst.Cursor := crHandPoint;
sOption := 0;
case lst.BiDiMode of
bdLeftToRight: sOption := 0;
bdRightToLeft: sOption := DT_RIGHT + DT_RTLREADING;
bdRightToLeftNoAlign: sOption := DT_RTLREADING;
bdRightToLeftReadingOnly: sOption := DT_RTLREADING;
end;
if lst.Style = lbOwnerDrawVariable then
sOption := sOption + DT_WORDBREAK + DT_EDITCONTROL;
if lst.ItemIndex Index then
begin
R := lst.ItemRect(Index);
S := lst.Items[Index];
if lst.BiDiMode = bdRightToLeft then
Dec(R.Right, Ident + 2)
else
Inc(R.Left, Ident + 2);
if lst.Selected[Index] then
lst.Canvas.Font.Color := clWhite
else
lst.Canvas.Font.Color := clBlue;
lst.Canvas.Font.Style := lst.Font.Style + [fsUnderLine];
SetBkModE(lst.Canvas.Handle, TRANSPARENT);
Drawtext(lst.Canvas.Handle, PChar(s), length(s), R, sOption);
end;
if not (ssMiddle in Shift) and
(lst.Tag -1) and
(lst.Tag Index) and
(lst.Tag lst.ItemIndex) then //What? Do you need more?
if lst.Selected[lst.Tag] then
ListBoxDrawItem(lst, lst.Tag, lst.ItemRect(lst.Tag),
[odSelected], Image)
else
ListBoxDrawItem(lst, lst.Tag, lst.ItemRect(lst.Tag),
[odDefault], Image);
lst.Tag := Index;
end;
procedure ListBoxRefresh(Control: TWinControl; Image: TBitmap);
var
lst: TListBox;
i, Count, H: integer;
begin
lst := TListBox(Control);
if lst.Style = lbStandard then exit;
if lst.Style = lbOwnerDrawFixed then
Count := 1
else
Count := lst.Items.Count - 1;
for i := 0 to Count - 1 do
begin
ListBoxMeasureItem(lst, i, H, Image);
lst.Perform (LB_SETITEMHEIGHT, i, MAKELPARAM(H, 0));
end;
lst.refresh;
end;
procedure ListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer; Image: TBitmap );
var
s: string;
lst: TListBox;
R: TRect;
sOption: integer;
begin
lst := TListBox(Control);
if lst.Style = lbStandard then exit;
sOption := 0;
case lst.Style of
lbStandard:
begin
Height := lst.ItemHeight;
exit;
end;
lbOwnerDrawFixed: sOption := 0;
lbOwnerDrawVariable: sOption := DT_WORDBREAK;
end;
R := lst.ClientRect;
Dec(R.Right, Image.width + 4 );
S := lst.Items[Index];
lst.Canvas.Font.Assign(lst.Font);
Height := DrawTextEx(lst.Canvas.Handle,
PChar(s),
length(s),
R,
sOption or DT_CALCRECT or DT_EXTERNALLEADING,
nil);
Inc(Height, 4);
if (Image.Height + 2) Height then
Height := Image.Height + 2;
end;
end.
]]>