diff --git a/ideintf/objectinspector.pp b/ideintf/objectinspector.pp index ffc934e49d..335ccf1108 100644 --- a/ideintf/objectinspector.pp +++ b/ideintf/objectinspector.pp @@ -1468,7 +1468,7 @@ procedure TOICustomPropertyGrid.ValueComboBoxMeasureItem(Control: TWinControl; var CurRow: TOIPropertyGridRow; begin - if (FItemIndex >= 0) and (FItemIndex < FRows.Count) and (ValueComboBox.HandleAllocated) then + if (FItemIndex >= 0) and (FItemIndex < FRows.Count) then begin CurRow := Rows[FItemIndex]; CurRow.Editor.ListMeasureHeight('Fj', Index, ValueComboBox.Canvas, AHeight); diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index 76cc34fc65..c45aa721a7 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -85,7 +85,7 @@ function CallDefaultWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; var Info: TComboboxInfo; begin - Result := WndClassName(Window) = ComboboxClsName; + Result := WndClassName(Window) = LCLComboboxClsName; if not Result then Exit; Info.cbSize := SizeOf(Info); diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 1aa39325f5..1a62a61fa7 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -221,6 +221,7 @@ const TabControlClsName: array[0..15] of char = 'SysTabControl32'#0; ListViewClsName: array[0..13] of char = 'SysListView32'#0; + LCLComboboxClsName: array[0..11] of char = 'LCLComboBox'#0; ClsNameW: array[0..6] of WideChar = ('W', 'i', 'n', 'd', 'o', 'w', #0); ClsHintNameW: array[0..10] of WideChar = ('H', 'i', 'n', 't', 'W', 'i', 'n', 'd', 'o', 'w', #0); diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index b52368662f..737e5b63e2 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/lcl/interfaces/win32/win32wscontrols.pp @@ -117,15 +117,23 @@ type SubClassWndProc: pointer; StrCaption, WindowTitle: String; pClassName: PChar; + pSubClassName: PChar; end; + TNCCreateParams = record + WinControl: TWinControl; + DefWndProc: WNDPROC; + Handled: Boolean; + end; + PNCCreateParams = ^TNCCreateParams; + // TODO: better names? procedure PrepareCreateWindow(const AWinControl: TWinControl; const CreateParams: TCreateParams; var Params: TCreateWindowExParams); procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams; - const AlternateCreateWindow: boolean); + const AlternateCreateWindow: boolean; SubClass: Boolean = False); procedure WindowCreateInitBuddy(const AWinControl: TWinControl; var Params: TCreateWindowExParams); @@ -186,36 +194,84 @@ begin end; procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams; - const AlternateCreateWindow: boolean); + const AlternateCreateWindow: boolean; SubClass: Boolean = False); var lhFont: HFONT; AErrorCode: Cardinal; + NCCreateParams: TNCCreateParams; + WindowClass, DummyClass: WndClass; +{$ifdef WindowsUnicodeSupport} + WindowClassW, DummyClassW: WndClassW; +{$endif} begin + NCCreateParams.DefWndProc := nil; + NCCreateParams.WinControl := AWinControl; + NCCreateParams.Handled := False; + if not AlternateCreateWindow then begin with Params do begin - if (Flags and WS_CHILD) <> 0 then + if SubClass then begin - // menu handle is also for specifying a control id if this is a child - MenuHandle := HMENU(AWinControl); - end else begin - MenuHandle := HMENU(nil); + {$ifdef WindowsUnicodeSupport} + if UnicodeEnabledOS then + begin + if GetClassInfoW(System.HInstance, PWideChar(WideString(pClassName)), @WindowClassW) then + begin + NCCreateParams.DefWndProc := WndProc(WindowClassW.lpfnWndProc); + if not GetClassInfoW(System.HInstance, PWideChar(WideString(pSubClassName)), @DummyClassW) then + begin + with WindowClassW do + begin + LPFnWndProc := SubClassWndProc; + hInstance := System.HInstance; + lpszClassName := PWideChar(WideString(pSubClassName)); + end; + Windows.RegisterClassW(@WindowClassW); + end; + pClassName := pSubClassName; + end; + end + else + {$endif} + begin + if GetClassInfo(System.HInstance, pClassName, @WindowClass) then + begin + NCCreateParams.DefWndProc := WndProc(WindowClass.lpfnWndProc); + if not GetClassInfo(System.HInstance, pSubClassName, @DummyClass) then + begin + with WindowClass do + begin + LPFnWndProc := SubClassWndProc; + hInstance := System.HInstance; + lpszClassName := pSubClassName; + end; + Windows.RegisterClass(@WindowClass); + end; + pClassName := pSubClassName; + end; + end; end; + if (Flags and WS_CHILD) <> 0 then + // menu handle is also for specifying a control id if this is a child + MenuHandle := HMENU(AWinControl) + else + MenuHandle := HMENU(nil); {$ifdef WindowsUnicodeSupport} if UnicodeEnabledOS then Window := CreateWindowExW(FlagsEx, PWideChar(WideString(pClassName)), PWideChar(UTF8ToUTF16(WindowTitle)), Flags, - Left, Top, Width, Height, Parent, MenuHandle, HInstance, nil) + Left, Top, Width, Height, Parent, MenuHandle, HInstance, @NCCreateParams) else Window := CreateWindowEx(FlagsEx, pClassName, PChar(Utf8ToAnsi(WindowTitle)), Flags, - Left, Top, Width, Height, Parent, MenuHandle, HInstance, nil); + Left, Top, Width, Height, Parent, MenuHandle, HInstance, @NCCreateParams); {$else} Window := CreateWindowEx(FlagsEx, pClassName, PChar(WindowTitle), Flags, - Left, Top, Width, Height, Parent, MenuHandle, HInstance, nil); + Left, Top, Width, Height, Parent, MenuHandle, HInstance, @NCCreateParams); {$endif} if Window = 0 then @@ -240,14 +296,18 @@ begin if Window <> HWND(Nil) then begin // some controls (combobox) immediately send a message upon setting font - WindowInfo := AllocWindowInfo(Window); - if GetWin32WindowInfo(Parent)^.needParentPaint then - WindowInfo^.needParentPaint := true; - WindowInfo^.WinControl := AWinControl; - AWinControl.Handle := Window; - if SubClassWndProc <> nil then - WindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLong( - Window, GWL_WNDPROC, PtrInt(SubClassWndProc))); + if not NCCreateParams.Handled then + begin + WindowInfo := AllocWindowInfo(Window); + if GetWin32WindowInfo(Parent)^.needParentPaint then + WindowInfo^.needParentPaint := true; + WindowInfo^.WinControl := AWinControl; + AWinControl.Handle := Window; + if Assigned(SubClassWndProc) then + WindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLong( + Window, GWL_WNDPROC, PtrInt(SubClassWndProc))); + end; + if AWinControl.Font.IsDefault then lhFont := Win32WidgetSet.DefaultFont else diff --git a/lcl/interfaces/win32/win32wsstdctrls.pp b/lcl/interfaces/win32/win32wsstdctrls.pp index eb6736c301..ebe6e33a53 100644 --- a/lcl/interfaces/win32/win32wsstdctrls.pp +++ b/lcl/interfaces/win32/win32wsstdctrls.pp @@ -350,21 +350,38 @@ function ComboBoxWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; var Info: TComboboxInfo; + WindowInfo: PWin32WindowInfo; + NCCreateParams: PNCCreateParams; begin // darn MS: if combobox has edit control, and combobox receives focus, it // passes it on to the edit, so it will send a WM_KILLFOCUS; inhibit // also don't pass WM_SETFOCUS to the lcl, // it will get one from the edit control - if ((Msg = WM_KILLFOCUS) or (Msg = WM_SETFOCUS)) then - begin - Info.cbSize := SizeOf(Info); - Win32Extra.GetComboBoxInfo(Window, @Info); - if (HWND(WParam) = Info.hwndItem) or (HWND(WParam) = Info.hwndList) then - begin - // continue normal processing, don't send to lcl - Result := CallDefaultWindowProc(Window, Msg, WParam, LParam); - Exit; - end; + case Msg of + WM_NCCREATE: + begin + NCCreateParams := PCREATESTRUCT(lParam)^.lpCreateParams; + if Assigned(NCCreateParams) then + begin + WindowInfo := AllocWindowInfo(Window); + WindowInfo^.WinControl := NCCreateParams^.WinControl; + WindowInfo^.WinControl.Handle := Window; + WindowInfo^.DefWndProc := NCCreateParams^.DefWndProc; + WindowInfo^.needParentPaint := False; + NCCreateParams^.Handled := True; + end; + end; + WM_KILLFOCUS, WM_SETFOCUS: + begin + Info.cbSize := SizeOf(Info); + Win32Extra.GetComboBoxInfo(Window, @Info); + if (HWND(WParam) = Info.hwndItem) or (HWND(WParam) = Info.hwndList) then + begin + // continue normal processing, don't send to lcl + Result := CallDefaultWindowProc(Window, Msg, WParam, LParam); + Exit; + end; + end; end; // normal processing Result := WindowProc(Window, Msg, WParam, LParam); @@ -799,13 +816,12 @@ begin if TComboBox(AWinControl).Sorted Then Flags:= Flags or CBS_SORT; pClassName := ComboboxClsName; + pSubClassName := LCLComboboxClsName; Flags := Flags or (WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS); SubClassWndProc := @ComboBoxWindowProc; end; // create window - FinishCreateWindow(AWinControl, Params, false); - // combobox is not a transparent control -> no need for parentpainting - Params.WindowInfo^.needParentPaint := false; + FinishCreateWindow(AWinControl, Params, False, True); Info.cbSize:= SizeOf(Info); Win32Extra.GetComboBoxInfo(Params.Window, @Info);