WinApi и COM

program Project1;

uses
  Windows,
  Messages,
  ComObj,
  ActiveX;

type
  { Класс-приемник }
  TDropObject = class(TObject, IDropTarget)
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { TDropTareget }
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
  end;

{ TDropObject }

function TDropObject.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
end;

function TDropObject.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TDropObject.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  Result := S_OK;
end;

function TDropObject.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
end;

function TDropObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
end;

function TDropObject._AddRef: Integer;
begin
  Result := 1;
end;

function TDropObject._Release: Integer;
begin
  Result := 1;
end;

{ Оконная процедура }

function WndProc(Wnd : HWND; msg : Cardinal; wParam, lParam : Integer) : Integer; stdcall;
begin
case msg of
    WM_CREATE : {$REGION}
        begin

        end; {$ENDREGION 'WM_CREATE'}
    WM_DESTROY : {$REGION}
        begin
                  //Убираем за собой
                  RevokeDragDrop(wnd);
                  OleUninitialize;
        end; {$ENDREGION 'WM_DESTROY'}
    else
        begin
          Result := DefWindowProc(Wnd, msg, wParam, lParam);
        end;
    end
end;

var
  Wc : TWndClass;
  Wnd : HWND;
  Msg : TMsg;
  DropObject : TDropObject;

begin
  //Инициалазицая Com
  CoInitialize(nil);           

  //Регистрация окна  
  ZeroMemory(@wc, SizeOf(wc));
  Wc.style := CS_DBLCLKS or CS_OWNDC;
  Wc.lpfnWndProc := @WndProc;
  Wc.cbClsExtra := 0;
  Wc.cbWndExtra := 0;
  Wc.hInstance := hInstance;
  Wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  Wc.hCursor := LoadCursor(0, IDC_ARROW);
  Wc.hbrBackground := COLOR_BTNFACE + 1;
  Wc.lpszClassName := 'MyWndClass';
  if not Boolean(RegisterClass(wc)) then
  begin
    MessageBox(0, PChar('Class <' + wc.lpszClassName + '> is not registered'), nil, MB_ICONERROR or MB_SYSTEMMODAL);
    OleUninitialize;
    ExitProcess(0);
  end;
  //Создание окна
  Wnd := CreateWindow('MyWndClass', nil, WS_OVERLAPPEDWINDOW,
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, HInstance, nil);

  //Создание и регистрация DropTarget
  DropObject := TDropObject.Create;
  RegisterDragDrop(Wnd, DropObject);

     
  ShowWindow(Wnd, SW_SHOW);
  while GetMessage(msg, 0, 0, 0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end.