Question

我想传递给GLUT函数（glutKeyboardFunc）指向成员函数（TDisplayer.GlKeyboard）的指针。 GLUT回调只接受函数指针。有没有办法将自我指针“打包”到函数中？

unit UDisplayer;

{$mode objfpc}

interface

type
   TDisplayer = class(TObject)

public
   constructor Create(x, y : Integer; caption : AnsiString);
   destructor Destroy; override;

   procedure GlKeyboard(key : Byte; x, y : Longint); cdecl; 

private
   winX : Integer;
   winY : Integer;
end;

implementation

uses gl, glut, glext, UTools;

constructor TDisplayer.Create(x, y : Integer; caption : AnsiString);
var
   cmd          : array of PChar;
   cmdCount     : Integer;
   keyboardCallback : pointer;
begin
   winX := x;
   winY := y;
   cmdCount := 1;
   SetLength(cmd, cmdCount);
   cmd[0] := PChar(ParamStr(0));
   glutInit(@cmdCount, @cmd);
   glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH);
   glutInitWindowSize(x, y);
   glutCreateWindow(PChar(caption));

   glClearColor(0.0, 0.0, 0.0, 0);

   //glutKeyBoardFunc(@self.glKeyBoard); <--- HERE

   glutMainLoop;
end;

destructor TDisplayer.Destroy;
begin
   inherited;
end;

procedure TDisplayer.GlKeyboard(key : Byte; x, y : Longint); cdecl;
begin
end;

end.

Answer 1

没有。方法指针是两个指针大，一个简单的函数指针只有一个，所以它根本不适合。

如果回调系统提供了一些＆＃34; context＆＃34;你有时可以将实例传递给上下文，然后像

那样做一些更普遍的thunk

function callme(context:pointer;x,y:integer);integer; cdecl;
begin
  TTheClass(context).callme(x,y);
end;

然后通过＆＃34; Self＆＃34;作为注册回调时的上下文。但看起来这个回调设置器的上下文在被调用时会被传递回回调。

Answer 2

第一次将回调声明为全局过程。它将是一种与上下文无关的方法，而不是依赖于自我

 type TDisplayer = class(TObject)
 public
   constructor Create(x, y : Integer; caption : AnsiString);
   destructor Destroy; override;
 private
   winX : Integer;
   winY : Integer;
 end;  

 procedure GlKeyboard(key : Byte; x, y : Longint); cdecl;

然后，由于 glutCreateWindow（）会返回唯一的上下文，您可以使用它将它与您的类实例相关联。因此，您可以定义一个关联数组，它允许使用GLUT窗口作为键检索 TDisplayer 实例：

type TCtxtArr = specialize TFPGMap<Integer,TForm>;

您添加一个作为全局变量，将在初始化和最终化部分中创建和释放：

var
  ctxtarray: TCtxtArr; 
initialization
  ctxtarray:= TCtxtArr.create;
finalization
  ctxtarray.free;
end.

然后在 TDisplayer.Create（）中添加条目到AA：

// id is a local integer.
id = glutCreateWindow(PChar(caption));
ctxtarray.Add(id, Self);
// assign the callback here or elsewhere
glutKeyBoardFunc(@glKeyBoard);

调用回调后，您可以检索 TDisplayer 实例，以便您可以访问其变量和方法：

procedure GlKeyboard(key : Byte; x, y : Longint); cdecl;
var
  disp: TDisplayer;
  id: integer;
begin
  glutGetWindow(id);
  disp := ctxtarray[id];
end;

不幸的是，我无法测试答案，因为它似乎是一个更大的计划的一部分。但是，此示例以模拟方式工作：

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, dialogs, fgl;

type
  TForm1 = class;
  TProc = procedure(x,y: integer);
  TCtxtArr = specialize TFPGMap<Integer,TForm1>;

  TForm1 = class(TForm)
    constructor Create(TheOwner: TComponent); override;
    procedure hello;
  end;

  procedure callback(x,y: integer);

var
  Form1: TForm1; Proc: TProc;
  ctxtarray: TCtxtArr;

implementation
{$R *.lfm}

constructor TForm1.Create(TheOwner: TComponent);
begin
  inherited;
  proc := @callback;
  ctxtarray.Add(0,Self);
  proc(0,0);
end;

procedure TForm1.hello;
begin
  showmessage('hello');
end;

procedure callback(x, y: integer);
var
  frm: TForm1;
begin
  frm := ctxtarray.Data[0];
  frm.hello;
end;

initialization
  ctxtarray:= TCtxtArr.create;
finalization
  ctxtarray.free;
end.

作为脚注：理论上FPC允许定义静态类方法（类似于全局过程），但由于某种原因，它们似乎无法分配给全局过程指针，至少它失败了FPC 2.6.4

Answer 3

你必须组装一些字节码，然后用'硬编码'来保存包装。自指针，它管理调用堆栈：

procOfObj = packed record
    method : pointer;
    this   : pointer; 
    end;

obj = packed object
    procedure ASIOBufferSwitch(
      ip: pointer; {the added IP artifact }
      doubleBufferIndex: longint; directProcess: longbool); cdecl;
    end;

cdeclProxy = packed object
    procedure  build( const src: procOfObj );    
    private
    push         : byte; push_arg: pointer;
    call         : byte; call_arg: pointer;
    add_ret      : longint;
    end;

procedure cdeclProxy.build( const src: procOfObj );
begin
    push := $68; push_arg := src.this;
    call := $e8; call_arg := pointer( src.method - @call - 5 );
    add_ret := $c304c483;
    result := @push;
end;

var cdp : cdeclProxy;
    o   : obj;
begin
    cdp.build( procOfObj( @o.ASIOBufferSwitch ))
    pointer(... procedure var ...) := @cdp;
end.

请注意，提供的示例在方法签名中需要额外的arg，但它允许在不知道arg计数的情况下构建包装器。如果你不想要ip arg，你必须在调用实际方法之前再次重新推送所有args，然后清理包装内的堆栈。

将成员函数指针转换为FreePascal中的函数指针

3 个答案: