paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 21:19:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Move some subfunctions outside from big WindowProc.

Browse Source 
git-svn-id: trunk@47392 -
This commit is contained in:
juha 2015-01-14 21:12:30 +00:00
parent 8fcd9bf8b1
commit 713f1f90dc
1 changed files with 112 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

225
lcl/interfaces/win32/win32callback.inc
View File

@ -239,6 +239,117 @@ begin
end; end;
end; end;
// Used by WindowProc :
function GetMenuParent(ASearch, AParent: HMENU): HMENU;
var
c, i: integer;
sub: HMENU;
begin
c := GetMenuItemCount(AParent);
for i:= 0 to c - 1 do
begin
sub := GetSubMenu(AParent, i);
if sub = ASearch
then begin
Result := AParent;
Exit;
end;
Result := GetMenuParent(ASearch, sub);
if Result <> 0 then Exit;
end;
Result := 0;
end;
function GetIsNativeControl(AWindow: HWND): Boolean;
var
S: String;
begin
S := WndClassName(AWindow);
Result := (S <> ClsName) and (S <> ClsHintName);
end;
procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
var
Parent: TWinControl;
Sibling: TControl;
WinControl: TWinControlAccess absolute Sibling;
LParamFlag: LRESULT;
i: Integer;
begin
Parent := RadioButton.Parent;
for i:= 0 to Parent.ControlCount - 1 do
begin
Sibling := Parent.Controls[i];
if (Sibling is TRadioButton) and (Sibling <> RadioButton) then
begin
// Pass previous state through LParam so the event handling can decide
// when to propagate LM_CHANGE (New State <> Previous State)
LParamFlag := Windows.SendMessage(WinControl.WindowHandle, BM_GETCHECK, 0, 0);
// Pass SKIP_LMCHANGE through LParam if previous state is already unchecked
if LParamFlag = BST_UNCHECKED then
LParamFlag := SKIP_LMCHANGE;
Windows.SendMessage(WinControl.WindowHandle, BM_SETCHECK,
Windows.WParam(BST_UNCHECKED), Windows.LParam(LParamFlag));
end;
end;
end;
// sets the text of the combobox,
// because some events are risen, before the text is actually changed
procedure UpdateComboBoxText(ComboBox: TCustomComboBox);
var
Index: Integer;
begin
with ComboBox do begin
Index := ItemIndex;
// Index might be -1, if current text is not in the list.
if (Index>=0) then
TWin32WSWinControl.SetText(ComboBox, Items[Index]);
end;
end;
procedure EnableChildWindows(WinControl: TWinControl; Enable: boolean);
var
i: integer;
ChildControl: TWinControl;
begin
for i := 0 to WinControl.ControlCount-1 do
begin
if WinControl.Controls[i] is TWinControl then
begin
ChildControl := TWinControl(WinControl.Controls[i]);
if Enable then
begin
if ChildControl.Enabled then
EnableWindow(ChildControl.Handle, true);
end
else
EnableWindow(ChildControl.Handle, false);
EnableChildWindows(ChildControl, Enable);
end;
end;
end;
// Gets the cursor position relative to a given window
function GetClientCursorPos(ClientWindow: HWND) : TSmallPoint;
var
P: TPoint;
begin
Windows.GetCursorPos(P);
//if the mouse is not over the window is better to set to 0 to avoid weird behaviors
if Windows.WindowFromPoint(P) = ClientWindow then
Windows.ScreenToClient(ClientWindow, P)
else
begin
P.X:=0;
P.Y:=0;
end;
Result := PointToSmallPoint(P);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: WindowProc Function: WindowProc
Params: Window - The window that receives a message Params: Window - The window that receives a message
@ -256,8 +367,7 @@ function
{$else} {$else}
WindowProc WindowProc
{$endif} {$endif}
(Window: HWnd; Msg: UInt; WParam: Windows.WParam; (Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
LParam: Windows.LParam): LResult; stdcall;
var var
LMessage: TLMessage; LMessage: TLMessage;
menuItem: TObject; menuItem: TObject;
@ -298,27 +408,6 @@ var
OrgCharCode: word; // used in WM_CHAR handling OrgCharCode: word; // used in WM_CHAR handling
CharCodeNotEmpty: boolean; // used by WM_CHAR, WM_SYSCHAR and WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP CharCodeNotEmpty: boolean; // used by WM_CHAR, WM_SYSCHAR and WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP
function GetMenuParent(ASearch, AParent: HMENU): HMENU;
var
c, i: integer;
sub: HMENU;
begin
c := GetMenuItemCount(AParent);
for i:= 0 to c - 1 do
begin
sub := GetSubMenu(AParent, i);
if sub = ASearch
then begin
Result := AParent;
Exit;
end;
Result := GetMenuParent(ASearch, sub);
if Result <> 0 then Exit;
end;
Result := 0;
end;
function GetPopMenuItemObject: TObject; function GetPopMenuItemObject: TObject;
var var
MainMenuHandle: HMENU; MainMenuHandle: HMENU;
@ -362,14 +451,6 @@ var
Result := nil; Result := nil;
end; end;
function GetIsNativeControl(AWindow: HWND): Boolean;
var
S: String;
begin
S := WndClassName(AWindow);
Result := (S <> ClsName) and (S <> ClsHintName);
end;
procedure SendPaintMessage(ControlDC: HDC); procedure SendPaintMessage(ControlDC: HDC);
var var
DC: HDC; DC: HDC;
@ -640,76 +721,11 @@ var
{$endif} {$endif}
end; end;
end; end;
{$IFDEF DBG_SendPaintMessage} {$IFDEF DBG_SendPaintMessage}
finally finally
DebugLnExit('<<< SendPaintMessage for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl)); DebugLnExit('<<< SendPaintMessage for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
end; end;
{$ENDIF} {$ENDIF}
end;
procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
var
Parent: TWinControl;
Sibling: TControl;
WinControl: TWinControlAccess absolute Sibling;
LParamFlag: LRESULT;
i: Integer;
begin
Parent := RadioButton.Parent;
for i:= 0 to Parent.ControlCount - 1 do
begin
Sibling := Parent.Controls[i];
if (Sibling is TRadioButton) and (Sibling <> RadioButton) then
begin
// Pass previous state through LParam so the event handling can decide
// when to propagate LM_CHANGE (New State <> Previous State)
LParamFlag := Windows.SendMessage(WinControl.WindowHandle, BM_GETCHECK, 0, 0);
// Pass SKIP_LMCHANGE through LParam if previous state is already unchecked
if LParamFlag = BST_UNCHECKED then
LParamFlag := SKIP_LMCHANGE;
Windows.SendMessage(WinControl.WindowHandle, BM_SETCHECK,
Windows.WParam(BST_UNCHECKED), Windows.LParam(LParamFlag));
end;
end;
end;
// sets the text of the combobox,
// because some events are risen, before the text is actually changed
procedure UpdateComboBoxText(ComboBox: TCustomComboBox);
var
Index: Integer;
begin
with ComboBox do begin
Index := ItemIndex;
// Index might be -1, if current text is not in the list.
if (Index>=0) then
TWin32WSWinControl.SetText(ComboBox, Items[Index]);
end;
end;
procedure EnableChildWindows(WinControl: TWinControl; Enable: boolean);
var
i: integer;
ChildControl: TWinControl;
begin
for i := 0 to WinControl.ControlCount-1 do
begin
if WinControl.Controls[i] is TWinControl then
begin
ChildControl := TWinControl(WinControl.Controls[i]);
if Enable then
begin
if ChildControl.Enabled then
EnableWindow(ChildControl.Handle, true);
end
else
EnableWindow(ChildControl.Handle, false);
EnableChildWindows(ChildControl, Enable);
end;
end;
end; end;
procedure HandleScrollMessage(LMsg: integer); procedure HandleScrollMessage(LMsg: integer);
@ -1040,23 +1056,6 @@ var
end; end;
end; end;
// Gets the cursor position relative to a given window
function GetClientCursorPos(ClientWindow: HWND) : TSmallPoint;
var
P: TPoint;
begin
Windows.GetCursorPos(P);
//if the mouse is not over the window is better to set to 0 to avoid weird behaviors
if Windows.WindowFromPoint(P) = ClientWindow then
Windows.ScreenToClient(ClientWindow, P)
else
begin
P.X:=0;
P.Y:=0;
end;
Result := PointToSmallPoint(P);
end;
// returns false if the UnicodeChar is not handled // returns false if the UnicodeChar is not handled
function HandleUnicodeChar(var AChar: Word): boolean; function HandleUnicodeChar(var AChar: Word): boolean;
var var