mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-30 14:18:58 +02:00
win32:
- redo FinishCreateWindow to allow window subclassing, - subclass combobox to get access to the first messages that control receives ideintf: remove workaround with ValueComboBox handle check in MeasureItem git-svn-id: trunk@24686 -
This commit is contained in:
paul
parent
3fce5af5cc
commit
f95b2f63d5
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user