Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 20-01-2017
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 909
Poder: 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
  #2  
Antiguo 20-01-2017
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.195
Poder: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Precisamente he desarrollado el mismo truco pero a un nivel de programación más bajo, con API.

La solución está basada en una clase que realiza un subclassing del formulario para controlar las notificaciones que envían la cabecera y el ListView. La clase agrega un ChecBox en la cabecera de la primera columna y en cada Item. También genera dos eventos, uno cuando se marca el CheckBox de la caberera y otro cuando se marca el de un Item, de esta forma tendremos control desde el formulario de lo que está pasando. Cuando se marca la cabecera, automáticamente se marcan todos los Items y cuando están marcados todos los Items individualmente, se marca la cabecera.



Esta funcionalidad aparece desde Vista en adelante.


El código de la clase es este:
Código Delphi [-]
unit LVCheckBox;

//--------------------------------------------------------------------------------------------------
// TLVCheckBox (Versión Hook estilo C++)
// escafandra 2017
// Clase para manejo de CheckBox en la cabecera e Items de un ListView

interface

uses Windows, Messages, CommCtrl;

const
  HDN_ITEMSTATEICONCLICK: integer = $FFFFFEC4;
  HDF_CHECKBOX           = $0040;
  HDF_CHECKED            = $0080;
  HDF_FIXEDWIDTH         = $0100;
  HDS_CHECKBOXES         = $0400;

type
  PNMHEADER   = ^TagNMHEADER;
//  PNMLISTVIEW = ^TagNMLISTVIEW;

  TOnHeaderChecked = procedure(Checked: boolean) of object;
  TOnItemChecked = procedure(Index: integer; Checked: boolean) of object;

type
  TLVCheckBox = class
  private
    hListView: HWND;
    OldWndProc: Pointer;
    function WndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
  public
    OnHeaderChecked: TOnHeaderChecked;
    OnItemChecked: TOnItemChecked;
    constructor Create; overload;
    constructor Create(hListView: HWND); overload;
    destructor Destroy; override;
    procedure  SetHeaderCheck;
    procedure  SetHandle(hLV: HWND);
  end;

implementation


function DefWndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
var
  pLVCheckBox: TLVCheckBox;
begin
  pLVCheckBox:= TLVCheckBox(GetWindowLong(Handle, GWL_USERDATA));
  if pLVCheckBox <> nil then
    Result:= pLVCheckBox.WndProc(Handle, Msg, WParam, LParam)
  else
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
end;

constructor TLVCheckBox.Create;
begin
  OnHeaderChecked:= nil;
  OnItemChecked:= nil;
  SetHandle(0);
end;

constructor TLVCheckBox.Create(hListView: HWND);
begin
  OnHeaderChecked:= nil;
  OnItemChecked:= nil;
  SetHandle(hListView);
end;

function TLVCheckBox.WndProc(Handle: HWND; Msg: DWORD; WParam: Longint; LParam: Longint): Longint; stdcall;
var
  pNMH: PNMHEADER;
  pNMLV: PNMLISTVIEW;
  HeaderChecked: bool;
  i: integer;
begin
  if Msg = WM_NOTIFY then
  begin
    // Notificación del cambio del CheckBox de la cabecera
    pNMH:= PNMHEADER(LParam);
    if pNMH.hdr.code = HDN_ITEMSTATEICONCLICK then
    begin
      if (0 <> (pNMH.PItem.mask and HDI_FORMAT)) and (0 <> (pNMH.PItem.fmt and HDF_CHECKBOX)) then
      begin
        HeaderChecked:= (0 = (pNMH.pitem.fmt and HDF_CHECKED));
        if @OnHeaderChecked <> nil then
          OnHeaderChecked(HeaderChecked);
        for i:= 0 to ListView_GetItemCount(hListView)-1 do
          ListView_SetCheckState(hListView, i, HeaderChecked);
      end;
    end;

    // Notificación del cambio del CheckBox de un Item
    if pNMH.hdr.code = LVN_ITEMCHANGED then
    begin
      pNMLV:= PNMLISTVIEW(LParam);
      if (pNMLV.uChanged and LVIF_STATE) <> 0 then
      begin
        if @OnItemChecked <> nil then
          OnItemChecked(pNMLV.iItem, ListView_GetCheckState(hListView, pNMLV.iItem) <> 0);
        SetHeaderCheck;
      end;
    end;
  end;
  Result:= CallWindowProc(OldWndProc, Handle, Msg, WParam, LParam);
end;

procedure TLVCheckBox.SetHeaderCheck;
var
  HeaderChecked: boolean;
  i: integer;
  hHeader: HWND;
  HDI: HD_ITEM;
begin
  HeaderChecked:= true;
  for i:= 0 to ListView_GetItemCount(hListView)-1 do
  begin
    if ListView_GetCheckState(hListView, i) = 0 then
    begin
      HeaderChecked:= false;
      break;
    end;
  end;

  hHeader:= ListView_GetHeader(hListView);
  HDI.mask:= HDI_FORMAT;
  Header_GetItem(hHeader, 0, HDI);
  if HeaderChecked then
      HDI.fmt:= HDI.fmt or HDF_CHECKED
  else
    HDI.fmt:= HDI.fmt and not HDF_CHECKED;
  Header_SetItem(hHeader, 0, HDI);
end;

procedure TLVCheckBox.SetHandle(hLV: HWND);
var
  hHeader: HWND;
  HD: HD_ITEM;
