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

时间：2021-11-18 11:11:32

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

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

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

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

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

研究阶段

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

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

　　

输出文字的代码片段：

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过来输出，比如头像、按钮图标，如果按钮要有背景色也是图片好些；

绘制图片的代码片段：

// 绘制图片，如果图片要自适应大小可以使用StrechDraw方法

Canvas.Draw(rEdge.Left, rEdge.Top, NormalPicture.Graphic);

　　

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

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

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

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

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

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

l

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

干活阶段

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

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

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_png\I_like_buttons_022.png')

  else

    IconHead.LoadFromFile(ExtractFilePath(Application.ExeName) + 'butt_png\I_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_png\check.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事件中将按钮重绘为按下状态

　　

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事件绘制按钮弹起效果，并触发点击事件，点击事件要在初始化按钮的时候赋值，代码如下：

　　

省略掉判断鼠标所在按钮的代码。。。

 // 鼠标弹起效果

  if Assigned(btnHit) then begin

    btnHit.Draw(lst.Canvas, BUTTON_DRAW_NORMAL);

    // 在鼠标按键放开时触发点击事件

    if Assigned(btnHit.OnClick) then begin

      btnHit.OnClick(btnHit);

    end;

  end;

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

　　

省略掉判断鼠标所在按钮的代码。。。

  // 经过第一个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;

　　运行效果如图：

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

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

　　附：

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 = ;

  BUTTON_DRAW_HOVER = ;

  BUTTON_DRAW_CLICK = ;

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 + ;

  Result.Top := Top + ;

  Result.Right := Left + Width - ;

  Result.Bottom := Top + Height - ;

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(, , , );

  if Assigned(FIcon.Graphic) and (not FIcon.Graphic.Empty) then begin

    iconRect := Classes.Rect(rEdge.Left + , rEdge.Top + ,

      rEdge.Left + Self.Height - , rEdge.Top + Self.Height - );

    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, , );

        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 := ;

  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.

相关文章