Недавно добавленные исходники

•  Animation Loaders  923

•  DeLiKaTeS Tetris (Тетрис)  5 869

•  TDictionary Custom Sort  7 815

•  Fast Watermark Sources  7 489

•  3D Designer  10 724

•  Sik Screen Capture  8 041

•  Patch Maker  8 249

•  Айболит (remote control)  8 300

•  ListBox Drag & Drop  7 116

•  Доска для игры Реверси  100 850

•  Графические эффекты  8 366

•  Рисование по маске  7 740

•  Перетаскивание изображений  6 343

•  Canvas Drawing  6 712

•  Рисование Луны  6 645

•  Поворот изображения  5 780

•  Рисование стержней  4 721

•  Paint on Shape  3 428

•  Генератор кроссвордов  4 410

•  Головоломка Paletto  3 554

•  Теорема Монжа об окружностях  4 352

•  Пазл Numbrix  2 819

•  Заборы и коммивояжеры  3 771

•  Игра HIP  2 539

•  Игра Go (Го)  2 539

•  Симулятор лифта  2 935

•  Программа укладки плитки  2 361

•  Генератор лабиринта  3 112

•  Проверка числового ввода  2 597

•  HEX View  3 001

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как пpинимать яpлыки пpи пеpетягивании их на контpол



Автор: Nomadic


TForm1 = class(TForm)
  ...
  private
    { Private declarations }
    procedure WMDropFiles(var M: TWMDropFiles); message WM_DROPFILES;
  ...
end;

var
  Form1: TForm1;

implementation

uses
  StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ...
  DragAcceptFiles(Handle, True);
  ...
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ...
  DragAcceptFiles(Handle, False);
  ...
end;

procedure TForm1.WMDropFiles(var M: TWMDropFiles);
var
  hDrop: Cardinal;
  n: Integer;
  s: string;
begin
  hDrop := M.Drop;
  n := DragQueryFile(hDrop, 0, nil, 0);
  SetLength(s, n);
  DragQueryFile(hDrop, 0, PChar(s), n + 1);
  DragFinish(hDrop);
  M.Result := 0;
  FileOpen(s);
end;

procedure TForm1.FileOpen(FileName: string);
begin
  if CompareText(ExtractFileExt(FileName), '.lnk') = 0 then
    FileName := ResolveShortcut(Application.Handle, FileName);
  DocName := ExtractFileName(FileName);
  Caption := Application.Title + ' - ' + DocName;
  ...
end;

function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;
var
  obj: IUnknown;
  isl: IShellLink;
  ipf: IPersistFile;
  pfd: TWin32FindDataA;
begin
  Result := '';
  obj := CreateComObject(CLSID_ShellLink);
  isl := obj as IShellLink;
  ipf := obj as IPersistFile;
  ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);
  with isl do
  begin
    Resolve(Wnd, SLR_ANY_MATCH);
    SetLength(Result, MAX_PATH);
    GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);
    Result := PChar(Result);
  end;
end;








Copyright © 2004-2026 "Delphi Sources" by «SiteAnalyzer». Delphi World FAQ

Группа ВКонтакте