| darkamerico |
05-06-2013 18:21:25 |
Avanzando hacia la solucion
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;
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
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 [-] ListBox1.OnChange := ListBox1Change;
ListBox1.DragDropListBox := ListBox2;
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
|