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

•  Animation Loaders  695

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

•  TDictionary Custom Sort  7 653

•  Fast Watermark Sources  7 345

•  3D Designer  10 554

•  Sik Screen Capture  7 871

•  Patch Maker  8 094

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

•  ListBox Drag & Drop  6 948

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

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

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

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

•  Canvas Drawing  6 581

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

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

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

•  Paint on Shape  3 300

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

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

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

•  Пазл Numbrix  2 755

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

•  Игра HIP  2 467

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

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

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

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

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

•  HEX View  2 927

 
скрыть

  Форум  

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

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