1. 首頁
  2. 問答
  3. 繪製一個複選框在TListView的

繪製一個複選框在TListView的

2011-04-01 57 views
6

我需要在一個TListView特定列畫一個複選框，所以我檢查這個問題How can I setup TListView with CheckBoxes in only certain columns?和接受的答案建議使用此另一個問題How to set a Checkbox TStringGrid in Delphi?描述的方法，現在移植該代碼有一個ListView工作，我帶着這樣的：繪製一個複選框在TListView的

procedure TForm15.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); 
const 
    PADDING = 4; 
var 
    h : HTHEME; 
    s : TSize; 
    r : TRect; 
    Rect : TRect; 
    i : Integer; 
    Dx : Integer; 
begin 
    if (SubItem=1) then 
    begin 
    DefaultDraw:=True; 
    Rect :=Item.DisplayRect(drBounds); 
    Dx:=0; 

    for i := 0 to SubItem do 
    Inc(Dx,Sender.Column[i].Width); 
    Rect.Left :=Rect.Left+Dx; 

    Rect.Right :=Rect.Left+Sender.Column[SubItem+1].Width; 

    FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH)); 
    s.cx := GetSystemMetrics(SM_CXMENUCHECK); 
    s.cy := GetSystemMetrics(SM_CYMENUCHECK); 
    if UseThemes then 
    begin 
     h := OpenThemeData(Sender.Handle, 'BUTTON'); 
     if h <> 0 then 
     try 
      GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, s); 
      r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2; 
      r.Bottom := r.Top + s.cy; 
      r.Left := Rect.Left + PADDING; 
      r.Right := r.Left + s.cx; 
      DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil); 
     finally 
      CloseThemeData(h); 
     end; 
    end 
    else 
    begin 
     r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2; 
     r.Bottom := r.Top + s.cy; 
     r.Left := Rect.Left + PADDING; 
     r.Right := r.Left + s.cx; 
     DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK)); 
    end; 
    //r := Classes.Rect(r.Right + PADDING, Rect.Top, Rect.Right, Rect.Bottom); 
    // DrawText(Sender.Canvas.Handle, StringGrid1.Cells[ACol, ARow], length(StringGrid1.Cells[ACol, ARow]), r, DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS); 
    end 
    else 
    DefaultDraw:=False; 
end;

，但我在試圖繪製一個複選框:(慘遭失敗，有人可以點我在正確的方向繪製在ListView的複選框，（代碼做不在列表視圖中繪製任何複選框）

listview在vsR eport模式，並有3列，我想把複選框在第三列。請不要建議使用第三方組件，我想使用TlistView控件。

UPDATE 1：感謝sertac recomendattion設置DefaultDraw值現在複選框顯示，但其他列看起來不太好。

enter image description here

更新2，繼安德烈亞斯建議列表視圖現在看起來更好，但仍顯示黑盒;

enter image description here

procedure TForm15.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); 
var 
    h : HTHEME; 
    s : TSize; 
    r : TRect; 
    Rect : TRect; 
    i : Integer; 
    Dx : Integer; 
begin 
    if (SubItem=2) then 
    begin 
    DefaultDraw:=False; 
    Rect :=Item.DisplayRect(drBounds); 

    Dx:=0; 
    for i := 0 to SubItem-1 do 
     Inc(Dx,Sender.Column[i].Width); 

    Rect.Left :=Rect.Left+Dx; 
    Rect.Right :=Rect.Left+Sender.Column[SubItem].Width; 
    FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH)); 
    s.cx := GetSystemMetrics(SM_CXMENUCHECK); 
    s.cy := GetSystemMetrics(SM_CYMENUCHECK); 
    Dx := (Sender.Column[SubItem].Width-GetSystemMetrics(SM_CXMENUCHECK)) div 2; 
    if UseThemes then 
    begin 
     h := OpenThemeData(Sender.Handle, 'BUTTON'); 
     if h <> 0 then 
     try 
      GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, s); 
      r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2; 
      r.Bottom := r.Top + s.cy; 
      r.Left := Rect.Left + Dx; 
      r.Right := r.Left + s.cx; 
      DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[SubItem-1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil); 
     finally 
      CloseThemeData(h); 
     end; 
    end 
    else 
    begin 
     r.Top := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2; 
     r.Bottom := r.Top + s.cy; 
     r.Left := Rect.Left + Dx; 
     r.Right := r.Left + s.cx; 
     DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[SubItem-1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK)); 
    end; 
    end; 
end;

來源

2011-04-01 Salvador

+0

您沒有將DefaultDraw設置爲false，您的框可能被VCL過度繪製。 – 2011-04-01 23:20:32

+0

謝謝塞爾特克現在我有一個進步。 – Salvador 2011-04-01 23:53:54

+0

我的第二個答案解決了所有問題。 – 2011-04-02 12:18:43

回答

9

擺脫這個錯誤的一個比較簡單的方法是自己繪製整個項目。設置OwnerDraw := true，免去您的日常OnCustomDrawSubItem，並添加

