Ver Mensaje Individual
  #6  
Antiguo 26-10-2011
jumasuro jumasuro is offline
Registrado
 
Registrado: feb 2007
Posts: 7
Reputación: 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