4

TMainWindowネイティブのWindowsAPIに関する知識を向上させるために、クラスを含む単純なユニットを作成しようとしています。

このクラスを次のように使用したいと思います。

var
  MainWindow: TMainWindow;
begin
  MainWindow := TMainWindow.Create;
  try
    MainWindow.ShowModal;
  finally
    MainWindow.Free;
  end;
end.

ほぼ動作するプロトタイプを入手しましたが、問題を見つけることができません。これまでに作成したコードは次のとおりです。

unit NT.Window;

interface

uses
  Windows, Messages, Classes, SysUtils;

type
  PObject = ^TObject;

  TMainWindow = class(TObject)
  private
    FChild  : HWND;                          { Optional child window }
    FHandle : HWND;
    procedure WMCreate      (var Msg: TWMCreate);      message WM_CREATE;
    procedure WMDestroy     (var Msg: TWMDestroy);     message WM_DESTROY;
    procedure WMNcCreate    (var Msg: TWMNCCreate);    message WM_NCCREATE;
    procedure WMPaint       (var Msg: TWMPaint);       message WM_PAINT;
    procedure WMPrintClient (var Msg: TWMPrintClient); message WM_PRINTCLIENT;
    procedure WMSize        (var Msg: TWMSize);        message WM_SIZE;
    procedure PaintContent(const APaintStruct: TPaintStruct);
    function HandleMessage(var Msg: TMessage): Integer;
  public
    constructor Create;
    procedure DefaultHandler(var Message); override;
    function ShowModal: Boolean;
  end;

implementation

var
  WindowByHwnd: TStringList;

function PointerToStr(APointer: Pointer): string;
begin
  Result := IntToStr(NativeInt(APointer));
end;

function StrToPointerDef(AString: string; ADefault: Pointer): Pointer;
begin
  Result := Pointer(StrToIntDef(AString, Integer(ADefault)));
end;

function GetWindowByHwnd(hwnd: HWND): TMainWindow;
begin
  Result := TMainWindow(StrToPointerDef(WindowByHwnd.Values[IntToStr(hwnd)], nil));
end;

procedure StoreWindowByHwnd(hwnd: HWND; AWindow: TMainWindow);
begin
  AWindow.FHandle := hwnd;
  WindowByHwnd.Add(IntToStr(hwnd) + '=' + PointerToStr(Pointer(AWindow)));
end;

function WndProc(hwnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  Msg    : TMessage;
  Window : TMainWindow;
begin
  Msg.Msg    := uiMsg;
  Msg.WParam := wParam;
  Msg.LParam := lParam;
  Msg.Result := 0;
  if uiMsg = WM_NCCREATE then begin
    StoreWindowByHwnd(hwnd, TMainWindow(TWMNCCreate(Msg).CreateStruct.lpCreateParams))
  end;
  Window := GetWindowByHwnd(hwnd);
  if Window = nil then begin
    Result := DefWindowProc(hwnd, Msg.Msg, Msg.WParam, Msg.LParam);
  end else begin
    Result := Window.HandleMessage(Msg);
  end;
end;

{ TMainWindow }

constructor TMainWindow.Create;
var
  wc: WNDCLASS;
begin
  inherited Create;
  wc.style         := 0;
  wc.lpfnWndProc   := @WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := HInstance;
  wc.hIcon         := 0;
  wc.hCursor       := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := HBRUSH(COLOR_WINDOW + 1);
  wc.lpszMenuName  := nil;
  wc.lpszClassName := 'Scratch';
  if Windows.RegisterClass(wc) = 0 then begin
    raise Exception.Create('RegisterClass failed: ' + SysErrorMessage(GetLastError));
  end;
  if CreateWindow(
    'Scratch',                   { Class Name }
    'Scratch',                   { Title }
    WS_OVERLAPPEDWINDOW,         { Style }
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),      { Position }
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),      { Size }
    0,                           { Parent }
    0,                           { No menu }
    HInstance,                   { Instance }
    @Self                        { No special parameters }
  ) = 0 then begin
    raise Exception.Create('CreateWindow failed: ' + SysErrorMessage(GetLastError));
  end;
end;

procedure TMainWindow.DefaultHandler(var Message);
var
  Msg: TMessage;
begin
  Msg := TMessage(Message);
  Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

function TMainWindow.HandleMessage(var Msg: TMessage): Integer;
begin
  // Dispatch(Msg);
  case Msg.Msg of
    WM_CREATE      : WMCreate(     TWMCreate(Msg));
    WM_DESTROY     : WMDestroy(    TWMDestroy(Msg));
    WM_NCCREATE    : WMNcCreate(   TWMNCCreate(Msg));
    WM_PAINT       : WMPaint(      TWMPaint(Msg));
    WM_PRINTCLIENT : WMPrintClient(TWMPrintClient(Msg));
    WM_SIZE        : WMSize(       TWMSize(Msg));
  else
    // DefaultHandler(Msg);
    Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
  end;

  Result := Msg.Result;
end;

procedure TMainWindow.PaintContent(const APaintStruct: TPaintStruct);
begin

end;

function TMainWindow.ShowModal: Boolean;
var
  msg_  : MSG;
