用Delphi制作仿每行带按钮的列表

　Delphi做程序开发在使用到列表控件时，一般是列表放文本内容，在列表以外放操作按钮，选中列表某项再点按钮进行操作。现在Web开发做列表的样式总是列表的每行都有操作按钮，如微博的列表风格：

　　

　　Web开发常用这种风格，一来是用户找操作按钮的移动距离近，二来制作上也不麻烦，不过CS程序开发就很少能找到现成的控件可用了。

最近正好要做个类似的控件，虽然不是微博风格，但都是在列表上放按钮放图片的样式，做完之后总结了一下感觉列表上放神马已经都不在话下了，分享一下开发经验。

我们可以使用TListBox控件来完成这个需求，因为当TListBox的style属性设置为lbOwnerDrawVariable时，可以在DrawItem事件中对列表元素做完全的控制，相当于每个元素都是一张纸，可以绘制任意的内容。

研究阶段

　　虽然说可以绘制任意内容，那要是说纯粹去绘制复杂的图形难度还是很大的，经过研究总结后发现基本可以下两种方式绘制内容：

　　文字方面的，使用TCanvas直接绘制输出，比如上面的个人描述区域、按钮的文字；　　

　　

1 2 3 4 5 6 7 8 9 10 11 12 13

输出文字的代码片段： ACanvas.TextOut(Rect.Left + 55,  Rect.Top + 4 + FTxtHght * nRows, sln); 绘制按钮的代码片段： // 绘制边框， // EDGE_RAISED是凸起效果可用于表示按钮一般状态 // EDGE_ETCHED是凹进效果表示按下状态 // 至于鼠标经过状态，没有合适的线框可用，可以将边框扩大1像素InflateRect(rEdge, 1, 1); DrawEdge(Canvas.Handle, rEdge, EDGE_RAISED, BF_RECT); Canvas.FillRect(rBtn); // 绘制文字 SetBkMode(Canvas.Handle, TRANSPARENT); DrawText(Canvas.Handle, Caption,     Length(Caption), rBtn, DT_CENTER + DT_SINGLELINE + DT_VCENTER)

　　　非文字的，都是先做好图再用TCanvas把copy过来输出，比如头像、按钮图标，如果按钮要有背景色也是图片好些；   

1 2 3

绘制图片的代码片段： // 绘制图片，如果图片要自适应大小可以使用StrechDraw方法 Canvas.Draw(rEdge.Left, rEdge.Top, NormalPicture.Graphic);

　　

可以将绘制按钮和图片封装成一些类，我封装了一些TdrawUI系列的类并放到名为U_DrawUI的单元。

         了解了以上两个方式后，剩下的就是在TListBox的事件中写控制代码了。

我们需要做的功能可以列举如下：

l  列表增加元素时每个元素显示头像和操作按钮

l  操作按钮在鼠标经过时、鼠标点击时有按钮效果

l  列表每个元素的文字，名称用粗体字，附带个人介绍用非粗体字，文字要自动折行

l   

l  每个元素之间有分割线，线条两边不要顶到边框

干活阶段

我们创建一个窗体工程，增加一个TListBox控件命名为lst1，另外至少包含一个对列表增加元素的Add按钮

         在lst1的OnDrawItem事件中绘制头像、按钮、分割线，另外要在OnMeasureItem事件中计算一下每行的高度。代码如下：              

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110

