Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Последние темы форума

Показать новые сообщения »

Почтовая рассылка

Подписчиков: 11855
Последний выпуск: 19.06.2015

WinApi и COM

3.6K
17 ноября 2009 года
0nni
326 / / 24.06.2008
Пытаюсь прикрутить Ole-Drop к окну созданному через api-ничего не получается, хотя тот же самый объект (TDropObject) преспокойно регистрирует окно VCL. Возможно что-то, где-то нужно инициализировать?

Код:
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.


Да, результат RegisterDragDrop = -2147024882
14
17 ноября 2009 года
Phodopus
3.3K / / 19.06.2008
Возвращает E_OUTOFMEMORY. Смотри, какие методы интерфейсного класса вызываются.
ПыСы. TDropObject лучше наследовать от TInterfacedObject.
3.6K
17 ноября 2009 года
0nni
326 / / 24.06.2008
Цитата: Phodopus
Возвращает E_OUTOFMEMORY. Смотри, какие методы интерфейсного класса вызываются.


Никакие методы не вызываются. Мне кажется я что то не сделал для начала работы с com. Тк после того как я добавил forms.pas в uses все чудесным образом заработало, в initialization ничего интересного не нашел. Несколько раз пытался отследить по цепочке uses но всегда возвращался на forms.

Цитата: Phodopus
ПыСы. TDropObject лучше наследовать от TInterfacedObject.


Удобно.

3.6K
18 ноября 2009 года
0nni
326 / / 24.06.2008
Ага, все. Помимо CoInitialize нужно было сделать OleInitialize. В VCL Это делается где то вглубине, поэтому в примерах для дельфи об этом не говорится.
14
18 ноября 2009 года
Phodopus
3.3K / / 19.06.2008
В OleAuto или OleCtnrs. Странно, была такая мысль, но мне тоже казалось Co* хватит.
3.6K
18 ноября 2009 года
0nni
326 / / 24.06.2008
CoInitialize - ole32.dll
OleInitialize - ole32.dll
Обе описаны в ActiveX.pas

Ну и OleUninitialize, CoUninitialize, думаю в обратном порядке вызывать.
194
18 ноября 2009 года
GIZMO
1.8K / / 30.07.2004
Цитата: Phodopus
В OleAuto или OleCtnrs. Странно, была такая мысль, но мне тоже казалось Co* хватит.



когда кажется - креститься надо:)

OleInitialize в отличии от СоInitialize инициализирует подсистему пользовательского интерфейса COM (в т.ч. drag-and-drop).


Цитата: 0nni
CoInitialize - ole32.dll
OleInitialize - ole32.dll
Обе описаны в ActiveX.pas

Ну и OleUninitialize, CoUninitialize, думаю в обратном порядке вызывать.


Это значит, что OleInitialize вызывает СоInitialize. Т.е. достаточно "только" OleInitialize.

9.0K
30 ноября 2009 года
grag63
71 / / 23.01.2006
не помешает также инициализировать интерфейс IDropTargetHelper...

Знаете кого-то, кто может ответить? Поделитесь с ним ссылкой.

Ваш ответ

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог