Usando un TListBox

[darkamerico]

Saludos amigos, tengo un TListBox que es llenado tras la pulsacion de un boton, tambien al hacer doble click sobre un elemento de la lista este se borra.

Ahora lo que deseo es agregar un TLabel que me vaya dando el numero de elementos que tiene el TListBox en cada momento, no existe algun Change como en el combo, donde pueda implementar dicha funcionalidad, o quizas no estoy enfocando el tema de forma adecuada.


Agradezco las nuevas ideas.

Atte,

Americo

[Neftali [Germán.Estévez]]

Como habrás visto, el TListBox no posee evento OnChange, así que tendrás que hacerlo de otra forma.
Lo más sencillo tal vez sea actualizar el contenido del TLabel con el número de elementos del ListBox (Listbox1.count) cada vez que añades o borras un elemento.

[darkamerico]

Bien has dicho Neftali, al señalar que no existe un evento OnChange, aqui encontre una unidad que añade ese evento y otros mas al componente TListBox:

Código Delphi [-]
unit ListBoxOnChangeU;
{
*****************************************************************************
*                                                                           *
*              TListBox Extention with Drag/Drop and On Change              *
*                                                                           *
*                            By Jens Borrisholt                             *
*                           Jens@Borrisholt.com                             *
*                                                                           *
* This file may be distributed and/or modified under the terms of the GNU   *
* General Public License (GPL) version 2 as published by the Free Software  *
* Foundation.                                                               *
*                                                                           *
* This file has no warranty and is used at the users own peril              *
*                                                                           *
* Please report any bugs to Jens@Borrisholt.com or contact me if you want   *
* to contribute to this unit.  It will be deemed a breach of copyright if   *
* you publish any source code  (modified or not) herein under your own name *
* without the authors consent!!!!!                                          *
*                                                                           *
* CONTRIBUTIONS:-                                                           *
*      Jens Borrisholt (Jens@Borrisholt.com) [ORIGINAL AUTHOR]              *
*                                                                           *
* Published:  http://delphi.about.com/.......                               *
*****************************************************************************
}

interface
uses
  Windows, Messages, Classes, Controls, StdCtrls;

{$M+}
type
  TListBox = class(StdCtrls.TListBox)
  private
    FOnChange: TNotifyEvent;
    FDragDropListBox: TListBox;
    FAllowInternalDrag: Boolean;
    FLButtonDown: Boolean;
    procedure SetOnChange(const Value: TNotifyEvent);
    procedure SetDragDropListBox(const Value: TListBox);
    procedure SetAllowInternalDrag(const Value: Boolean);
    function GetActiveString: string;
    function GetActiveObject: TObject;
  published
    property ActiveString: string read GetActiveString;
    property ActiveObject: TObject read GetActiveObject;
    property AllowInternalDrag: Boolean read FAllowInternalDrag write SetAllowInternalDrag;
    property DragDropListBox: TListBox read FDragDropListBox write SetDragDropListBox;
    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    function ItemAtPos(PosX, PosY: Integer; Existing: Boolean): Integer;
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure DoChange;
    procedure SetItemIndex(const Value: Integer); override;

    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMMOuseMove(var Message: TWMMouse); message WM_MOUSEMOVE;
  end;

implementation

{ TListBox }

constructor TListBox.Create(AOwner: TComponent);
begin
  inherited;
  FAllowInternalDrag := True;
  FLButtonDown := False;
end;

procedure TListBox.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TListBox.DragDrop(Source: TObject; X, Y: Integer);
var
  DropPosition: Integer;
  SourceListBox: TListBox;
  SourceStrValue: string;
  SourceObjValue: TObject;
begin
  DropPosition := ItemAtPos(x, y, True);
  SourceListBox := TListBox(Source);

  SourceStrValue := SourceListBox.ActiveString;
  SourceObjValue := SourceListBox.ActiveObject;

  SourceListBox.Items.Delete(SourceListBox.ItemIndex);

  if DropPosition < 0 then
    DropPosition := Items.Count;

  Items.InsertObject(DropPosition, SourceStrValue, SourceObjValue);

  inherited;
  DoChange;
end;