begin
  ShowWindow(FHandle, CmdShow);
  while GetMessage(msg_, 0, 0, 0) do begin
    TranslateMessage(msg_);
    DispatchMessage(msg_);
  end;
  Result := True;
end;

procedure TMainWindow.WMCreate(var Msg: TWMCreate);
begin
  Msg.Result := 0;
end;

procedure TMainWindow.WMDestroy(var Msg: TWMDestroy);
begin
  PostQuitMessage(0);
end;

procedure TMainWindow.WMNcCreate(var Msg: TWMNCCreate);
begin
  Msg.Result := Ord(True);
end;

procedure TMainWindow.WMPaint(var Msg: TWMPaint);
var
  ps: PAINTSTRUCT;
begin
  BeginPaint(FHandle, ps);
  PaintContent(ps);
  EndPaint(FHandle, ps);
end;

procedure TMainWindow.WMPrintClient(var Msg: TWMPrintClient);
var
  ps: PAINTSTRUCT;
begin
  ps.hdc := Msg.DC;
  GetClientRect(FHandle, ps.rcPaint);
  PaintContent(ps);
end;

procedure TMainWindow.WMSize(var Msg: TWMSize);
begin
  if FChild <> 0 then begin
    MoveWindow(FChild, 0, 0, Msg.Width, Msg.Height, True);
  end;
end;

initialization
  WindowByHwnd := TStringList.Create;

finalization
  WindowByHwnd.Free;

end.

コードの一部は、Raymond Chenによるスクラッチプログラムに基づいています:http: //blogs.msdn.com/b/oldnewthing/archive/2003/07/23/54576.aspx

TStringListWndProc関数でTMainWindowのインスタンスを検索するためにを使用していますが、これはかなり非効率的ですが、機能するはずです。

プログラムはそのままクラッシュDispatchし、HandleMessage関数で使用するとクラッシュします。

コンストラクターを終了した直後、またはDispatch呼び出しの変更バージョンでクラッシュするのはなぜですか?

4

1 に答える 1

6

あなたはこのように呼びますCreateWindow

CreateWindow(
  'Scratch',                   { Class Name }
  'Scratch',                   { Title }
  WS_OVERLAPPEDWINDOW,         { Style }
  Integer(CW_USEDEFAULT),
  Integer(CW_USEDEFAULT),      { Position }
  Integer(CW_USEDEFAULT),
  Integer(CW_USEDEFAULT),      { Size }
  0,                           { Parent }
  0,                           { No menu }
  HInstance,                   { Instance }
  @Self                        { No special parameters }
)

最後のパラメータが間違っているというコメントに加えて、が間違っています。式@SelfはローカルSelf変数へのポインタです。ローカル変数へのポインタ。それはひどい結果になるに違いない。作成中のオブジェクトへのポインタを渡していると思っていましたが、それはの値によってSelf直接与えられます。を削除し@ます。


ハンドルと参照の両方を文字列に変換してname=valueルックアップを実行する代わりに、オブジェクト参照をウィンドウハンドルに関連付けるより直接的な方法がいくつかあります。

  • 手始めに、のような、よりタイプセーフな連想コンテナを使用できますTDictionary<HWnd, TMainWindow>。これにより、少なくともすべての文字列変換から離れることができます。

  • SetWindowLongPtrおよびを使用して、オブジェクト参照をウィンドウハンドルに直接関連付けることができますGetWindowLongPtr。次のようにコードを変更できます。

    constructor TMainWindow.Create;
      // ...
      wc.cbWndExtra := SizeOf(Self);
    
    function GetWindowByHwnd(hwnd: HWnd): TMainWindow;
    begin
      Result := TMainWindow(GetWindowLongPtr(hwnd, 0));
    end;
    
    procedure StoreWindowByHwnd(hwnd: HWND; AWindow: TMainWindow);
    begin
      AWindow.FHandle := hwnd;
      SetWindowLongPtr(hwnd, 0, IntPtr(AWindow));
    end;
    

    「余分なウィンドウバイト」を使用しているため、ウィンドウクラスの子孫が他の目的で同じスペースを使用しようとしないようにする必要があります。cbWndExtra子孫がスペースを必要としていることを「登録」し、すべての子孫の要求を合計して、合計をフィールドに入力するための何らかのメカニズムを提供する必要があります。次に、子孫が予約したスロットにデータをロードして保存する方法があります。

  • ウィンドウのプロパティを使用できます。オブジェクト参照をメッセージ内のプロパティ値に格納しSetPropwm_NCCreateメッセージ内で削除しRemovePropますwm_NCDestroy

    子孫クラスで使用される可能性が低いプロパティ名を選択します。

  • 最後に、VCLが行うこと、つまりすべてのオブジェクトに新しい「スタブ」ウィンドウプロシージャを割り当てることができます。テンプレートプロシージャが通常のウィンドウプロシージャのアドレスにジャンプします。新しいスタブにメモリを割り当て、テンプレートに現在のオブジェクト参照を入力し、を呼び出すときにそのスタブポインタを使用しますRegisterClassEx

于 2012-06-19T16:33:07.917 に答える