Problem mit eigener Klasse und Fensterprozedur

[SirThornberry]

du musst dir folgendes raus kopieren und am besten in eine eigene unit kopieren:

Delphi-Quellcode:

type
  TObjWndProc = function(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LResult of Object;
  TNonVCLMsgProcObj = class(TObject)
  private
    fAllocedMem: Pointer;
    fMethodRef: TObjWndProc;
    fSelfRef: TObject;
    procedure FSetMethodRef(ARef: TObjWndProc);
    procedure FSetSelfRef(ARef: TObject);
  public
    constructor Create(ASelfRef: TObject=nil; AMethod: TObjWndProc=nil);
    destructor Destroy; override;

    property SelfRef: TObject read fSelfRef write FSetSelfRef default nil;
    property WndProc: Pointer read fAllocedMem;
    property WndMethod: TObjWndProc read fMethodRef write FSetMethodRef default nil;
  end;
[...]
{==============================================================================}
{============================= TNonVCLObjMsgProc ==============================}
{==============================================================================}

constructor TNonVCLMsgProcObj.Create(ASelfRef: TObject; AMethod: TObjWndProc);
  procedure LWrite(AVal: Integer; var APtr: Pointer; ASize: Integer);
  begin
    move(AVal, APtr^, ASize);
    inc(Integer(APtr), ASize);
  end;
var LPtr: Pointer;
begin
  inherited Create;
  fMethodRef := AMethod;
  fSelfRef   := ASelfRef;
  //erstellt folgende Funktion im speicher
  {
  function LTmpProc(wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
  type
    TObjWndProc = function(Self: Pointer; wnd: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LResult;
  var LObjProc: TObjWndProc;
      LSelfRef: Pointer;
  begin
    LObjProc := [ASELF];
    LSelfRef := [AProc];
    result := LObjProc(LSelfRef, wnd, uMsg, wp, lp);
  end;
  }
  LPtr := VirtualAlloc(nil, 4096, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  fAllocedMem := LPtr;
  //Begin
  LWrite($55, LPtr, 1);
  LWrite($EC8B, LPtr, 2);
  LWrite($53, LPtr, 1);
  //LObjProc zuweisen
  LWrite($B8, LPtr, 1);
  LWrite(Integer(@fMethodRef), LPtr, 4);
  //LSelfProc zuwiesen
  LWrite($BA, LPtr, 1);
  LWrite(Integer(fSelfRef), LPtr, 4);
  //Aufruf
  LWrite($104D8B, LPtr, 3);
  LWrite($51, LPtr, 1);
  LWrite($144D8B, LPtr, 3);
  LWrite($51, LPtr, 1);
  LWrite($D88B, LPtr, 2);
  LWrite($0C4D8B, LPtr, 3);
  LWrite($C28B, LPtr, 2);
  LWrite($08558B, LPtr, 3);
  LWrite($D3FF, LPtr, 2);

  //end
  LWrite($5B, LPtr, 1);
  LWrite($5D, LPtr, 1);
  LWrite($0010C2, LPtr, 3);
  LWrite($90, LPtr, 1);
end;

{==============================================================================}

destructor TNonVCLMsgProcObj.Destroy;
begin
  VirtualFree(fAllocedMem, 0, MEM_RELEASE);
  inherited Destroy;
end;

{==============================================================================}

procedure TNonVCLMsgProcObj.FSetMethodRef(ARef: TObjWndProc);
var LAddr: Pointer;
begin
  if @fMethodRef <> @ARef then
  begin
    fMethodRef := ARef;
    LAddr := Pointer(Integer(fAllocedMem) + 5);
    move(Pointer(@@fMethodRef)^, LAddr^, 4);
  end;
end;

{==============================================================================}

procedure TNonVCLMsgProcObj.FSetSelfRef(ARef: TObject);
var LAddr: Pointer;
begin
  if @fSelfRef <> @ARef then
  begin
    fSelfRef := ARef;
    LAddr := Pointer(Integer(fAllocedMem) + 10);
    move(Pointer(@fSelfRef)^, LAddr^, 4);
  end;
end;

Dieses Object dient dazu die MsgProc auf eine MsgMethode umzuleiten.

Du musst dann also noch ins Create von deiner Eigenen WindowKlasse folgendes schreiben:

Delphi-Quellcode:

fMsgProcObj           := TNonVCLMsgProcObj.Create;
fMsgProcObj.SelfRef   := Self;
fMsgProcObj.WndMethod := WndProc;

und ins Destroy
fMsgProcObj.Free; und Anstelle von
WndClass.lpfnWndProc := @TWindow.WndProc; schreibst du einfach
WndClass.lpfnWndProc := fMsgProcObj.WndProc;