Несовместимые типы: «обычная процедура и указатель на метод» - PullRequest
0 голосов
/ 13 марта 2019

Я следую этому примеру, чтобы создать окно внутри потока и на моем конкретном коде компилятор говорит:

Несовместимые типы: «указатель на обычную процедуру и метод»

В этой строке:

if (MagSetImageScalingCallback(hWndMag, MagImageScalingCallback)) then;

ссылка на мой обратный вызов MagImageScalingCallback .

Вот как определяется поток с вашими методами / функциями:

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows,
  Classes,
  SysUtils,
  Magnification;

type
  THostWNDThread = class(TThread)
  private
    hWndMag: HWND;
    procedure SetMagnificationWND;
    function MagImageScalingCallback(HWND: HWND; srcdata: Pointer;
      srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
      unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;
  protected
  public
  end;

procedure THostWNDThread.SetMagnificationWND;
begin
  if (MagSetImageScalingCallback(hWndMag, MagImageScalingCallback)) then;
end;

function THostWNDThread.MagImageScalingCallback(HWND: HWND; srcdata: Pointer;
  srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
  unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;
begin
  Result := True;
end;

begin
  try

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.

Единица увеличения:

unit Magnification;

{$ALIGN ON}
{$MINENUMSIZE 4}

interface

uses
  Windows;

const
  // Magnifier Class Name
  WC_MAGNIFIERA: AnsiString = 'Magnifier';
  WC_MAGNIFIERW: WideString = 'Magnifier';
  WC_MAGNIFIER = 'Magnifier';

  // Magnifier Window Styles
  MS_SHOWMAGNIFIEDCURSOR = $0001;
  MS_CLIPAROUNDCURSOR = $0002;
  MS_INVERTCOLORS = $0004;

  // Filter Modes
  MW_FILTERMODE_EXCLUDE = 0;
  MW_FILTERMODE_INCLUDE = 1;

type
  tagMAGTRANSFORM = record
    v: array[1..3, 1..3] of Single;
  end;
  MAGTRANSFORM = tagMAGTRANSFORM;
  TMagTransform = tagMAGTRANSFORM;
  PMagTransform = ^TMagTransform;

  tagMAGIMAGEHEADER = record
    width: UINT;
    height: UINT;
    format: TGUID;
    stride: UINT;
    offset: UINT;
    cbSize: UINT;
  end;
  MAGIMAGEHEADER = tagMAGIMAGEHEADER;
  TMagImageHeader = tagMAGIMAGEHEADER;
  PMagImageHeader = ^TMagImageHeader;

  tagMAGCOLOREFFECT = record
    transform: array[1..5, 1..5] of Single;
  end;
  MAGCOLOREFFECT = tagMAGCOLOREFFECT;
  TMagColorEffect = tagMAGCOLOREFFECT;
  PMagColorEffect = ^TMagColorEffect;

  TMagImageScalingCallback = function (hwnd: HWND; srcdata: Pointer;
    srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
    unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;

  THWNDArray = array[0..0] of HWND;
  PHWNDArray = ^THWNDArray;

  // Public Functions
  function MagInitialize(): BOOL; stdcall;
  function MagUninitialize(): BOOL; stdcall;

  function MagSetWindowSource(hwnd: HWND; rect: TRect): BOOL; stdcall;
  function MagGetWindowSource(hwnd: HWND; var Rect: TRect): BOOL; stdcall;
  function MagSetWindowTransform(hwnd: HWND; var Transform: TMagTransform): BOOL; stdcall;
  function MagGetWindowTransform(hwnd: HWND; var Transform: TMagTransform): BOOL; stdcall;
  function MagSetWindowFilterList(hwnd: HWND; dwFilterMode: DWORD;
    count: Integer; pHWND: PHWNDArray): BOOL; stdcall;
  function MagGetWindowFilterList(hwnd: HWND; var dwFilterMode: DWORD;
    count: Integer; pHWND: PHWNDArray): Integer; stdcall;
  function MagSetImageScalingCallback(hwnd: HWND;
    MagImageScalingCallback: TMagImageScalingCallback): BOOL; stdcall;
//  MagImageScalingCallback WINAPI MagGetImageScalingCallback(HWND hwnd );
  function MagSetColorEffect(hwnd: HWND; var Effect: TMagColorEffect): BOOL; stdcall;
  function MagGetColorEffect(hwnd: HWND; var Effect: TMagColorEffect): BOOL; stdcall;

implementation

const
  MagnificationDll = 'Magnification.dll';

  function MagInitialize; external MagnificationDll name 'MagInitialize';
  function MagUninitialize; external MagnificationDll name 'MagUninitialize';
  function MagSetWindowSource; external MagnificationDll name 'MagSetWindowSource';
  function MagGetWindowSource; external MagnificationDll name 'MagGetWindowSource';
  function MagSetWindowTransform; external MagnificationDll name 'MagSetWindowTransform';
  function MagGetWindowTransform; external MagnificationDll name 'MagGetWindowTransform';
  function MagSetWindowFilterList; external MagnificationDll name 'MagSetWindowFilterList';
  function MagGetWindowFilterList; external MagnificationDll name 'MagGetWindowFilterList';
  function MagSetImageScalingCallback; external MagnificationDll name 'MagSetImageScalingCallback';
  function MagSetColorEffect; external MagnificationDll name 'MagSetColorEffect';
  function MagGetColorEffect; external MagnificationDll name 'MagGetColorEffect';

end.

1 Ответ

3 голосов
/ 13 марта 2019

Нельзя использовать нестатический метод класса в качестве обратного вызова API. Вам нужно либо:

  • объявляет MagImageScalingCallback() со спецификаторами class и static:

    class function MagImageScalingCallback(hwnd: HWND; srcdata: Pointer;
      srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
      unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall; static;
    
  • делает MagImageScalingCallback() автономной не-членом функцию.

Если вы посмотрите на пример, на котором основан ваш код, он использует метод class static для обратного вызова WindowProc API.

В любом случае, обратный вызов не может иметь неявный параметр Self, поэтому, если вам нужен доступ к данным вашего класса внутри обратного вызова, вы можете передать указатель Self вашего класса в обратный вызов, используя HWND через Win32 API (Get|Set)WindowLong/Ptr(GWL_USERDATA) или (Get|Set)Prop() функции. Например:

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows,
  Classes,
  SysUtils,
  Magnification;

type
  THostWNDThread = class(TThread)
  private
    class function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
    class function MagImageScalingCallback(hwnd: HWND; srcdata: Pointer;
      srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
      unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall; static;
  protected
    procedure Execute; override;
  public
  end;

procedure THostWNDThread.Execute; 
var
  Msg: TMsg;
  WndClass: WNDCLASS;
  hWndMag: HWND;
begin
  with WndClass do 
  begin 
    Style := 0; 
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0; 
    cbWndExtra := 0; 
    hInstance := HInstance; 
    hIcon := 0; 
    hCursor := LoadCursor(0, IDC_ARROW); 
    hbrBackground := COLOR_WINDOW; 
    lpszMenuName := nil; 
    lpszClassName := 'THostWNDThread'; 
  end; 
  if not Windows.RegisterClass(FWndClass) then
    RaiseLastOSError;
  try
    hWndMag := CreateWindow(WndClass.lpszClassName, nil, DesiredStyles, DesiredXPos, DesiredYPos, DesiredWidth, DesiredHeight, 0, 0, HInstance, nil);   
    if hWndMag = 0 then
      RaiseLastOSError;
    try
      SetWindowLongPtr(hWndMag, GWL_USERDATA, LONG_PTR(Self));
      if not MagSetImageScalingCallback(hWndMag, MagImageScalingCallback) then
        raise Exception.Create('Cant set Scaling callback');
      while GetMessage(Msg, hWndMag, 0, 0) > 0 do
      begin
        TranslateMessage(msg);
        DispatchMessage(msg)
      end;
    finally
      DestroyWindow(hWndMag);
    end;
  finally
    Windows.UnregisterClass(WndClass.lpszClassName, HInstance);
  end;
end;

class function THostWNDThread.WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  // handle uMsg as needed...
  Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end; 

class function THostWNDThread.MagImageScalingCallback(hwnd: HWND; srcdata: Pointer;
  srcheader: MAGIMAGEHEADER; destdata: Pointer; destheader: MAGIMAGEHEADER;
  unclipped: TRect; clipped: TRect; dirty: HRGN): BOOL; stdcall;
var
  pThread: THostWNDThread;
begin
  pThread := THostWNDThread(GetWindowLongPtr(hwnd, GWL_USERDATA));
  // use pThread and parameters as needed ...
  Result := True;
end;

var
  Thread: THostWNDThread;
begin
  try
    Thread := THostWNDThread.Create(False);
    Thread.WaitFor;
    Thread.Free;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.
...