Ver Mensaje Individual
  #1  
Antiguo 20-01-2017
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 910
Reputación: 22
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Listview con Checkbox

Me vi en la necesidad de utilizar un Tlistview y debía tener algunas columnas con checkbox que pudiera marcar y desmarcar, debido a ello buscando encontre como hacerlo y quiero compartir el código. De seguro a alguien le servirá.

Intente flexibilizar un poco el código, ya que el original había que indicar desde que columnas deberían ser checkbox lo que limita un poco, ya que en mi caso requeria intercalar las columnas checkbox con otras.

Bueno no tantas palabras. Los procedimientos que hacen el trabajo son:
  • ListviewChecked(Sender:TObject)
  • ListViewDrawCheckbox(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState)

Código Delphi [-]
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Winapi.CommCtrl, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
     procedure ListviewChecked(Sender:TObject);
     procedure ListViewDrawCheckbox(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
  end;

var
  Form1: TForm1;

implementation
uses UxTheme, System.Math;

{$R *.dfm}

{
Listview con checkbok en subitems

Requiere : Winapi.CommCtrl, UxTheme, System.Math
}
{
 http://www.delphigroups.info/2/4/646599.html
 Peter Below (TeamB)
}
procedure TForm1.ListviewChecked(Sender: TObject);
var
   pt: TPoint;
   item : TLIstItem;
   hittestinfo: TLVHitTestInfo;
begin
     pt:= TListView(Sender).ScreenToClient( mouse.cursorpos );
     item := TListView(Sender).GetItemAt( pt.x, pt.y );

     If Not Assigned( Item ) then
        Exit;

     FillChar( hittestinfo, sizeof( hittestinfo ), 0 );
     hittestinfo.pt := pt;

     If -1 <>listview1.perform( LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo)) Then
     Begin
          if hittestinfo.iSubItem>0 then
          begin
               TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1];
               If CompareText(TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1],DefaultTrueBoolStr)=0 then
                  TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1]:=DefaultFalseBoolStr
               else
                   TListView(Sender).items[hittestinfo.iItem].Subitems[ hittestinfo.iSubItem-1]:=DefaultTrueBoolStr;
          end;
     End;
end;

{
Link  : http://stackoverflow.com/questions/5...in-a-tlistview
Author: Andreas Rejbrand
}
procedure TForm1.ListViewDrawCheckbox(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 = 1;
  PADDING = 5;
var
  r: TRect;
  i, oldleft: Integer;
  s: string;
  size: TSize;
  h: HTHEME;
  ListItem: TListItem;
  checked:Boolean;
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=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,
                              System.Math.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;

               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
               if (Not TryStrToBool(Item.SubItems[i-1],checked)) then
               begin
                    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);
                    //CLOAYZA: Debo guardar valor original de R.Left (Centrado CheckBox)
                    oldleft:=R.Left;
                    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);

                               oldleft:=R.Left;

                               r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - size.cy) div 2;
                               r.Bottom := r.Top + size.cy;
                               //r.Left   := r.Left + PADDING
                               //CLOAYZA: Para que el control checkbox se muestre centrado el la columna
                               r.Left   := r.Left + (r.Right - r.Left - size.cx) div 2;
                               r.Right  := r.Left + size.cx;

                               DrawThemeBackground(h, Sender.Canvas.Handle, BP_CHECKBOX, IfThen(CompareText(Item.SubItems[i-1],DefaultTrueBoolStr)=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
                         //CLOAYZA: Para que el control checkbox se muestre centrado el la columna
                         r.Left   := r.Left + (r.Right - r.Left - size.cx) div 2;
                         r.Right  := r.Left + size.cx;
                         DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(CompareText(Item.SubItems[i-1],DefaultTrueBoolStr)=0, DFCS_CHECKED, DFCS_BUTTONCHECK));
                    end;
                    //CLOAYZA: Restaura valor original de R.Left (Centrado CheckBox)
                    r.Left:=oldleft;
               end
          end;
          inc(r.Left, Sender.Column[i].Width);
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
   Names: array[0..5, 0..1] of string = (
    ('Rubble', 'Barney'),
    ('Michael', 'Johnson'),
    ('Bunny', 'Bugs'),
    ('Silver', 'HiHo'),
    ('Simpson', 'Bart'),
    ('Squirrel', 'Rocky')
    );
var
  I: Integer;
  NewColumn: TListColumn;
  ListItem: TListItem;
  ListView: TListView;
begin

     ListView1.Items.Clear;
     with ListView1 do
     begin
          Parent := Self;
          Align := alClient;
          ViewStyle := vsReport;

          NewColumn := Columns.Add;
          NewColumn.Caption := 'Last';
          NewColumn := Columns.Add;
          NewColumn.Caption := 'Age';
          NewColumn := Columns.Add;
          NewColumn.Caption := 'Select';
          NewColumn := Columns.Add;
          NewColumn.Caption := 'Comment';
          NewColumn := Columns.Add;
          NewColumn.Caption := 'View';

          for I := Low(Names) to High(Names) do
          begin
               ListItem := Items.Add;
               ListItem.Caption := Names[i][0];
               ListItem.SubItems.Add(Names[i][1]);
               ListItem.SubItems.Add(DefaultTrueBoolStr);    //Asigna valor True
               ListItem.SubItems.Add('comentarios');
               ListItem.SubItems.Add(DefaultFalseBoolStr);   //Asigna valor False
          end;
     end;

     ListView1.OwnerDraw :=True;
     ListView1.OnDrawItem:=ListViewDrawCheckbox;
     ListView1.OnClick   := ListviewChecked;
end;

end.

Espero sea de utilidad
Responder Con Cita