dibujar una casilla de verificación en un TListView

Question

necesito para dibujar una casilla de verificación en una columna en particular en un TListView, por lo verifico esta pregunta How can I setup TListView with CheckBoxes in only certain columns? y en la respuesta aceptada sugiero utilizar el método descrito en esta otra pregunta How to set a Checkbox TStringGrid in Delphi?, ahora portar ese código para trabajo con un ListView que venga con esto:

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; 

pero fallan miserablemente en mi intento de trazar una casilla :(, alguien me puede apuntar en la dirección correcta para dibujar la casilla de verificación en la vista de lista, (el código hace no dibujar ninguna casilla de verificación en la vista de lista).

La lista está en vsR modo eport y tenía 3 columnas, quiero poner la casilla en la tercera columna. por favor, no sugiera qué uso de un componente de terceros, quiero usar el control TlistView.

ACTUALIZA 1: gracias al establecer el valor DefaultDraw se muestran ahora las casillas de verificación recomendattion sertac, pero las otras columnas se ve terrible.

ACTUALIZACIÓN 2, siguiendo las sugerencias Andreas la vista de lista ahora se ven mejor, pero aún así se muestra el cuadro de negro;

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; 

Answer 1

Una forma relativamente simple de deshacerse de este error es dibujar el ítem completo. Establecer OwnerDraw := true, retire su rutina OnCustomDrawSubItem, y añadir

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

El código anterior necesita más pruebas, pero es probable que en la dirección correcta. Ahora es muy tarde y tengo que irme.

Answer 2

En primer lugar, debe establecer DefaultDraw a false en la elaboración de la columna de la casilla de verificación y true otra manera, porque DefaultDraw significa que el VCL realiza el dibujo, y no usted. Actualmente haces lo opuesto.

Además, por alguna extraña razón, el control considera que el primer subelemento es SubItem = 1, y el segundo subelemento a SubItem = 2. Por lo tanto, debe probar if SubItem = 2 then en su lugar.

[Por supuesto, esto implica que los cambios

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

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

]

Los rectángulos negros parecen ser un error en algún lugar de la unión de la VCL y el código de Win32.

Answer 3

Sin apagar completamente a OwnerDraw, encontré la siguiente razonablemente aceptable:

1. No rellenar la columna del subtítulo (o utilizarlo para la indexación) y establecer la anchura inicial a 0
2. Ponga su etiquetas en la primera columna de SubItem (segunda columna) y luego las casillas de verificación

3. utilizar la rutina CustomDrawSubItem para dibujar las etiquetas utilizando "TextOut", por ejemplo:

   ListView1.Canvas.TextOut (2, y, 'Mi etiqueta');

Esto oculta las cajas negras y se puede ver las etiquetas de texto. Sin embargo, la selección no funciona sobre el texto. Pequeño precio a pagar, en mi opinión.