delphi - SetWindowSubclass 将 ANSI 窗口更改为 UNICODE

Question

SetWindowSubClass() 是否应该将 ANSI 窗口更改为 UNICODE 窗口？我在文档或网络上没有找到任何有关此行为的信息。

我创建了一个测试应用程序 ( full source ) 只是为了说明如何 SetWindowSubclass (我相信)将受影响的窗口类型从 ANSI 更改为 UNICODE，因为不应该! IsWindowUnicode()确认更改。

 program TwoWaySubclassing;

 {$apptype gui}
 {$R Generic.res}                          

 {
 { I created this test application just to illustrate how SetWindowSubclass()
 { changes -- I believe -- the type of the affected window from ANSI to UNICODE,
 { as it shouldn't! IsWindowUnicode() confirms that.
 {
 { The Delphi 7 (all ANSI) application has 2 edit controls:
 {   1. The smaller, which is subclassed in 2 switchable ways (called Modes).
 {   2. The bigger, like a memo, not subclassed. Just for dumping info.
 {   3. A button for switching between modes, on-the-fly.
 {
 { The default subclassing Mode uses SetWindowLong (the classic way).
 { When pressing the button, the edit control is subclassed via SetWindowSubclass.
 { Pressing it again brings the edit control back to the default SetWindowLong mode.
 {
 { The main window (and all child controls) are created using the ANSI version
 { of the API procedure, so the message handler should receive, in "lParam",
 { a pointer to an ANSI text (along with the wm_SetText message), always!
 {
 { The problem is that's not happening when the edit control is subclassed using
 { the SetWindowSubclass mode! SetWindowSubclass() simply changes the window
 { from ANSI to UNICODE and starts sending a PWideChar(lParam) rather than the
 { expected PAnsiChar(lParam).
 {
 { Once back to the default SetWindowLong mode, the window becomes ANSI again!
 { Just run the application and try switching between modes. Look carefully at the
 { detailed info shown in the bigger edit control.
 {
 { Screenshots:
 {   1. http://imgh.us/mode1.png
 {   2. http://imgh.us/mode2.png
 {
 { Environment:
 {   Windows 7 32-bit
 {   Delphi 7 (all-ANSI)
 {
 { Regards,
 {   Paulo França Lacerda
 }

 uses
   Windows,
   Messages,
   SysUtils;

 type
   UINT_PTR  = Cardinal;
   DWORD_PTR = Cardinal;

   TSubClassProc = function (hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM; uIdSubclass:UINT_PTR; dwRefData:DWORD_PTR) :LRESULT; stdcall;

   TSubMode = (
     subSetWindowLong,
     subSetWindowSubclass);

 const
   LtBool    :Array[Boolean]  of String = ('False', 'True');
   LtSubMode :Array[TSubMode] of String = ('SetWindowLong', 'SetWindowSubclass');

   strTextUsingPAnsiChar = 'ANSI Text in PAnsiChar(lParam)';
   strTextUsingPWideChar = 'UNICODE Text in PWideChar(lParam)';

 const
   cctrl = Windows.comctl32;

 function SetWindowSubclass    (hWnd:Windows.HWND; pfnSubclass:TSubClassProc; uIdSubclass:UINT_PTR; dwRefData:DWORD_PTR) :BOOL; stdcall; external cctrl name 'SetWindowSubclass';
 function RemoveWindowSubclass (hWnd:Windows.HWND; pfnSubclass:TSubClassProc; uIdSubclass:UINT_PTR) :BOOL;                      stdcall; external cctrl name 'RemoveWindowSubclass';
 function DefSubclassProc      (hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM) :LRESULT;                                   stdcall; external cctrl name 'DefSubclassProc';

 var
   wc  :TWndClass;
   Msg :TMsg;

   hButton :HWnd;
   hEdit   :HWnd;
   hEdit2  :HWnd;
   hFont   :HWnd;
   hFont2  :HWnd;

   hMainHandle :HWnd;
   swl_OldProc :Pointer;  // Default Procedure for Subclassing #1 (via SetWindowLong)
   SubMode   :TSubMode;


 procedure Release_Resources;
 begin
   DestroyWindow (hButton);  hButton := 0;
   DestroyWindow (hEdit);    hEdit   := 0;
   DestroyWindow (hEdit2);   hEdit2  := 0;
   DeleteObject  (hFont);    hFont   := 0;
   DeleteObject  (hFont2);   hFont2  := 0;
 end;

 procedure MsgBox (S:String);
 begin
   MessageBox (hMainHandle, PChar(S), 'Information', mb_Ok or mb_IconInformation);
 end;

 procedure Reveal_Text (lParam:LPARAM);
 const
   lf  = #13#10;
   lf2 = lf+lf;
 var
   S :String;
   AnsiTxt :String;
   UnicTxt :String;
   Remarks :Array[1..3] of String;
 begin
   if   IsWindowUnicode(hEdit)
   then Remarks[1] := '    (Man! SetWindowSubclass changed it to Unicode!!)'
   else Remarks[1] := '    (great! as designed)';

   AnsiTxt := PAnsiChar(lParam);

   if  (Length(AnsiTxt) = 1)
   then Remarks[2] := '    (text is obviously truncated)'
   else Remarks[2] := '    (text is healthy and is ANSI, as it should)';

   UnicTxt := PWideChar(lParam);

   if  (Pos('?',UnicTxt) > 0)
   then Remarks[3] := '    (text is obviously garbaged)'
   else Remarks[3] := '    (text is healthy, but I want it to be ANSI)';

   S :=
          'Subclassed using: '
     +lf +'    '+LtSubMode[SubMode]+'()'
     +lf2+ 'IsUnicodeWindow(hEdit)? '
     +lf +'    '+LtBool[IsWindowUnicode(hEdit)]
     +lf +       Remarks[1]
     +lf2+'PAnsiChar(lParam):'
     +lf +'    "'+PAnsiChar(lParam)+'"'
     +lf +       Remarks[2]
     +lf2+ 'PWideChar(lParam):'
     +lf +'    "'+PWideChar(lParam)+'"'
     +lf +       Remarks[3];

   SetWindowText (hEdit2, PChar(S));
 end;

 function swl_EditWndProc (hWnd:HWnd; uMsg:UInt; wParam:WParam; lParam:LParam) :LResult; stdcall;
 begin
   Result := CallWindowProc (swl_OldProc, hWnd, uMsg, wParam, lParam);
   if (uMsg = wm_SetText) then Reveal_Text(lParam);
 end;

 function sws_EditWndProc (hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM; uIdSubclass:UINT_PTR; dwRefData:DWORD_PTR) :LRESULT; stdcall;
 begin
   Result := DefSubclassProc (hWnd, uMsg, wParam, lParam);
   if (uMsg = wm_SetText) then Reveal_Text(lParam);
 end;

 procedure do_SetWindowSubclass;
 begin
   if   not SetWindowSubclass (hEdit, @sws_EditWndProc, 1, dword_ptr($1234{whatever}))
   then RaiseLastOSError;

   SubMode := subSetWindowSubclass;
 end;

 procedure undo_SetWindowSubclass;
 begin
   if   not RemoveWindowSubclass (hEdit, @sws_EditWndProc, 1)
   then RaiseLastOSError;

   SubMode := subSetWindowLong;  // restored
 end;

 function AppWindowProc (hWnd:HWnd; uMsg:UInt; wParam:WParam; lParam:LParam) :LResult; stdcall;
 begin
   case uMsg of
     wm_Command:
     begin
       if (lParam = hButton) then
       case SubMode of
         subSetWindowLong:
         begin
           do_SetWindowSubclass;  // now using SetWindowSubclass()
           SetWindowText (hEdit,   PChar(strTextUsingPWideChar));
           SetWindowText (hButton, PChar('Switch back to SetWindowLong mode'));
         end;

         subSetWindowSubclass:
         begin
           undo_SetWindowSubclass;  // back to SetWindowLong()
           SetWindowText (hEdit,   PChar(strTextUsingPAnsiChar));
           SetWindowText (hButton, PChar('Switch to SetWindowSubclass mode'));
         end;
       end;
     end;

     wm_Destroy:
     begin
       Release_Resources;
       PostQuitMessage (0);
       Exit;
     end;
   end;

   Result := DefWindowProc (hWnd, uMsg, wParam, lParam);
 end;

 var
   W,H :Integer;

 begin
   wc.hInstance     := hInstance;
   wc.lpszClassName := 'ANSI_Wnd';
   wc.Style         := cs_ParentDC;
   wc.hIcon         := LoadIcon(hInstance,'MAINICON');
   wc.lpfnWndProc   := @AppWindowProc;
   wc.hbrBackground := GetStockObject(white_brush);
   wc.hCursor       := LoadCursor(0,IDC_ARROW);

   RegisterClass(wc);  // ANSI (using Delphi 7, so all Windows API is mapped to ANSI).

   W := 500;
   H := 480;

   hMainHandle := CreateWindow (  // ANSI (using Delphi 7, so all Windows API is mapped to ANSI).
     wc.lpszClassName,'2-Way Subclassing App',
     ws_OverlappedWindow or ws_Caption or ws_MinimizeBox or ws_SysMenu or ws_Visible,
     ((GetSystemMetrics(SM_CXSCREEN)-W) div 2),  //   vertically centered in screen
     ((GetSystemMetrics(SM_CYSCREEN)-H) div 2),  // horizontally centered in screen
     W,H,0,0,hInstance,nil);

   // create the fonts
   hFont := CreateFont (-14,0,0,0,0,0,0,0, default_charset, out_default_precis, clip_default_precis, default_quality, variable_pitch or ff_swiss, 'Tahoma');
   hFont2:= CreateFont (-14,0,0,0,0,0,0,0, default_charset, out_default_precis, clip_default_precis, default_quality, variable_pitch or ff_swiss, 'Courier New');

   // create the edits
   hEdit :=CreateWindowEx (WS_EX_CLIENTEDGE,'EDIT','some text', WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL,                10,35,W-40, 23,hMainHandle,0,hInstance,nil);
   hEdit2:=CreateWindowEx (WS_EX_CLIENTEDGE,'EDIT','details',   WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL or ES_MULTILINE,10,72,W-40,300,hMainHandle,0,hInstance,nil);
   SendMessage(hEdit, WM_SETFONT,hFont, 0);
   SendMessage(hEdit2,WM_SETFONT,hFont2,0);

   // create the button
   hButton:=CreateWindow ('Button','Switch to SetWindowSubclass mode', WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT, 90,H-95,290,32,hMainHandle,0,hInstance,nil);
   SendMessage(hButton,WM_SETFONT,hFont,0);

   // subclass the Edit using the default method.
   swl_OldProc := Pointer(GetWindowLong(hEdit,GWL_WNDPROC));
   SetWindowLong (hEdit,GWL_WNDPROC,Longint(@swl_EditWndProc));

   SubMode := subSetWindowLong;
   SetWindowText (hEdit, PChar(strTextUsingPAnsiChar));

   // message loop
   while GetMessage(Msg,0,0,0) do
   begin
     TranslateMessage(Msg);
     DispatchMessage(Msg);
   end;
 end.

该应用程序有 2 个编辑控件:

1. 较小的一个，它以 2 种可切换方式(此处称为模式)进行子类化。
2. 较大的一个，例如备忘录，没有子类。只是为了转储信息。

还有一个用于在模式之间切换的按钮。

默认子类化模式使用 SetWindowLong() (经典方式):

在 Delphi 2007 及更早版本中，主窗口(以及所有子控件)是使用 ANSI 版本的 Win32 API 过程创建的，因此(子类控件的)消息处理程序应该接收 ANSI 文本(以及 WM_SETTEXT 消息)，始终如此!

问题是当使用SetWindowSubclass()对编辑控件进行子类化时，不会发生这种情况! SetWindowSubClass() 将窗口从 ANSI 更改为 UNICODE，并且它开始接收 Unicode 文本而不是预期的 ANSI 文本。

按下按钮通过 SetWindowSubclass() 来子类化编辑控件:

再次按下按钮可通过 SetWindowLong() 对编辑控件进行子类化。

一旦回到SetWindowLong()模式，编辑控件会再次自动接收ANSI文本:

只需运行应用程序并尝试在模式之间切换。仔细查看更大的编辑控件中显示的详细信息。

需要澄清的是:我认为这是 Microsoft 的一个错误。但是，如果它是一个“功能”，有人可以引导我查看相应的文档吗？我到处都找不到它。

Answer 1

根据 MSDN:

Subclassing Controls Using ComCtl32.dll version 6

Note ComCtl32.dll version 6 is Unicode only. The common controls supported by ComCtl32.dll version 6 should not be subclassed (or superclassed) with ANSI window procedures.

...

Note All strings passed to the procedure are Unicode strings even if Unicode is not specified as a preprocessor definition.

看来这是所设计的。

我的 c:\windows\syswow64文件夹中的

comctl32.dll是版本6.1。