VPF::Drag and Drop - Форум программистов

Guest

Дата 4.9.2005, 20:06 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Методом Drag and drop я перетаскиваю файлы и папки на моей форме, но в Listbox-e я получаю только путь к нему. Как получить иконку перетаскиваемого обьекта и кликнув по ней открыть этот файл (папку)? Или как это реализованно в программах как Mouse Utiliti, ObjectDesktop.

Poseidon

Дата 4.9.2005, 21:35 (ссылка)

(нет голосов)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
     procedure WMDROPFILES (var Msg: TMessage); message WM_DROPFILES;
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

uses ShellApi;

procedure TForm1.WMDROPFILES (var Msg: TMessage);
var
  i,amount,size: integer;
  Filename: PChar;
begin
  inherited;
  Amount := DragQueryFile(Msg.WParam, $FFFFFFFF, Filename, 255);
  for i := 0 to (Amount - 1) do
  begin
    size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
    Filename:= StrAlloc(size);
    DragQueryFile(Msg.WParam,i , Filename, size);
    listbox1.items.add(StrPas(Filename));
    StrDispose(Filename);
  end;
  DragFinish(Msg.WParam);
end;

function Icon2Bitmap(Icon: TIcon): TBitmap;
begin
  with TImageList.Create (nil) do
  begin
    AddIcon (Icon);
    Result := TBitmap.Create;
    GetBitmap (0, Result); 
    Free;
  end;
end;


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
Icon: TIcon;
BitMap: TBitMap;
Offset: Integer;
BMPRect: TRect;
IconIndex: word;
hndIcon: hIcon;

begin
with (Control as TListBox).Canvas do
    begin
      FillRect(Rect);
      Icon:= TIcon.Create;

      IconIndex := 1;
      hndIcon := ExtractAssociatedIcon(HInstance,
      PChar(ListBox1.Items[INDEX]), IconIndex);

      Icon.Handle:= hndIcon;
      BitMap:= Icon2Bitmap(Icon);
      Icon.Free;
      Offset := 0;
      if Bitmap <> nil
      then
        begin
        BMPRect:= Bounds(Rect.Left+2, Rect.Top, BitMap.Width, BitMap.Height);
        BrushCopy(BMPRect, Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),
                  Bitmap.Canvas.Pixels[0, Bitmap.Height-1]);
        Offset := Rect.Bottom - Rect.Top + 4
        end;
      TextOut(Rect.Left + Offset, Rect.Top, ListBox1.Items[Index]);
      BitMap.Free;
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style:= lbOwnerDrawFixed; // можно в инспекторе обьектов изменить

DragAcceptFiles(Handle, true);
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var Index: Integer;
begin
Index:= ListBox1.ItemIndex;
if Index = -1 then exit;

ShellExecute(handle,nil,PAnsiChar(ListBox1.Items[Index]),nil,nil,SW_Restore);
end;

end.

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

Guest

Дата 5.9.2005, 09:06 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Спасибо, очень понравилось но так как апетит растет дальше хотелось бы задать другой вопрос. А как теперь получить иконку в реальную величину, спрятать путь к проге/папке, показать подсказку с названием обьекта? Насколько я понимаю в Listbox-e это невозможно.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »