用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.