Problem mit eigener Klasse und Fensterprozedur

[SirThornberry]

aus langer weile habe ich mal von deinem ersten Post den Source genommen und das von mir beschriebene eingearbeitet:

Delphi-Quellcode:

unit NonVCLForms;

interface 

uses 
  Windows, Messages; 

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;


  TPosition = (poNone, poCenter);

  TWndStyle = packed record
    Left, Top, Width, Height: Integer;
    Caption: PChar;
    Color: Cardinal;
    Position: TPosition;
  end;

  TWindow = class
  private 
    { Private-Deklarationen } 
    type 
      TNotifyEvent = procedure of object; 
    var 
      FHandle: HWND;
      FMsgProcObj: TNonVCLMsgProcObj;
      FOnCreate: TNotifyEvent; 
      WndClass: TWndClassEx; 
    procedure CenterWindow(wndParent, wndChild: HWND); 
  public 
    { Public-Deklarationen }
    constructor Create(WndStyle: TWndStyle);
    destructor Destroy; override;
    function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
      lParam: LPARAM): LRESULT;
  published 
    property Handle: HWND read FHandle; 
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; 
  end; 

implementation

{==============================================================================}
{============================= 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;

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

(* Private *) 

(* Zentriert ein Fenster anhand seines Parents *) 
procedure TWindow.CenterWindow(wndParent, wndChild: HWND); 
var 
  PRec, 
  CRec: TRect; 
begin 
  // Fensterkoordinaten ins TRect laden 
  GetClientRect(WndParent, PRec); 
  GetClientRect(WndChild, CRec); 
  // Parent muss größer sein als Child 
  if ((PRec.Right - PRec.Left) < (CRec.Right - CRec.Left)) or 
     ((PRec.Bottom - PRec.Top) < (CRec.Bottom - CRec.Top)) then 
  begin 
    Exit; 
  end; 
  // Position setzen 
  SetWindowPos(WndChild, HWND_TOP, (PRec.Right - CRec.Right) div 2, 
    (PRec.Bottom - CRec.Bottom) div 2, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE); 
end; 

(* Public *) 

constructor TWindow.Create(WndStyle: TWndStyle); 
var 
  lgBr: TLogBrush; 
  hBr: HBRUSH; 
begin
  FMsgProcObj := TNonVCLMsgProcObj.Create(Self, WndProc);

  case WndStyle.Color of 
    COLOR_WINDOW, 
    COLOR_APPWORKSPACE: 
      begin 
        lgBr.lbColor := GetSysColor(WndStyle.Color); 
      end; 
  else 
    lgBr.lbColor := WndStyle.Color; 
  end; 
  lgBr.lbStyle := BS_SOLID; 
  hBr := CreateBrushIndirect(lgBr); 

  WndClass.cbSize := SizeOf(WndClass); 
  WndClass.style := CS_OWNDC;

  WndClass.lpfnWndProc := FMsgProcObj.WndProc;
  WndClass.hInstance := hInstance; 
  WndClass.hCursor := LoadCursor(0, IDC_ARROW); 
  WndClass.hbrBackground := hBr; 
  WndClass.lpszClassName := 'TWindow'; 
  RegisterClassEx(WndClass); 

  With WndStyle do 
  begin 
    FHandle := CreateWindow('TWindow', Caption, WS_VISIBLE or WS_SYSMENU, 
                 Left, Top, Width, Height, 0, 0, hInstance, nil); 

    if Position = poCenter then 
      CenterWindow(FindWindow('ProgMan', nil), Handle); 
  end; 

end;

destructor TWindow.Destroy;
begin
  if (FHandle <> 0) then
    DestroyWindow(FHandle);
  FMsgProcObj.Free; 
  inherited Destroy; 
end;


function TWindow.WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT;
begin 
  case uMsg of 
    WM_CREATE: 
      begin 
        if Assigned(OnCreate) then 
          OnCreate; 
        Result := 0; 
      end; 
  else 
    Result := DefWindowProc(hwnd, uMsg, wParam, lParam); 
  end; 
end; 

end.

In diesem Schritt hab ich das Destroy mit überschrieben in dem das erzeugte Fenster auch wieder frei gegeben wird!