fmmain.pas

这是不可多得的源代码

unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    StringGrid1: TStringGrid;
    Edit2: TEdit;
    Edit3: TEdit;
    RadioButton1: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  public
    { Public declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const iOffset = 2;

procedure TForm1.Button1Click(Sender: TObject);
var
  ap : Pointer;
  gp : Pointer;
  aObj : TObject;
  iCount : Integer;
  iValue : Integer;
begin
  ap := Self;
  ap := Pointer(ap^);
  Self.Edit1.Text :=
    IntToStr(ShortInt(Pointer(Pointer(Integer(ap) + vmtMethodTable)^)^));

  ap := Button1;
  ap := Pointer(ap^);
  Self.Edit2.Text :=
    IntToStr(ShortInt(Pointer(Pointer(Integer(ap) + vmtDynamicTable)^)^));

  gp := Pointer(Integer(Pointer(Integer(ap) + vmtDynamicTable)^) + 2);
  for iCount := 0 to StrToInt(Self.Edit2.Text) - 1 do
  begin
    iValue := Integer(Pointer(gp)^) and $0000FFFF;
    ListBox1.items.Add(IntToStr(iValue));
    gp := Pointer(Integer(gp) + iOffset);
  end;

  ap := RadioButton1;
  ap := Pointer(ap^);
  Self.Edit3.Text :=
    IntToStr(ShortInt(Pointer(Pointer(Integer(ap) + vmtDynamicTable)^)^));

  ap := ListBox1;
  ap := Pointer(ap^);
  Self.Edit3.Text :=
    IntToStr(ShortInt(Pointer(Pointer(Integer(ap) + vmtDynamicTable)^)^));


{
  ap := @TForm1.FormShow;
  Self.Edit2.Text := Self.MethodName(ap);
}
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  
  with Params do
  begin
    Style := Style and (not WS_SYSMENU);
    Style := Style and (not WS_MINIMIZEBOX);
    Style := Style and (not WS_MAXIMIZEBOX);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Self.Caption := 'OnShow';
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Self.Caption := 'ListBox';
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Self.ListBox1.Items.Add('X 轴 : ' + IntToStr(X) + 'Y 轴 : ' + IntToStr(Y));
end;

function KeysToShiftState(Keys: Word): TShiftState;
begin
  Result := [];
  if Keys and MK_SHIFT <> 0 then Include(Result, ssShift);
  if Keys and MK_CONTROL <> 0 then Include(Result, ssCtrl);
  if Keys and MK_LBUTTON <> 0 then Include(Result, ssLeft);
  if Keys and MK_RBUTTON <> 0 then Include(Result, ssRight);
  if Keys and MK_MBUTTON <> 0 then Include(Result, ssMiddle);
  if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
end;


procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;

  with Message do
    case Msg of
      WM_MOUSEMOVE:
        FormMouseMove(Self, KeysToShiftState(TWMMouseMove(Message).Keys), TWMMouseMove(Message).XPos, TWMMouseMove(Message).YPos);
    end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  Self.Caption := 'OnClick';
end;

procedure TForm1.WMCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then
    Button1.Click
  else
    inherited;
end;

end.