procedure TForm15.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; 
    Rect: TRect; State: TOwnerDrawState); 

    function ShrinkRect(const r: TRect; const X0, X1, Y0, Y1: integer): TRect; inline; 
    begin 
    result := r; 
    inc(result.Left, X0); 
    inc(result.Top, Y0); 
    dec(result.Right, X1); 
    dec(result.Bottom, Y1); 
    end; 

const 
    CHECK_COL = 2; 
    PADDING = 4; 
var 
    r: TRect; 
    i: Integer; 
    s: string; 
    size: TSize; 
    h: HTHEME; 
begin 

    FillRect(Sender.Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH)); 
    r := Rect; 
    inc(r.Left, PADDING); 
    for i := 0 to TListView(Sender).Columns.Count - 1 do 
    begin 
    r.Right := r.Left + Sender.Column[i].Width; 
    if i <> CHECK_COL then 
    begin 
     if i = 0 then 
     begin 
     s := Item.Caption; 
     if not IsWindowVisible(ListView_GetEditControl(Sender.Handle)) then 
     begin 
      if UseThemes and ([odSelected, odHotLight] * State <> []) then 
      begin 
      h := OpenThemeData(Sender.Handle, 'LISTVIEW'); 
      if h <> 0 then 
       try 
       DrawThemeBackground(h, Sender.Canvas.Handle, LVP_GROUPHEADER, IfThen(odSelected in State, LVGH_CLOSESELECTED, LVGH_OPENHOT), ShrinkRect(r, -2, 6, 1, 1), nil); 
       finally 
       CloseThemeData(h); 
       end; 
      end; 
      if (odSelected in State) and not UseThemes then 
      DrawFocusRect(Sender.Canvas.Handle, ShrinkRect(r, -2, 6, 1, 1)); 
     end; 
     end 
     else 
     s := Item.SubItems[i - 1]; 
     Sender.Canvas.Brush.Style := bsClear; 
     DrawText(Sender.Canvas.Handle, 
     PChar(s), 
     length(s), 
     r, 
     DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS); 
    end 
    else 
    begin 

     size.cx := GetSystemMetrics(SM_CXMENUCHECK); 
     size.cy := GetSystemMetrics(SM_CYMENUCHECK); 
     if UseThemes then 
     begin 
     h := OpenThemeData(Sender.Handle, 'BUTTON'); 
     if h <> 0 then 
      try 
      GetThemePartSize(h, Sender.Canvas.Handle, BP_CHECKBOX, CBS_CHECKEDNORMAL, nil, TS_DRAW, size); 
      r.Top := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2; 
      r.Bottom := r.Top + size.cy; 
      r.Left := r.Left + PADDING; 
      r.Right := r.Left + size.cx; 
      DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[1],'True')=0, CBS_CHECKEDNORMAL, CBS_UNCHECKEDNORMAL), r, nil); 
      finally 
      CloseThemeData(h); 
      end; 
     end 
     else 
     begin 
     r.Top := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2; 
     r.Bottom := r.Top + size.cy; 
     r.Left := r.Left + PADDING; 
     r.Right := r.Left + size.cx; 
     DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK)); 
     end; 

    end; 
    inc(r.Left, Sender.Column[i].Width); 
    end; 

end;

Sample usage http://privat.rejbrand.se/listbugs.png

上面的代碼需要進一步測試，但可能是在正確的方向。現在已經很晚了，我得走了。

來源

2011-04-02 01:10:27

+0

非常感謝Andreas。 – Salvador 2011-04-04 13:04:47

0

首先，你應該設置DefaultDraw到false繪製複選框列和true否則當，因爲DefaultDraw意味着，VCL確實圖紙，而不是你。目前你做的是相反的。

另外，由於某種奇怪的原因，控件認爲第一個子項目是SubItem = 1，第二個子項目是SubItem = 2。因此，您應該測試if SubItem = 2 then。

[當然，這意味着變化

for i := 0 to SubItem - 1 do 
    Inc(Dx, Sender.Column[i].Width); 

Rect.Right := Rect.Left+Sender.Column[SubItem].Width;

]

黑色矩形似乎是一個錯誤的地方在VCL和Win32代碼的結合。

來源

2011-04-01 23:57:26

+0

非常感謝@Andreas。你有刪除黑匣子的想法嗎？ – Salvador 2011-04-02 00:41:34

+0

@Salvador：不，我不知道。它可能會很好地對所有者繪製整個項目，但這不應該是必要的...... – 2011-04-02 00:42:21

0

沒有完全切換到的OwnerDraw，我發現下面的合理的可接受：

  1. 不要在標題欄（或將其用於索引），並設置其初始寬度爲0
  2. 把你的在第一子項列標籤（第二列），然後複選框

  3. 使用CustomDrawSubItem程序提請使用「的TextOut」您的標籤，例如：

    ListView1.Canvas.TextOut（2，Y， '我的標籤'）;

這隱藏的黑盒子，你可以看到你的文本標籤。但是選擇不適用於文本。在我看來，付出的代價很小。

來源

2013-03-22 15:18:23 user2199822

相關問題

 相關問題