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.