Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.08.2019, 23:33   #1
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
Сообщение Перенос файлов и папок в VirtualStringTree не срабатывает

Этот способ работал для обычных компонентов, например в обычном TreeView.
Пример, никаких ShowMessage не появляется при переносе файлов на VirtualStringTree:
Код:
type
  TForm1 = class(TForm)
// ..........
    VST1: TVirtualStringTree;
    FLst :TStrings; // файлы
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure WMDROPFILES(var Msg: TMessage); message WM_DropFiles; 
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 FLst := TStringList.Create;
 DragAcceptFiles(VST1.Handle, True);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FLst.Free;
end;

procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
  i, Amount, Size :Integer;
  Filename :PChar;
  Buf :string;
begin
  inherited;
  FileName := '';
  Amount := DragQueryFile(Msg.WParam, $FFFFFFFF, Filename, 255);
   FLst.Clear;
    try
  if Amount>0 then
  For I:=0 To Amount-1 Do
  begin
    Size := DragQueryFile(Msg.WParam, i, nil, 0)+1;
    Filename := StrAlloc(size);
      Try
    DragQueryFile(Msg.WParam, I, Filename, size);
    Buf := string(Filename);
    FLst.Add(Buf);
      Finally
    StrDispose(Filename);
      end;
  end;

  if Amount>0 then
  begin
     ShowMessage(FLst.Text);
  end
   else
  begin
   MessageBox(Handle, 'Добавлять нечего', 'Информация', MB_OK+MB_ICONINFORMATION);
  end;
    finally
  DragFinish(Msg.WParam);
    end;
end;
Как можно заставить VirtualStringTree принять список файлов/папок которые мышкой перенесли на него? И чтобы была возможность получать узел назначения или nil если курсор на пустом месте остановился.
С перемещением вручную созданных узлов куда угодно в дереве проблем нет.

Пробовал так, список файлов приходит. Но не узнать узел/nil назначения куда перенесли файлы.
Код:
uses
  SysUtils, Messages, Classes, Activex, ShellAPI, ComObj;

type
  TForm1 = class(TForm)
    VST1: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    originalEditWindowProc :TWndMethod;
    procedure EditWindowProc(var Msg:TMessage);
    procedure FilesDrop(var Msg: TWMDROPFILES);
    { Private declarations }
  public
   fDragDropFileList :TStringList;
    { Public declarations }
  protected
    { Protected declarations }
  end;

var
  Form1: TFormTray;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 fDragDropFileList := TStringList.Create;
 originalEditWindowProc := VST1.WindowProc;
 VST1.WindowProc := EditWindowProc;
 DragAcceptFiles(VST1.Handle, True);
  //
 VST1.TreeOptions.MiscOptions := VST1.TreeOptions.MiscOptions + [toCheckSupport];
 VST1.TreeOptions.SelectionOptions := VST1.TreeOptions.SelectionOptions + [toMultiSelect];
 VST1.TreeOptions.AutoOptions := VST1.TreeOptions.AutoOptions - [toAutoDeleteMovedNodes]; 
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 VST1.Clear;
 FreeAndNil(fDragDropFileList);
end;

procedure TForm1.EditWindowProc(var Msg: TMessage);
begin // DragDrop files
  // if correct message, execute the procedure
  if Msg.Msg = WM_DROPFILES then
  begin
    FilesDrop(TWMDROPFILES(Msg))
  end
   else
  begin
    // in other case do default...
    originalEditWindowProc(Msg) ;
  end;
end;

procedure TForm1.FilesDrop(var Msg: TWMDROPFILES);
var
  i :Integer;
  DroppedFilename :string;
  numFiles :LongInt;
  buffer :array[0..MAX_PATH]of Char;
begin // DragDrop files
  // Number of files
  numFiles := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0) ;
  // Accept all files
  fDragDropFileList.Clear;
  for i := 0 to (numFiles - 1) do
  begin

    DragQueryFile(Msg.Drop, i, @buffer, sizeof(buffer));

      // Proteccion
      try
    DroppedFilename := buffer;

    // HERE you can do something with the file...
  //      TreeView1.Items.AddChild(nil, DroppedFilename);
    fDragDropFileList.Add(DroppedFilename);
      except
    on E:Exception do
    begin
      // catch
    end;
      end;
  end;

  ShowMessage(fDragDropFileList.Text);
end;

end.
Alter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание папок и файлов. KAMLS Общие вопросы C/C++ 25 07.10.2018 10:39
delphi 7 перенос всех папок в каталоге в одну! ThundeRLorD Общие вопросы Delphi 3 20.10.2015 21:34
копирование файлов и папок Smagulov85 Общие вопросы Delphi 0 19.10.2010 23:16
поиск файлов и папок FAiver Общие вопросы Delphi 13 09.04.2009 18:01
Отображение скрытых файлов и папок и отображение розширения всех файлов beegl Общие вопросы Delphi 10 14.12.2008 22:02