procedure TForm1.lst1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect;   State: TOwnerDrawState); var   sTmp,sln:string;   nRows,I,iPos,iPosEnd,iLen, nWidth:Integer; //,nEnterTimes   lst: TListBox;   ACanvas: TCanvas;   lineRect, iconRect: TRect;   btn1, btn2: TDrawUIButton;   hitPoint: TPoint;   iconHead: TPicture; begin   lst := TListBox(Control);   ACanvas := TListBox(Control).Canvas;     nWidth := lst.Width - 170;   ACanvas.FillRect(Rect);   // 每个元素之间画一条分割线   lineRect := Classes.Rect(Rect.Left, Rect.Bottom - 1, Rect.Right, Rect.Bottom);   lst.Canvas.Pen.Width := 1;   lst.Canvas.Pen.Color := $F5F2F2;   lst.Canvas.MoveTo(lineRect.Left + 10, lineRect.Top);   lst.Canvas.LineTo(lineRect.Right - 10, lineRect.Top);     iconHead := TPicture.Create;   if index mod 2 = 0 then     IconHead.LoadFromFile(ExtractFilePath(Application.ExeName) + 'butt_pngI_like_buttons_022.png')   else     IconHead.LoadFromFile(ExtractFilePath(Application.ExeName) + 'butt_pngI_like_buttons_023.png');   SetBkMode(lst.Canvas.Handle, TRANSPARENT);   iconRect := Classes.Rect(Rect.Left + 2, Rect.Top + 10, Rect.Left + 50, Rect.Top + 58);   lst.Canvas.StretchDraw(iconRect, iconHead.Graphic);   iconHead.Free;   nRows := 0;     // 输出标题   sln := '我是一个用户';   ACanvas.Font.Name := '微软雅黑';   ACanvas.Font.Size := 10;   ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];   ACanvas.TextOut(Rect.Left + 55,  Rect.Top + 4 + FTxtHght * nRows, sln);   ACanvas.Font.Style := ACanvas.Font.Style - [fsBold];   Inc(nRows);     // 输出内容   sTmp:=WrapText(ACanvas, lst.Items[index], nWidth);   ACanvas.Font.Size := 9;   while true do   begin     I := Pos(#10,sTmp);     if I <> 0 then     begin       sln := Copy(sTmp,1,I-1);       sTmp := Copy(sTmp,I+1,Length(sTmp));       ACanvas.TextOut(Rect.Left + 55,  Rect.Top + 8 + FTxtHght * nRows, sln);       Inc(nRows);     end     else begin       if Length(sTmp) <> 0 then       begin         ACanvas.TextOut(Rect.Left + 55,  Rect.Top + 8 + FTxtHght * nRows, sln);         Inc(nRows);       end;       System.Break;     end;   end;     hitPoint := lst.ScreenToClient(Mouse.CursorPos);     // add button1   btn1 := TDrawUIButton.Create(Self);   btn1.Left := Rect.Right - 120;   btn1.Top := Rect.Top + 20;   btn1.Width := 68;   btn1.Height := 20;   btn1.Caption := '关注';   btn1.Color := clWhite;   btn1.Font.Color := clBlack;   btn1.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'butt_pngcheck.png');   FBtns.AddObject(Format('%d_%d', [index, 1]), btn1);   btn1.Draw(lst.Canvas, BUTTON_DRAW_NORMAL);     // add button 2   btn2 := TDrawUIButton.Create(Self);   btn2.Left := Rect.Right - 120 + btn1.Width + 3;   btn2.Top := Rect.Top + 20;   btn2.Width := 36;   btn2.Height := 20;   btn2.Caption := '更多';   btn2.Color := clWhite;   btn2.Font.Color := clBlack;   FBtns.AddObject(Format('%d_%d', [index, 2]), btn2);   btn2.Draw(lst.Canvas, BUTTON_DRAW_NORMAL); end;     procedure TForm1.lst1MeasureItem(Control: TWinControl; Index: Integer;   var Height: Integer); var   sTmp:string;   nRows, nWidth: Integer;   lst: TListBox; begin   lst := TListBox(Control);   nWidth := lst.Width - 170;   nRows := 0;   sTmp:=WrapText(lst.Canvas, lst.Items[index], nWidth);   nRows := nRows + GetLineCount(sTmp);   Height:= FTxtHght*nRows + 30; end;

　　

　　在OnDrawItem画出的东西就已经具备我们需求中的模样了，只是按钮在鼠标操作时不会有变化，我们需要让按钮在鼠标经过、鼠标点击时候按钮样式有变化，且要能响应点击事件。

      在OnMouseDown事件中将按钮重绘为按下状态

　　

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

procedure TForm1.lst1MouseDown(Sender: TObject; Button: TMouseButton;   Shift: TShiftState; X, Y: Integer); var   btn, btnHit: TDrawUIButton;   btnRect: TRect;   pt: TPoint;   lst: TListBox;   lstIndex, btnIndex: Integer; begin   lst := TListBox(Sender);   pt := Classes.Point(X, Y);   lstIndex := lst.ItemAtPos(pt, True);   if lstIndex = -1 then     Exit;     btnHit := nil;   btnIndex := FBtns.IndexOf(Format('%d_%d', [lstIndex, 1]));   btn := TDrawUIButton(FBtns.Objects[btnIndex]);   btnRect := btn.EdgeRect;   // 点了第一个button   if PtInRect(btnRect, pt) then begin     btnHit := btn;   end;     if not Assigned(btnHit) then begin     btnIndex := FBtns.IndexOf(Format('%d_%d', [lstIndex, 2]));     btn := TDrawUIButton(FBtns.Objects[btnIndex]);     btnRect := btn.EdgeRect;     // 点了第二个button     if PtInRect(btnRect, pt) then begin       btnHit := btn;     end;   end;     // 鼠标按下效果   if Assigned(btnHit) then     btnHit.Draw(lst.Canvas, BUTTON_DRAW_CLICK); end;

　　在OnMouseUp事件绘制按钮弹起效果，并触发点击事件，点击事件要在初始化按钮的时候赋值，代码如下：

　　

1 2 3 4 5 6 7 8 9

省略掉判断鼠标所在按钮的代码。。。  // 鼠标弹起效果   if Assigned(btnHit) then begin     btnHit.Draw(lst.Canvas, BUTTON_DRAW_NORMAL);     // 在鼠标按键放开时触发点击事件     if Assigned(btnHit.OnClick) then begin       btnHit.OnClick(btnHit);     end;   end;

　　还有，在OnMouseMove事件绘制鼠标变亮的效果，

　　

1 2 3 4 5 6 7

省略掉判断鼠标所在按钮的代码。。。   // 经过第一个button，第二个button的代码也省略，实际上每行应维护一个按钮List，示例代码略过。   if PtInRect(btnRect, pt) then begin     btn.Draw(lst.Canvas, BUTTON_DRAW_HOVER)   end else begin     btn.Draw(lst.Canvas, BUTTON_DRAW_NORMAL)   end;

　　运行效果如图：

　　

　　绘制工作大致到这里，要继续美化样式，最好按钮也使用图片来画，比如关注按钮的图片自带对号会更好。

　　附：

     U_DrawUI.pas代码

　  

unit U_DrawUI;

{ 用于在界面绘制控件UI时的数据对象
  author: edhn
}

interface

uses
  Generics.Collections, Windows, Forms, ComCtrls, Controls, Classes,
  Types, Messages, Graphics, ExtCtrls, SysUtils, StdCtrls, Buttons;

const
  BUTTON_DRAW_NORMAL = 1;
  BUTTON_DRAW_HOVER = 2;
  BUTTON_DRAW_CLICK = 3;

type
  TDrawUIBaseControl = class
  private
    FOwner: TObject;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FColor: TColor;
    FHint: String;
    FEnabled: Boolean;
    FVisbile: Boolean;

    function GetBrushRect: TRect;
    function GetEdgeRect: TRect;
    procedure SetEdgeRect(value: TRect);
  protected
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  public
    property Owner: TObject read FOwner write FOwner;
    property Left: Integer read FLeft write FLeft;
    property Top: Integer read FTop write FTop;
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
    property Color: TColor read FColor write FColor;
    property Hint: String read FHint write FHint;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Visbile: Boolean read FVisbile write FVisbile;
    property BrushRect: TRect read GetBrushRect;
    property EdgeRect: TRect read GetEdgeRect write SetEdgeRect;

    constructor Create();overload; virtual;
    constructor Create(Owner: TObject);overload; virtual;
    destructor Destroy();override;

    procedure Draw(Canvas: TCanvas; param: Integer);virtual; abstract;
  end;

  { TDrawUIButton }
  TDrawUIButton = class(TDrawUIBaseControl)
  private
    FCaption: String;
    FFont: TFont;
    FEnabled: Boolean;
    FOnClick: TNotifyEvent;
    FNormalPicture: TPicture;
    FHoverPicture: TPicture;
    FClickPicture: TPicture;
    FDisablePicture: TPicture;
    FDrawState: TButtonState;
    FIcon: TPicture;
  public
    MouseOnButton: Boolean;
    property Caption: String read FCaption write FCaption;
    property Font: TFont read FFont write FFont;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Icon: TPicture read FIcon write FIcon;
    property NormalPicture: TPicture read FNormalPicture;
    property HoverPicture: TPicture read FHoverPicture;
    property ClickPicture: TPicture read FClickPicture;
    property DisablePicture: TPicture read FDisablePicture;
    property DrawState: TButtonState read FDrawState;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;

    constructor Create(Owner: TObject);override;
    destructor Destroy();override;

    procedure Draw(Canvas: TCanvas; param: Integer);override;
  end;

  { TDrawUIImage }
  TDrawUIImage = class(TDrawUIBaseControl)
  private
    FImage: TImage;
  public
    property Image: TImage read FImage write FImage;

    constructor Create(Owner: TObject);override;
    destructor Destroy();override;

    procedure Draw(Canvas: TCanvas; param: Integer);override;
  end;

implementation

{ TDrawBaseControl }

constructor TDrawUIBaseControl.Create(Owner: TObject);
begin
  FOwner := Owner;
  FEnabled := True;
  FVisbile := True;
end;

constructor TDrawUIBaseControl.Create;
begin
  FEnabled := True;
  FVisbile := True;
end;

destructor TDrawUIBaseControl.Destroy;
begin

  inherited;
end;

function TDrawUIBaseControl.GetBrushRect: TRect;
begin
  Result.Left := Left + 1;
  Result.Top := Top + 1;
  Result.Right := Left + Width - 1;
  Result.Bottom := Top + Height - 1;
