ListBox - usando o ownerdraw

{

 Esta tela tem uma listbox e um timage.

 mostra como usar o ownerdraw da listbox

 Setar ListBox.Style := lbOwnerDrawFixed

}

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 < X1) 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.