VCL消息分析（参考别人，自己再整理的）

program Project3;

uses
  Windows,
  Messages;

type
  TWndMethod = procedure(var Message: TMessage) of object;
{这句类型声明的意思是：TWndMethod 是一种过程类型，它指向一个接收 TMessage 类型参数的过程，
但它不是一般的静态过程，它是对象相关(object related)的。TWndMethod 在内存中存储为一个指向
过程的指针和一个对象的指针，所以占用8个字节。TWndMethod类型的变量必须使用已实例化的对象来赋值}
  TMyApplication = class(TObject)
  private
    FHandle: HWND;
    FWndClass: TWndClass;
    FObjectInstance: Pointer;
    FMsg: TMsg;
    procedure WndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy;override;
    function CreateHandle: Boolean;
    procedure Show;
    procedure Run;
  end;

type
  PMyObjectInstance = ^TMyObjectInstance;
  TMyObjectInstance = packed record
    CodeCall: Byte; //1个字节
    Offset: Integer; //4个字节
    Method: TWndMethod; //8个字节 两个指针，一个是Self指针，一个是函数指针
    CodeJmp: array[1..2] of Byte; //2个字节
    WndProcPtr: Pointer; //4个字节
  end;    //共计19个字节

{ Standard window procedure }
{因为对象方法是一个过程，而窗口回调函数是函数要有返回值，所以用它做个包装才可以}
{ In    ES:BX = Address of method pointer }
{ Out   DX:AX = Result }
function StdWndProc(Window: HWND; Message, WParam: Longint;
  LParam: Longint): Longint; stdcall; assembler;
asm
  XOR     EAX,EAX
  PUSH    EAX
  PUSH    LParam
  PUSH    WParam
  PUSH    Message
  MOV     EDX,ESP  //;将堆栈中构造的记录TMessage指针传递给EDX
  MOV     EAX,[ECX].Longint[4]  //;传递Self指针给EAX，类中的Self指针也就是指向VMT入口地址
  CALL    [ECX].Pointer  //;调用WndProc方法
  ADD     ESP,12
  POP     EAX
end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeObjectInstance(Method: TWndMethod): Pointer;
const
  BlockCode: array[1..2] of Byte = (
    $59,       { POP ECX }         //汇编指令 POP ECX
    $E9);      { JMP StdWndProc }  //汇编指令 JMP  长跳转指令
var
  PBlock: PMyObjectInstance;
begin
  PBlock := VirtualAlloc(nil, SizeOf(TMyObjectInstance), MEM_COMMIT,
                         PAGE_EXECUTE_READWRITE);
  Move(BlockCode, PBlock^.CodeJmp, SizeOf(BlockCode));
  PBlock^.WndProcPtr := Pointer(CalcJmpOffset(@PBlock^.CodeJmp[2], @StdWndProc));
  PBlock^.CodeCall := $E8;  //汇编指令 JMP  短跳转指令
  PBlock^.Offset := CalcJmpOffset(PBlock, @PBlock^.CodeJmp);
  PBlock^.Method := Method;
  Result := PBlock;
end;

procedure FreeObjectInstance(ObjectInstance: Pointer);
begin
  VirtualFree(ObjectInstance, 0, MEM_RELEASE);
end;
{ TMyApplication }

constructor TMyApplication.Create;
begin
//填充数据
  FWndClass.style:= CS_VREDRAW or CS_HREDRAW;
  FWndClass.lpfnWndProc:= @DefWindowProc;//@InitWndProc;  直接赋该函数地址是不行的，只能是DefWindowProc
  FWndClass.cbClsExtra:= 0;
  FWndClass.cbWndExtra:= 0;
  FWndClass.hInstance:= HInstance;
  FWndClass.hIcon:= LoadIcon(0, IDI_APPLICATION);
  FWndClass.hCursor:= LoadCursor(0, IDC_ARROW);
  FWndClass.hbrBackground:= GetStockObject(WHITE_BRUSH);
  FWndClass.lpszMenuName:= nil;
  FWndClass.lpszClassName:= 'TMyApplication';

  FObjectInstance:= MakeObjectInstance(WndProc);
end;

function TMyApplication.CreateHandle: Boolean;
begin
//注册
  if RegisterClass(FWndClass) = 0 then
  begin
    MessageBox(0, '这个错误是不应该出现的！', FWndClass.lpszClassName, MB_OK);
    Result:= false;
  end
  else
  begin
    //MyCreationControl:= Self;

    FHandle:= CreateWindow(FWndClass.lpszClassName, '我的第一个以面向对象方式撰写的SDK程序!',
      WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
      0, 0, HInstance, nil);

   //替换回调函数
    SetWindowLong(FHandle, GWL_WNDPROC,  LongInt(FObjectInstance));

    Result:= True;
  end;
end;

destructor TMyApplication.Destroy;
begin
 // ReleaseThunk(FObjectInstance);
  FreeObjectInstance(FObjectInstance);
  inherited;
end;

procedure TMyApplication.Run;
begin
  while GetMessage(FMsg, 0, 0, 0) do
  begin
    TranslateMessage(FMsg);
    DispatchMessage(FMsg);
  end;
end;

procedure TMyApplication.Show;
begin
  ShowWindow(FHandle, CmdShow);
  UpdateWindow(FHandle);
end;

procedure TMyApplication.WndProc(var Message: TMessage);
var
  ps: PAINTSTRUCT;
  dc: HDC;
begin
  Message.Result:= 0;
  case Message.Msg of
  WM_CREATE://不能响应这个消息了，不过在Delphi中TApplication好像也不用响应它
  begin
    MessageBox(0, '三四三', '三四三', MB_OK);   //此处不能被执行，因为该回调在窗口创建后才替换的。
  end;
  WM_DESTROY:
  begin
    PostQuitMessage(0);
  end;
  WM_PAINT:
  begin
    dc:= BeginPaint(FHandle, ps);
    TextOut(dc, 20, 20, 'zwz_good', 8);
    EndPaint(FHandle, ps);
  end
  else
    Message.Result:= DefWindowProc(FHandle, Message.Msg, Message.wParam, Message.lParam);
  end;

end;

var
  MyApplication: TMyApplication;
begin
  MyApplication:= TMyApplication.Create;
  if MyApplication.CreateHandle then
  begin
    MyApplication.Show;
    MyApplication.Run;
  end;
  MyApplication.Free;
end.
{
var
  MyCreationControl: TMyApplication;

function InitWndProc(HWindow: HWnd; Message: Word; WParam: Word;
  LParam: Longint): Longint; export;
begin
  MyCreationControl.FHandle := HWindow;
  //替换回调函数
  SetWindowLong(HWindow, GWL_WNDPROC,  LongInt(MyCreationControl.FObjectInstance));
asm  //为了可以响应WM_CREATE
  PUSH    LParam
  PUSH    WParam
  PUSH    Message
  PUSH    HWindow
  MOV     EAX,MyCreationControl
  MOV     MyCreationControl,0
  CALL    [EAX].TMyApplication.FObjectInstance
  MOV     Result,EAX
end;
end;
}