Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 24-10-2011
jumasuro jumasuro is offline
Registrado
 
Registrado: feb 2007
Posts: 7
Poder: 0
jumasuro Va por buen camino
Asignar Drag&Drop a paneles creados en tiempo de ejecución

Hola a todos,
aunque llevo años consultando este foro, y aunque hasta ahora no me había visto en la necesidad de preguntar ya que siempre había encontrado la solución rebuscando un poco entre todos los mensajes, en esta ocasión no consigo solucionar el problema que tengo y por eso recurro a vosotros, a ver podéis echarme una mano.

Tengo un formulario en el que creo varios paneles en tiempo de ejecución y estoy intentando hacer que se puedan arrastrar archivos sobre cada uno de ellos desde el explorador de windows (sólo en los paneles).
El caso es que se como "asignar" el drag&drop a un panel, pero no como hacerlo para todos los que se creen durante la ejecución.
Este es el código que tengo en mi formulario para asignar el drag&drop a un panel:

Código Delphi [-]
unit Unit1;  

interface  
uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ShellApi, ExtCtrls, StdCtrls;  
type   
  TForm1 = class(TForm)     
    Memo1: TMemo;     
    procedure FormCreate(Sender: TObject);   
  private     { Private declarations }     
    originalPanelWindowProc : TWndMethod;     
    procedure PanelWindowProc (var Msg : TMessage) ;     
    procedure PanelFilesDrop (var Msg : TWMDROPFILES) ;  
  public     { Public declarations }   
  end;  

var   
  Form1: TForm1;  

implementation  {$R *.dfm}  

procedure TForm1.FormCreate(Sender: TObject); 
var   
  i : integer;   
  Panel : TPanel; 
begin   
  //Creo el panel1   
  Panel := TPanel.Create(Self);   
  Panel.Parent := Self;   
  Panel.Name := 'Panel1';   
  Panel.Top := 2;   
  Panel.Left := 2;   
  Panel.Height := 100;   
  Panel.Width := 100;   
  Panel.Show;    
  //Creo el panel2   
  Panel := TPanel.Create(Self);   
  Panel.Parent := Self;   
  Panel.Name := 'Panel2';   
  Panel.Top := 2;   
  Panel.Left := 120;   
  Panel.Height := 100;   
  Panel.Width := 100;   
  Panel.Show; 
  //Esto sería para asignar el drag&drop a un sólo panel (panel1) 
  {  originalPanelWindowProc := Panel1.WindowProc;   Panel1.WindowProc := PanelWindowProc;   DragAcceptFiles(Panel1.Handle,true) ; }  
  //Esto sería para asignar dinámicamente el mensaje del drag&drop a todos los paneles (Esto es lo que no se hacer)  
  for i := 0 to ComponentCount-1 do   
  begin     
    if (Components[i] is TPanel) then     
    begin       
      originalPanelWindowProc := (Components[i] as TPanel).WindowProc;       
        (Components[i] as TPanel).WindowProc := PanelWindowProc;       
     DragAcceptFiles((Components[i] as TPanel).Handle,true) ;     
    end;   
  end; 
end;  

procedure TForm1.PanelWindowProc(var Msg: TMessage); 
begin   
  if Msg.Msg = WM_DROPFILES then     
    PanelFilesDrop(TWMDROPFILES(Msg))   
  else     
    originalPanelWindowProc(Msg) ; 
end;  

procedure TForm1.PanelFilesDrop(var Msg: TWMDROPFILES); 
const   
  MAXFILENAME = 255; 
var   
  cnt, fileCount : integer;   
  fileName : array [0..MAXFILENAME] of char; 
begin   
  fileCount := DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAXFILENAME) ;    
  for cnt := 0 to -1 + fileCount do   
  begin     
     DragQueryFile(msg.Drop, cnt, fileName, MAXFILENAME) ;      
     memo1.Lines.Insert(0, fileName) ;   
  end;    
  DragFinish(msg.Drop) ; 
end;

El ejemplo anterior consta únicamente de un formulario, un memo (memo1) donde muestro la ruta de los ficheros que se han arrastrado sobre los paneles y 2 paneles creados en tiempo de ejecución.
El problema lo tengo con el "originalPanelWindowProc" y el procedimiento "PanelWindowProc (var Msg : TMessage)", que cuando sólo hay un panel funciona correctamente pero en cuanto hay más ya no funciona. Si mis pocos conocimientos de delphi no me engañan, el problema es que no se puede asignar el mismo "originalPanelWindowProc" y procedimiento "PanelWindowProc (var Msg : TMessage)" a todos los paneles creados, pero no se como generar dichos mensajes de forma dinámica para cada uno de los paneles creados.

¿Podéis echarme una mano?.
Muchas gracias.

Última edición por ecfisa fecha: 24-10-2011 a las 18:20:55. Razón: Corregir problema de etiquetas bajo interfaz WYSIWYG
Responder Con Cita
  #2  
Antiguo 24-10-2011
Avatar de duilioisola
[duilioisola] duilioisola is offline
Miembro Premium
 
Registrado: ago 2007
Ubicación: Barcelona, España
Posts: 1.734
Poder: 20
duilioisola Es un diamante en brutoduilioisola Es un diamante en brutoduilioisola Es un diamante en bruto
El problema parece ser que originalPanelWindowProc siempre será el del último TPanel que recorras en el bucle.
Luego, cada vez que llega un mensaje (excepto el de WM_DROPFILES) enviará el mensaje al ultimo panel y empezará a dar errores.

Creo que la mejor solución es que hagas un panel propio que descienda de TPanel y que tenga una propiedad más que guarde esta información y maneje los mensajes.
Voy a hacer alguna prueba y si me sale te envío algo de código...
Responder Con Cita
  #3  
Antiguo 24-10-2011
Avatar de duilioisola
[duilioisola] duilioisola is offline
Miembro Premium
 
Registrado: ago 2007
Ubicación: Barcelona, España
Posts: 1.734
Poder: 20
duilioisola Es un diamante en brutoduilioisola Es un diamante en brutoduilioisola Es un diamante en bruto
Aquí tienes el código del que te hablé antes.
Pon un TMemo llamado Memo1 alineado alTop y deja un espacio abajo para que aparezcan los dos paneles.

Código Delphi [-]
unit UPruebaDragAndDrop;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellApi, StdCtrls, ExtCtrls;

