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

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

　　

　　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;

　　运行效果如图：

　　

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

　　附：

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.
时间： 2024-10-11 02:56:30

用Delphi制作仿每行带按钮的列表的相关文章

jquery 文字滚动大全 scroll 支持文字或图片 单行滚动 多行滚动 带按钮控制滚动

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <meta http-equiv="Content-

js制作带按钮的循环自动切换广告

-----------------------------------------------------------------------------------------------------------------css @charset "gb2312";/* CSS Document */ body{ margin:0; margin-top:3px; padding:0; font-size:12px; line-height:20px; color:#333;}.a

Delphi制作DLL

一.开使你的第一个DLL专案 1.File->Close all->File->New﹝DLL﹞ 代码: //自动产生Code如下 library Project2; //这有段废话 uses SysUtils, Classes; {$R *.RES} begin end. 2.加个Func进来: 代码: library Project2; uses SysUtils, Classes; Function MyMax ( X , Y : integer ) : integer ; std

用duilib制作仿QQ2013动态背景登录器

转载请说明原出处,谢谢~~ 在上一篇博客里,我修复了CActiveXUI控件的bug,从而可以使用flash动画来制作程序的背景,这篇博客说明一下应该怎么使用CActiveXUI控件创建透明无窗体的背景. 去年的QQ2013的登陆界面就是动态界面,上篇博客我说道了,Duiengine已经有高人做好了仿QQ界面的代码,我这里只是把QQ2013的动态登陆界面制作出来.而QQ2014又换了全新的界面,不过熟悉UI制作的朋友知道,模仿 QQ2014的登陆界面比QQ2013的还要简单.可以看到QQ2013

jquery制作弹出层带遮罩效果，点击阴影部分层消失

jquery制作弹出层带遮罩效果,点击阴影部分层消失. 整体还是比较简单的. HTML代码很简单 1 <a href="#" class="big-link" data-reveal-id="myModal" data-animation="fade">jquery点我弹出</a> 2 <div id="myModal" class="reveal-modal&quo

delphi xe6 for android 自带控件LocationSensor优先使用GPS定位的方法

delphi xe6 for android LocationSensor控件默认是优先使用网络定位,对定位精度要求高的应用我们可以修改原码直接指定GPS定位. 修改方法: 将C:\Program Files\Embarcadero\Studio\14.0\source\rtl\common\System.Android.Sensors.pas拷贝到自己的工程目录里 打开System.Android.Sensors.pas找到function TUIAndroidLocationSensor.D

Delphi制作QQ自动登录器源码

Delphi制作QQ自动登录器源码 http://www.cnblogs.com/sunsoft/archive/2011/02/25/1964967.html 以TM2009为例,检查了一下,未登录之前一个窗体,上边两个控件,登录以后,窗体捕获到一个控件,根据这个,首先找到QQ登录框,输入用户名,密码的位置,获取窗体句柄的具体代码如下: 这里先定义了一个record类型, 1   TQQWnd= record 2     QQWnd,QStatusWnd: HWND;  //QQ窗口句柄,QQ

AppBoxPro - 细粒度通用权限管理框架（可控制表格行内按钮）源码提供下载

特别声明: 提供的源代码已经包含了 AppBoxPro 的全部源代码,用 VS2012 打开项目后,直接 Ctrl+F5 可以运行起来(默认使用VS自带的LocalDB数据库). FineUIPro是商业程序,仅包含v1.7.0公测版的DLL:当然你也可以自行把 FineUIPro 换成 FineUI(开源版),开源版下载地址. AppBoxPro 是基于 FineUIPro 和 Entity Framework 的通用权限管理框架,包括用户管理.职称管理.部门管理.角色管理.角色权限管理等模块

GridView行中按钮的使用

GridView行中按钮的使用 在web项目的过程中,特别是开发ASP.NET应用程序,经常会用到数据显示空间GridView控件,然后需要每行的结尾放置一个button或linkbutton来对当前行进行操作.如下图,添加一个删除按钮,当点击按钮时删除所在行的记录. 本文将提供5种常用的方法来实现行记录的删除操作,并由此来了解下GridView中按钮的使用. 方法1: 在GridView控件中放置一个模板列,往里面放置一个按钮,并用主键值绑定按钮,代码如下: <asp:TemplateFiel