end;

function TDrawUIBaseControl.GetEdgeRect: TRect;
begin
  Result.Left := Left;
  Result.Top := Top;
  Result.Right := Left + Width;
  Result.Bottom := Top + Height;
end;

procedure TDrawUIBaseControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  FLeft := ALeft;
  FTop := ATop;
  FWidth := AWidth;
  FHeight := AHeight;
end;

procedure TDrawUIBaseControl.SetEdgeRect(value: TRect);
begin
  with value do
    SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

{ TDrawButton }

constructor TDrawUIButton.Create(Owner: TObject);
begin
  inherited Create(Owner);
  FFont := TFont.Create;
  FEnabled := True;
  FIcon := TPicture.Create;
  FNormalPicture := TPicture.Create;
  FHoverPicture := TPicture.Create;
  FClickPicture := TPicture.Create;
  FDisablePicture := TPicture.Create;
end;

destructor TDrawUIButton.Destroy;
begin
  FFont.Free;
  FIcon.Free;
  FNormalPicture.Free;
  FHoverPicture.Free;
  FClickPicture.Free;
  FDisablePicture.Free;
  inherited;
end;

procedure TDrawUIButton.Draw(Canvas: TCanvas; param: Integer);
var
  rBtn, rEdge, iconRect: TRect;
begin
  rBtn := BrushRect;
  rEdge := Self.EdgeRect;
  iconRect := Classes.Rect(0, 0, 0, 0);
  if Assigned(FIcon.Graphic) and (not FIcon.Graphic.Empty) then begin
    iconRect := Classes.Rect(rEdge.Left + 2, rEdge.Top + 1,
      rEdge.Left + Self.Height - 2, rEdge.Top + Self.Height - 1);
    Canvas.StretchDraw(iconRect, FIcon.Graphic);
  end;

  rBtn.Left := rBtn.Left + RectWidth(iconRect);
  if not Enabled then begin
    Canvas.Brush.Color := $F4F4F4;
    if Assigned(DisablePicture.Graphic) and (not DisablePicture.Graphic.Empty) then begin
      Canvas.Draw(rEdge.Left, rEdge.Top, DisablePicture.Graphic);
    end else begin
      DrawEdge(Canvas.Handle, rEdge, EDGE_RAISED, BF_RECT);
      Canvas.FillRect(rBtn);
    end;
  end else begin
     Canvas.Brush.Color := Color;
     if param = BUTTON_DRAW_CLICK then begin
      if Assigned(ClickPicture.Graphic) and (not ClickPicture.Graphic.Empty) then begin
        Canvas.Draw(rEdge.Left, rEdge.Top, ClickPicture.Graphic);
      end else begin
        DrawEdge(Canvas.Handle, rEdge, EDGE_ETCHED, BF_RECT);
        Canvas.FillRect(rBtn);
      end;
    end else if param = BUTTON_DRAW_HOVER then begin
      if Assigned(HoverPicture.Graphic) and (not HoverPicture.Graphic.Empty) then begin
        Canvas.Draw(rEdge.Left, rEdge.Top, HoverPicture.Graphic);
      end else begin
        InflateRect(rEdge, 1, 1);
        DrawEdge(Canvas.Handle, rEdge, EDGE_RAISED, BF_RECT);
        Canvas.FillRect(rBtn);
      end;
    end else begin
      if Assigned(NormalPicture.Graphic) and (not NormalPicture.Graphic.Empty) then begin
        Canvas.Draw(rEdge.Left, rEdge.Top, NormalPicture.Graphic);
      end else begin
        DrawEdge(Canvas.Handle, rEdge, EDGE_RAISED, BF_RECT);
        Canvas.FillRect(rBtn);
      end;
    end;
  end;

  if Enabled then
    Canvas.Font.Color := Self.Font.Color
  else
    Canvas.Font.Color := clGrayText;
  Canvas.Font.Name := '微软雅黑';
  Canvas.Font.Size := 9;
  SetBkMode(Canvas.Handle, TRANSPARENT);
  DrawText(Canvas.Handle, Caption,
    Length(Caption), rBtn, DT_CENTER + DT_SINGLELINE + DT_VCENTER);
end;

{ TDrawImage }

constructor TDrawUIImage.Create(Owner: TObject);
begin
  inherited Create(Owner);
  FImage := TImage.Create(nil);
end;

destructor TDrawUIImage.Destroy;
begin
  FImage.Free;
  inherited;
end;

procedure TDrawUIImage.Draw(Canvas: TCanvas; param: Integer);
begin
  Canvas.Draw(Left, Top, Image.Picture.Bitmap);
end;

end.