type
  TPanelDragAndDrop = class(TCustomPanel)
  private
    FFiles : TStrings;
    OriginalPanelWindowProc : TWndMethod;
    FOnFileDrop : TNotifyEvent;
    procedure PanelWindowProc (var Msg : TMessage);
    procedure PanelFilesDrop (var Msg : TWMDROPFILES);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnFileDrop : TNotifyEvent read FOnFileDrop write FOnFileDrop;
    property Files : TStrings read FFiles write FFiles;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure PanelFileDrop(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

/// ********** ********** ********** ********** ********** **********
/// TPanelDragAndDrop
/// ********** ********** ********** ********** ********** **********
/// Descendiente de TCustomPanel
/// Acepta que le hechen archivos
/// Publica un evento OnFileDrop
/// Publica la lista de archivos que le cayeron
/// NO VACIA LA LISTA DE ARCHIVOS

procedure TPanelDragAndDrop.PanelWindowProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_DROPFILES then
    PanelFilesDrop(TWMDROPFILES(Msg))
  else
    OriginalPanelWindowProc(Msg);
end;

procedure TPanelDragAndDrop.PanelFilesDrop(var Msg: TWMDROPFILES);
const
  MAXFILENAME = 255;
var
  cnt, FileCount : integer;
  FileName : array [0..MAXFILENAME] of char;
begin
  FileCount := DragQueryFile(msg.Drop, $FFFFFFFF, FileName, MAXFILENAME);
  for cnt := 0 to -1 + FileCount do
  begin
     DragQueryFile(msg.Drop, cnt, FileName, MAXFILENAME);
     FFiles.Add(FileName);
  end;
  DragFinish(msg.Drop);

  if Assigned(OnFileDrop) then
     OnFileDrop(Self);
end;

constructor TPanelDragAndDrop.Create(AOwner: TComponent);
begin
  inherited;
  FFiles := TStringList.Create;
  Self.Parent := TWinControl(AOwner);
  
  OriginalPanelWindowProc := WindowProc;
  WindowProc := PanelWindowProc;
  DragAcceptFiles(Handle, True);
end;

destructor TPanelDragAndDrop.Destroy;
begin
  FFiles.Free;
  inherited;
end;

/// ********** ********** ********** ********** ********** **********
/// TForm1
/// ********** ********** ********** ********** ********** **********

procedure TForm1.FormCreate(Sender: TObject);
var
  i : integer;
  Panel : TPanelDragAndDrop;
begin
  //Creo el panel1
  Panel := TPanelDragAndDrop.Create(Self);
  Panel.Parent := Self;
  Panel.Name := 'autoPanel1';
  Panel.Align := alLeft;
  Panel.Show;

  //Creo el panel2
  Panel := TPanelDragAndDrop.Create(Self);
  Panel.Parent := Self;
  Panel.Name := 'autoPanel2';
  Panel.Align := alRight;
  Panel.Show;

  for i := 0 to ComponentCount-1 do
  begin
    if (Components[i] is TPanelDragAndDrop) then
        (Components[i] as TPanelDragAndDrop).OnFileDrop := PanelFileDrop;
  end;
end;

procedure TForm1.PanelFileDrop(Sender: TObject);
var
   i : integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Add(Format('Entraron %d archivos desde el panel %s', [TPanelDragAndDrop(Sender).Files.Count, TPanelDragAndDrop(Sender).Name]));
  for i := 0 to TPanelDragAndDrop(Sender).Files.Count -1 do
  begin
     Memo1.Lines.Add(TPanelDragAndDrop(Sender).Files[i]);
  end;
  TPanelDragAndDrop(Sender).Files.Clear;
end;

end.
Responder Con Cita
  #4  
Antiguo 25-10-2011
jumasuro jumasuro is offline
Registrado
 
Registrado: feb 2007
Posts: 7
Poder: 0
jumasuro Va por buen camino
Muchas gracias duilioisola,
desde luego está claro que aun me falta mucho por aprender, voy a probarlo y te cuento.

Un saludo.
Responder Con Cita
  #5  
Antiguo 25-10-2011
jumasuro jumasuro is offline
Registrado
 
Registrado: feb 2007
Posts: 7
Poder: 0
jumasuro Va por buen camino
Hola,
ya lo he probado y funciona a la perfección!.
Estoy bastante perdido con las propiedades de los objetos y tengo que mirarlo porque veo que son muy útiles y bastante habituales, así que tendré que dedicar un tiempo a aprender como funcionan.

Ahora me surge otro problema, y es que estoy viendo que no me va a quedar más remedio que cambiar esos paneles por frames, ya que tengo que añadirles una imagen (con un evento al hacer dobleclick sobre ella) y una label con un texto.
Pero al intentar adaptar el código del panel a un frame me he dado cuenta que no se como hacerlo.

En resumen, tengo un frame con un panel (sólo lo estoy usando como contenedor de la imagen y la label, así que a lo mejor se podría prescindir de él), una imagen y una label.
En el formulario iría añadiendo instancias de ese frame en tiempo de ejecución según fuese necesario.
¿Se puede implementar el ejemplo del drag&drop al frame (o al panel o a la imagen que tiene dentro)?, es decir, que al arrastrar los ficheros sobre cualquiera de los frames del formulario funcione el drag&drop como en el ejemplo de los paneles?.

Muchas gracias por todo y perdón por el cambio del panel por el frame, pero es que hasta que he visto la solución al problema que tenía inicialmente no me he dado cuenta de que tenía que haber pensado mejor donde lo tendría que hacer...
Responder Con Cita
  #6  
Antiguo 26-10-2011
jumasuro jumasuro is offline
Registrado
 
Registrado: feb 2007
Posts: 7
Poder: 0
jumasuro Va por buen camino
Hola a todos,
después de unas cuantas pruebas por fin creo haber conseguido implementar el drag&drop en el frame.
Rebuscando un poco por el foro e internet me he dado cuenta que tanto el constructor como el destructor del frame estaban disponibles, simplemente que no me daba cuenta de que podía acceder a ellos, así que siguiendo el ejemplo que me puso duilioisola, modifiqué mi frame y parece que ya hace lo que quiero.
Pongo aquí el código por si alguien se encuentra con un problema similar...

- Código del Frame:
(un frame con una imagen y una label)

Código Delphi [-]
...
type
  TFrameCnt = class(TFrame)
    imgFrame: TImage;
    lblFrame: TLabel;
  private
    { Private declarations }
    FFiles : TStrings;
    OriginalfrmWindowProc : TWndMethod;
    FOnFileDrop : TNotifyEvent;
    procedure frmWindowProc (var Msg : TMessage);
    procedure frmFilesDrop (var Msg : TWMDROPFILES);
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy; override;
  published
    property OnFileDrop : TNotifyEvent read FOnFileDrop write FOnFileDrop;
    property Files : TStrings read FFiles write FFiles;
  end;

implementation

{$R *.dfm}

constructor TFrameCnt.Create(AOwner: TComponent);
begin
  inherited;

  FFiles := TStringList.Create;
  Self.Parent := TWinControl(AOwner);

  OriginalfrmWindowProc := WindowProc;
  WindowProc := frmWindowProc;
  DragAcceptFiles(Handle, True);
end;


destructor TFrameCnt.Destroy;
begin
  FFiles.Free;
  inherited;
end;


procedure TFrameCnt.frmWindowProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_DROPFILES then
    frmFilesDrop(TWMDROPFILES(Msg))
  else
    OriginalfrmWindowProc(Msg);
end;


procedure TFrameCnt.frmFilesDrop(var Msg: TWMDROPFILES);
const
  MAXFILENAME = 255;
var
  cnt, FileCount : integer;
  FileName : array [0..MAXFILENAME] of char;
begin
  FileCount := DragQueryFile(msg.Drop, $FFFFFFFF, FileName, MAXFILENAME);
  for cnt := 0 to -1 + FileCount do
  begin
     DragQueryFile(msg.Drop, cnt, FileName, MAXFILENAME);
     FFiles.Add(FileName);
  end;
  DragFinish(msg.Drop);

  if Assigned(OnFileDrop) then
     OnFileDrop(Self);
end;
...

- Código del formulario principal:
(un formulario con un memo y un par de frames creados en tiempo de ejecución)

Código Delphi [-]
...
type
  TwndPrincipal = class(TForm)
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
...
  private
    { Private declarations }
    //***** Para que funcione el Drag & Drop en los frames *********************
    procedure frmFileDrop(Sender: TObject);
    //**************************************************************************
  public
    { Public declarations }
  end;
...

procedure TwndPrincipal.FormShow(Sender: TObject);
var
  Frame : TFrameCnt;
  cont, i : integer;
begin
  cont := 0;

  //Creamos el frame1
  Frame:= TFrameCnt.Create(Self);
  Frame.Parent := self;
  Frame.Name := '';
  Frame.Top := (cont * Frame.Height) + 1;
  Frame.Left := 1;
  Frame.Width := 49;
  Frame.lblFrame.Caption := 'Frame1';
  Frame.Show;

  inc(cont);

  //Creamos el frame2
  Frame:= TFrameCnt.Create(Self);
  Frame.Parent := self;
  Frame.Name := '';
  Frame.Top := (cont * Frame.Height) + 1;
  Frame.Left := 1;
  Frame.Width := 49;
  Frame.lblFrame.Caption := 'Frame2';
  Frame.Show;

  for i := 0 to ComponentCount-1 do
  begin
    if (Components[i] is TFrameCnt) then
        (Components[i] as TFrameCnt).OnFileDrop := frmFileDrop;
  end;
  ...
end;


procedure TwndPrincipal.frmFileDrop(Sender: TObject);
var
   i : integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Add(Format('Entraron %d archivos desde el panel %s', [TFrameCnt(Sender).Files.Count, TFrameCnt(Sender).Name]));
  for i := 0 to TFrameCnt(Sender).Files.Count -1 do
  begin
     Memo1.Lines.Add(TFrameCnt(Sender).Files[i]);
  end;
  TFrameCnt(Sender).Files.Clear;
end;

Muchas gracias y un saludo.
Responder Con Cita
  #7  
Antiguo 26-10-2011
Avatar de alej.villa
alej.villa alej.villa is offline
Miembro
NULL
 
Registrado: may 2011
Ubicación: Caracas, Venezuela
Posts: 76
Poder: 13
alej.villa Va por buen camino
Solo por curiosidad

Cita:
Empezado por jumasuro Ver Mensaje
Memo1.Lines.Add(Format('Entraron %d archivos desde el panel %s', [TFrameCnt(Sender).Files.Count, TFrameCnt(Sender).Name]));
Hola buenos días quisiera saber que significan esos valores que coloqué en negrita y como se deben usar.
Responder Con Cita
  #8  
Antiguo 26-10-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.040
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Por favor, alej.villa, preguntas distintas en temas distintos, crea un nuevo tema haciendo esa pregunta, no mezclemos las cosas, gracias Recuerda leer nuestra guía de estilo.
Responder Con Cita
Respuesta



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
Controlar componentes creados en tiempo de ejecución. damirua OOP 1 13-05-2010 14:03:58
Error TStringList creados en tiempo de ejecución subzero Varios 14 26-01-2008 13:58:05
Destruir Qrlabels creados en tiempo de ejecucion Ade Impresión 6 08-10-2006 19:46:28
Eventos en componentes creados en tiempo de ejecucion joumont OOP 3 27-12-2005 14:48:23
Objetos creados en tiempo de ejecución Scocc OOP 4 13-06-2003 20:55:29


La franja horaria es GMT +2. Ahora son las 23:38:31.


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