procedure TListBox.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  inherited;

  if FDragDropListBox = nil then
    Exit;

  Accept := (Integer(Source) = Integer(Self)) and (FAllowInternalDrag);

  if not Accept then
    Accept := (Integer(Source) = Integer(FDragDropListBox));
end;

function TListBox.GetActiveObject: TObject;
begin
  Result := nil;

  if ItemIndex < 0 then
    exit;

  Result := Items.Objects[ItemIndex];
end;

function TListBox.GetActiveString: string;
begin
  Result := '';

  if ItemIndex < 0 then
    Exit;

  Result := Items[ItemIndex];
end;

function TListBox.ItemAtPos(PosX, PosY: Integer; Existing: Boolean): Integer;
begin
  Result := inherited ItemAtPos(Point(PosX, PosY), Existing);
end;

procedure TListBox.SetAllowInternalDrag(const Value: Boolean);
begin
  FAllowInternalDrag := Value;
end;

procedure TListBox.SetDragDropListBox(const Value: TListBox);
begin
  FDragDropListBox := Value;
  if Value <> nil then
  begin
    DragMode := dmAutomatic;
    Value.FDragDropListBox := Self;
    Value.DragMode := dmAutomatic;
  end
  else
  begin
    DragMode := dmManual;
    Value.FDragDropListBox := nil;
    Value.DragMode := dmManual;
  end;
end;

procedure TListBox.SetItemIndex(const Value: Integer);
begin
  inherited;
  DoChange;
end;

procedure TListBox.SetOnChange(const Value: TNotifyEvent);
begin
  FOnChange := Value;
end;

procedure TListBox.WMKeyDown(var Message: TWMKeyDown);
var
  OldIndex: Integer;
begin
  OldIndex := ItemIndex;
  inherited;
  if OldIndex <> ItemIndex then
    DoChange;
end;

procedure TListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  OldIndex: Integer;
begin
  FLButtonDown := True;
  OldIndex := ItemIndex;
  inherited;
  if OldIndex <> ItemIndex then
    DoChange;
end;

procedure TListBox.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FLButtonDown := False;
  inherited;
end;

procedure TListBox.WMMOuseMove(var Message: TWMMouse);
begin
  if not FLButtonDown then
    exit;

  inherited;
  DoChange;
end;

end.

Luego de eso en el evento OnCreate del formulario agregamos la referencia esa unidad y asignamos los eventos:

Código Delphi [-]
//assign a onchanve event to your ListBox
   ListBox1.OnChange := ListBox1Change;
 
   //If you only want to drag items in you own listbox
   //ListBox1.DragDropListBox := ListBox1;
 
 
   //If you only want to drag between two listboxes
   ListBox1.DragDropListBox := ListBox2;
 
   //do now allow items do be dragged within the Listbox
   ListBox1.AllowInternalDrag := false;
 end;

------------------------------------
La fuente de este codigo es: Esta
------------------------------------

Sin embargo, al correr el programa dicho evento no se ejecuta como espero, se activa cuando paso el mouse por encima del TListBox. Se que la solucion esta cerca...

Atentamente

[ecfisa]

Hola darkamerico.

No te aconsejo complicarte con semejante código si la tarea que va a desempeñar no lo justifica.

Mira que simple resulta como te sugiere Neftali:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  with ListBox1 do
  begin
    Items.Add('Item'+IntToStr(Random(100)+1)); // (un item X...)
    Label1.Caption := IntToStr(Items.Count);
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  with ListBox1 do
    if ItemIndex <> -1 then
    begin
      Items.Delete(ItemIndex);
      Label1.Caption := IntToStr(Items.Count);
    end;
end;

Saludos.

[Neftali [Germán.Estévez]]

Además, ese código, tal y como indica en el encabezado añade soporte para Darg & Drop, cosa que entiendo no te hace falta.
Si necesitaras usarlo de forma intensiva (muchos componentes) tal vez estaría justificado, de otra forma creo que es demasiado.

[darkamerico]

Estamos de acuerdo en que el monto de codigo quizas sea demasiado para esta tarea diminuta que estoy haciendo, pero viendolo en el tiempo, se compensa el esfuerzo de esta solucion, y no estare volviendo a crear otro hilo .

Un abrazo a los dps, gracias por su interes.


Atte,