Как передать метод как обратный вызов к Windows API call?

Какую версию Delphi вы используете?

В последних версиях вы можете использовать статические методы класса для этого:

TMyClass = class
public
  class procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall; static;
  procedure DoIt;
end;
[...]
procedure TMyClass.DoIt;
begin
  SetTimer(0, 0, 8, @TimerProc);  
end;

TMyClass = class
public
  procedure DoIt;
  procedure DoOnTimerViaMethod;
end;

var MyReceiverObject: TMyClass;

[...]

procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall:
begin
  if Assigned(MyReceiverObject) then 
    MyReceiverObject.DoOnTimerViaMethod;
end;

procedure TMyClass.DoIt;
begin
  MyReceiverObject := Self;
  SetTimer(0, 0, 8, @TimerProc);  // <-???- that's what I want to do (last param)
end;

Не идеально. Следите за потоками, перезаписью переменных и т.д. Но это делает свою работу.

Ответ на вторую правку:

Если вы хотите получить ответ, включающий указатель на экземпляр TMyClass, вам может не повезти. По сути, процедура, которую вызывает Windows, имеет определенную сигнатуру и не является методом объекта. Вы не можете напрямую обойти это, даже с помощью __closure или procedure of object магии, за исключением случаев, описанных ниже и в других ответах. Почему?

• Windows не знает, что это метод объекта, и хочет вызвать процедуру с определенной сигнатурой.

• Указатель больше не является простым указателем - у него две половины, экземпляр объекта и метод. Ему нужно сохранить Self, а также метод.

Кстати, я не понимаю, что плохого в коротком погружении за пределы объектно-ориентированного мира. Не-ОО код не обязательно грязный если используется хорошо.

Оригинальный, до вашей правки ответ:

Это невозможно именно так, как вы пытаетесь это сделать. Метод, который хочет SetTimer, должен точно следовать сигнатуре TIMERPROC - смотрите документацию MSDN. Это простая, безобъектная процедура.

Однако метод TMyClass.DoIt является объектным методом. На самом деле он состоит из двух частей: объекта, на котором он вызывается, и самого метода. В Delphi это "процедура объекта" или "закрытие" (о процедурных типах читайте здесь). Таким образом, сигнатуры несовместимы, и вы не можете хранить экземпляр объекта, который вам нужен для вызова метода объекта. (Есть также проблемы с соглашением о вызове - стандартные методы Delphi реализованы с использованием соглашения fastcall, тогда как TIMERPROC определяет CALLBACK, который, по памяти, является макросом, расширяющимся до stdcall. Читайте больше о соглашениях вызова и особенно о fastcall.)

Итак, что же делать? Вам нужно отобразить ваш необъектно-ориентированный обратный вызов в объектно-ориентированный код.

Есть несколько способов, но самый простой следующий:

Если у вас есть только один таймер, то вы знаете, что когда вызывается обратный вызов вашего таймера, срабатывает именно этот таймер. Сохраните указатель метода в переменной типа procedure of object с соответствующей сигнатурой. Более подробную информацию см. в документации Embarcadero по ссылке выше. Возможно, это будет выглядеть так:

type TMyObjectProc = procedure of object;
var pfMyProc : TMyObjectProc;

Затем инициализируйте pfMyProc в nil. В TMyClass.DoIt установите pfMyProc в @DoIt - то есть теперь он указывает на процедуру DoIt в контексте этой конкретной инстанциации TMyClass. Затем ваш обратный вызов может вызвать этот метод.

(Если вам интересно, переменные класса, имеющие процедурный тип, как этот, являются способом внутреннего хранения обработчиков событий. Свойства OnFoo объекта VCL являются указателями на процедуры объекта.)

К сожалению, эта процедурная архитектура не является объектно-ориентированной, но именно так она должна быть сделана.

Вот как может выглядеть полный код (я не работаю с компилятором, поэтому он может работать не так, как написано, но он должен быть близок):

type TMyObjectProc = procedure of object;
var pfMyProc : TMyObjectProc;

initialization
  pfMyProc = nil;

procedure MyTimerCallback(hWnd : HWND; uMsg : DWORD; idEvent : PDWORD; dwTime : DWORD); stdcall;
begin
  if Assigned(pfMyProc) then begin
    pfMyProc(); // Calls DoIt, for the object that set the timer
    pfMyProc = nil;
  end;
end;

procedure TMyClass.MyOOCallback;
begin
  // Handle your callback here
end;

procedure TMyClass.DoIt;
begin
  pfMyProc = @MyOOCallback;
  SetTimer(0, 0, 8, @ MyTimerCallback);
end;

Другим способом было бы воспользоваться тем, что ваш таймер имеет уникальный ID. Сохраните связку между ID таймера и объектом. В обратном вызове преобразуйте ID в указатель и вызовите метод объекта.

Edit: Я заметил комментарий к другому ответу, предлагающий использовать адрес объекта в качестве ID таймера. Это работает, но это потенциально опасный хак, если в итоге у вас будет два объекта по одному и тому же адресу в разное время, и вы не вызовете KillTimer. Я использовал этот метод, но лично мне он не нравится - я думаю, что дополнительная бухгалтерия в виде хранения карты (ID таймера, указатель объекта) лучше. Хотя это действительно сводится к личному стилю.

Я использовал MakeObjectInstance несколько раз, чтобы сделать то же самое. Вот статья на эту тему: How to use a VCL class member-function as a Win32 callback

Процедура TimerProc должна быть стандартной процедурой, а не указателем на метод.

Указатель метода на самом деле является парой указателей; первый хранит адрес метода, а второй хранит ссылку на объект, которому принадлежит метод принадлежит

Редактировать

Это, возможно, настолько ООП, насколько вы сможете его понять. Все неприятные вещи скрыты от тех, кто использует ваш TMyClass.

unit Unit2;

interface

type
  TMyClass = class
  private
    FTimerID: Integer;
    FPrivateValue: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure DoIt;
  end;

implementation

uses
  Windows, Classes;

var
  ClassList: TList;

constructor TMyClass.Create;
begin
  inherited Create;
  ClassList.Add(Self);
end;

destructor TMyClass.Destroy;
var
  I: Integer;
begin
  I := ClassList.IndexOf(Self);
  if I <> -1 then
    ClassList.Delete(I);
  inherited;
end;

procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall;
var
  I: Integer;
  myClass: TMyClass;
begin
  for I := 0 to Pred(ClassList.Count) do
  begin
    myClass := TMyClass(ClassList[I]);
    if myClass.FTimerID = Integer(idEvent) then
      myClass.FPrivateValue := True;
  end;
end;

procedure TMyClass.DoIt;
begin
  FTimerID := SetTimer(0, 0, 8, @TimerProc);  // <-???- that's what I want to do (last param)
end;

initialization
  ClassList := TList.Create;

finalization
  ClassList.Free;

end.

Редактировать: (как упомянул glob)

Не забудьте добавить соглашение о вызове stdcall.