在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论