SetWindowSubclass 将 ANSI windows 更改为 UNICODE

SetWindowSubclass changes ANSI windows to UNICODE

SetWindowSubClass() 是否应该将 ANSI window 更改为 UNICODE 寡妇?我没有在文档中或网络上找到任何关于此行为的信息。

我创建了一个测试应用程序(full source) just to illustrate how SetWindowSubclass (I believe) changes the type of the affected window from ANSI to UNICODE, as it shouldn't! 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(34{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 及更早版本中,主要 window(和所有子控件)是使用 ANSI 版本的 Win32 API 过程创建的,因此消息处理程序(的子类控件)应该始终接收 ANSI 文本(以及 WM_SETTEXT 消息)!

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

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

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

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

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

澄清一下:我认为这是 Microsoft 的一个错误。但是,如果它是 "feature",有人可以引导我找到相应的文档吗?我到处都找不到它。

根据 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.

看来这是设计的

comctl32.dll 在我的 c:\windows\syswow64 文件夹中是版本 6.1。