begin
  if (hLV <> INVALID_HANDLE_VALUE) and (hLV <> hListView) then
  begin
    if hLV = 0 then
    begin
      SetWindowLong(GetParent(hListView), GWL_USERDATA, 0);
      SetWindowLong(GetParent(hListView), GWL_WNDPROC, LongInt(OldWndProc));
    end;
    if hLV <> 0 then
    begin
      ListView_SetExtendedListViewStyle(hLV, LVS_EX_CHECKBOXES or LVS_EX_FULLROWSELECT);
      //hHeader = (HANDLE)SendMessage(hListView, LVM_GETHEADER, 0, 0);
      hHeader:= ListView_GetHeader(hLV);
      SetWindowLong(hHeader, GWL_STYLE, GetWindowLong(hHeader, GWL_STYLE) or HDS_CHECKBOXES);
      ZeroMemory(@HD, sizeof(HD_ITEM));
      HD.mask:= HDI_FORMAT;
      Header_GetItem(hHeader, 0, HD);
      HD.fmt:= HD.fmt or HDF_CHECKBOX or HDF_FIXEDWIDTH;
      Header_SetItem(hHeader, 0, HD);

      SetWindowLong(GetParent(hLV), GWL_USERDATA, LongInt(self));
      OldWndProc:= Pointer(SetWindowLong(GetParent(hLV), GWL_WNDPROC, LongInt(@DefWndProc)));
    end;
    hListView:= hLV;
  end;
end;

destructor TLVCheckBox.Destroy;
begin
  OnHeaderChecked:= nil;
  OnItemChecked:= nil;
  SetHandle(0);
end;

end.

Un ejemplo de uso:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl, XPMan, LVCheckBox, StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    XPManifest1: TXPManifest;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    LVC: TLVCheckBox;
    procedure OnHeaderChecked(Checked: boolean);
    procedure OnItemChecked(Index: integer; Checked: boolean);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  LVC:= TLVCheckBox.Create(ListView1.Handle);
  LVC.OnHeaderChecked:= OnHeaderChecked;
  LVC.OnItemChecked:= OnItemChecked;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LVC.SetHandle(ListView1.Handle);
  LVC.OnHeaderChecked:= OnHeaderChecked;
  LVC.OnItemChecked:= OnItemChecked;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  LVC.SetHandle(0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LVC.Free;
end;


procedure TForm1.OnHeaderChecked(Checked: boolean);
begin
  Windows.Beep(500, 100);
end;

procedure TForm1.OnItemChecked(Index: integer; Checked: boolean);
begin
  Windows.Beep(1000, 100);
end;


end.


Probado en Delphi 7 y Berlin.




Saludos.

Última edición por escafandra fecha: 20-01-2017 a las 23:46:57.
Responder Con Cita
  #3  
Antiguo 20-01-2017
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.011
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Gracias por compartirlo
Responder Con Cita
  #4  
Antiguo 21-01-2017
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.195
Poder: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Una aclaración sobre mi código, precisa XP.RES o su componente delphi en caso de Delphi7.





Saludos.
Responder Con Cita
  #5  
Antiguo 21-01-2017
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.011
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por escafandra Ver Mensaje
Una aclaración sobre mi código, precisa XP.RES o su componente delphi en caso de Delphi7
¿Qué es xp.res o el componente delphi7?
Responder Con Cita
  #6  
Antiguo 21-01-2017
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.195
Poder: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Cita:
Empezado por Casimiro Notevi Ver Mensaje
¿Qué es xp.res o el componente delphi7?
Es el antiguo archivo de recursos para que los programas escritos en las antiguas versiones Delphi, tomarán el estilo WinXP. En Delhphi7 existía un componente para incluirlo en el formulario visualmente (en lugar de a mano en el Uses).

Saludos.
Responder Con Cita
  #7  
Antiguo 23-01-2017
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 909
Poder: 22
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Estimado escafandra, creo que son un poco distintos ambas soluciones...

Adjunto imagen


Sería estupendo poder reunir ambas en una solución

Saludos cordiales

Última edición por cloayza fecha: 23-01-2017 a las 16:06:16.
Responder Con Cita
  #8  
Antiguo 20-04-2017
Miriamalcarria Miriamalcarria is offline
Registrado
NULL
 
Registrado: abr 2017
Posts: 4
Poder: 0
Miriamalcarria Va por buen camino
Ostras que bueno. Gracias.
Responder Con Cita
  #9  
Antiguo 13-07-2023
alquimista alquimista is offline
Miembro
 
Registrado: ene 2008
Posts: 203
Poder: 17
alquimista Va por buen camino
Se que han pasado unos cuantos años. Pero es un código interesante.
He probado el ejemplo de cloayza y veo que en las columnas que tienen texto (por ejemplo columna Age), si pulsas para editar aparece un checkbox también. ¿Hay alguna versión que indique que columnas solo son checkbox y cuales no?

En la linea:
Código:
     If -1 <>listview1.perform( LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo)) Then
del procedure TForm1.ListviewChecked(Sender: TObject);

¿se podría poner?
Código:
     If -1 <>TListView(Sender).perform( LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo)) Then
para así abstraer el procedure para otros Listview?

Gracias
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Checkbox en un listview Choclito OOP 6 15-04-2011 21:55:52
Checkbox Transparente! AndrecitoPz Varios 5 19-04-2010 23:31:08
checkbox Lupita Varios 6 07-04-2008 16:12:53
Checkbox que no cheka Kenobi Varios 6 23-01-2008 09:59:18
checkbox superhopi OOP 3 12-05-2003 11:32:46


La franja horaria es GMT +2. Ahora son las 09:12:12.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi