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

REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)

Browse Source 
git-svn-id: trunk@5081 -
This commit is contained in:
micha 2004-01-20 22:14:27 +00:00
parent 5aee800a5b
commit 1ac23788c3
4 changed files with 57 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -194,7 +194,7 @@ Var
procedure GetChildOwnerObject(ChildId: Integer);
begin
OwnerObject := TObject(GetProp(Windows.GetDlgItem(Window, ChildId), 'WinControl'));
OwnerObject := TObject(Windows.GetProp(Windows.GetDlgItem(Window, ChildId), 'WinControl'));
end;
procedure SendPaintMessage;
@ -465,7 +465,7 @@ Begin
if ScrollBar <> 0 then
begin
// send message to actual scrollbar window
OwnerObject := TObject(GetProp(ScrollBar, 'Wincontrol'));
OwnerObject := TObject(Windows.GetProp(ScrollBar, 'Wincontrol'));
end;
End;
End;
@ -760,7 +760,7 @@ Begin
if ScrollBar <> 0 then
begin
// send message to actual scrollbar window
OwnerObject := TObject(GetProp(ScrollBar, 'Wincontrol'));
OwnerObject := TObject(Windows.GetProp(ScrollBar, 'Wincontrol'));
end;
End;
End;
@ -976,6 +976,9 @@ end;
{
$Log$
Revision 1.90 2004/01/20 22:14:27 micha
REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)
Revision 1.89 2004/01/20 10:26:41 micha
try register globally unique properties

43
lcl/interfaces/win32/win32object.inc
View File

@ -605,7 +605,7 @@ Begin
Begin
If Handle <> 0 Then
begin
DestroyAcceleratorTable(LongWord(GetProp(Handle, 'Accel')));
DestroyAcceleratorTable(Windows.GetProp(Handle, 'Accel'));
DestroyWindow(Handle);
end;
End
@ -1131,7 +1131,7 @@ var
Begin
While PeekMessage(AMessage, HWnd(Nil), 0, 0,PM_REMOVE) Do
Begin
AccelTable := HACCEL(GetProp(AMessage.HWnd, 'Accel'));
AccelTable := HACCEL(Windows.GetProp(AMessage.HWnd, 'Accel'));
If (AccelTable = HACCEL(nil)) or (TranslateAccelerator(AMessage.HWnd, AccelTable, @AMessage) = 0) Then
Begin
TranslateMessage(@AMessage);
@ -1927,6 +1927,10 @@ Begin
Width := TControl(Sender).Width;
if TControl(Sender).Visible then
Flags := Flags or WS_VISIBLE;
if csAcceptsControls in TControl(Sender).ControlStyle then
FlagsEx := FlagsEx or WS_EX_CONTROLPARENT;
if TControl(Sender).TabStop then
Flags := Flags or WS_TABSTOP;
Assert(False, 'Trace:Setting dimentions');
LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height);
{$IFDEF VerboseSizeMsg}
@ -1964,17 +1968,21 @@ Begin
csBitBtn:
Begin
pClassName := 'BUTTON';
Flags := Flags or BS_PUSHBUTTON or BS_OWNERDRAW;
if TBitBtn(Sender).Default Then
Flags := Flags or BS_DEFPUSHBUTTON
else
Flags := Flags or BS_PUSHBUTTON;
Flags := Flags or BS_OWNERDRAW;
WindowTitle := nil;
IntSendMessage3(LM_LOADXPM, Sender, StrCaption);
End;
csButton:
Begin
Assert(False, 'Trace:CreateComponent - Creating Button');
If Not TButton(Sender).Default Then
Flags := Flags Or BS_PUSHBUTTON
Else
Flags := Flags Or BS_DEFPUSHBUTTON;
if TButton(Sender).Default Then
Flags := Flags or BS_DEFPUSHBUTTON
else
Flags := Flags or BS_PUSHBUTTON;
pClassName := 'BUTTON';
WindowTitle := StrCaption;
End;
@ -2021,7 +2029,7 @@ Begin
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
end;
end;
FlagsEx := WS_EX_CLIENTEDGE;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
pClassName := 'LISTBOX';
Flags := Flags or (WS_VSCROLL or LBS_NOINTEGRALHEIGHT or LBS_HASSTRINGS);
End;
@ -2037,13 +2045,13 @@ Begin
else
Flags:= Flags or LBS_MULTIPLESEL;
End;
FlagsEx := WS_EX_CLIENTEDGE;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
pClassName := 'LISTBOX';
Flags := Flags or LBS_MULTICOLUMN or WS_HSCROLL;
End;
csEdit:
Begin
FlagsEx := WS_EX_CLIENTEDGE;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
pClassName := 'EDIT';
WindowTitle := StrCaption;
Flags := Flags Or ES_AUTOHSCROLL;
@ -2059,7 +2067,6 @@ Begin
Begin
Assert(False, 'Trace:CreateComponent - Creating a Form Window');
Flags:= WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
FlagsEx:= 0;
Case TCustomForm(Sender).BorderStyle of
//bsSizeable:; -> Default
bsSingle:
@ -2092,7 +2099,7 @@ Begin
pClassName := @ClsName;
WindowTitle := StrCaption;
Flags := WS_POPUP;
FlagsEx := WS_EX_TOOLWINDOW;
FlagsEx := FlagsEx or WS_EX_TOOLWINDOW;
Left := LongInt(CW_USEDEFAULT);
Top := LongInt(CW_USEDEFAULT);
Width := LongInt(CW_USEDEFAULT);
@ -2133,7 +2140,7 @@ Begin
ssBoth:
Flags := Flags Or WS_HSCROLL Or WS_VSCROLL;
End;
FlagsEx := WS_EX_CLIENTEDGE;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
pClassName := 'EDIT';
WindowTitle := StrCaption;
End;
@ -2160,7 +2167,7 @@ Begin
csScrollBox:
Begin
//Todo: Make control respond to user scroll request
FlagsEx := WS_EX_CLIENTEDGE;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
pClassName := @ClsName;
Flags := Flags or WS_HSCROLL or WS_VSCROLL;
DoSubClass := false;
@ -2170,7 +2177,7 @@ Begin
Assert(False, 'TRACE: CreateComponent - creating a scrolled window');
pClassName := @ClsName;
WindowTitle := StrCaption;
Flags := WS_OVERLAPPEDWINDOW Or WS_HSCROLL Or WS_VSCROLL Or WS_VISIBLE;
Flags := WS_OVERLAPPEDWINDOW or WS_HSCROLL or WS_VSCROLL or WS_VISIBLE;
Left := LongInt(CW_USEDEFAULT);
Top := LongInt(CW_USEDEFAULT);
Width := LongInt(CW_USEDEFAULT);
@ -2218,7 +2225,6 @@ Begin
csPage:
Begin
Assert(False, 'Trace:Create a csPage component.');
FlagsEx := WS_EX_CONTROLPARENT;
pClassName := @ClsName;
Flags := Flags and DWORD(not WS_VISIBLE);
DoSubClass := false;
@ -2963,7 +2969,10 @@ End;
{
$Log$
Revision 1.159 2004/01/20 10:26:41 micha
Revision 1.160 2004/01/20 22:14:27 micha
REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)
Revision 1.158 2004/01/20 10:26:41 micha
try register globally unique properties
Revision 1.158 2004/01/12 08:36:34 micha

11
lcl/interfaces/win32/win32proc.inc
View File

@ -578,13 +578,13 @@ end;
Procedure SetAccelGroup(Const Control: HWND; Const AnAccelGroup: HACCEL);
Begin
Assert(False, 'Trace:TODO: Code SetAccelGroup');
InterfaceObject.SetProp(Control, 'AccelGroup', Pointer(AnAccelGroup));
Windows.SetProp(Control, 'AccelGroup', AnAccelGroup);
End;
Function GetAccelGroup(Const Control: HWND): HACCEL;
Begin
Assert(False, 'Trace:TODO: Code GetAccelGroup');
Result := HACCEL(InterfaceObject.GetProp(Control, 'AccelGroup'));
Result := HACCEL(Windows.GetProp(Control, 'AccelGroup'));
End;
Procedure SetAccelKey(Window: HWND; Const CommandId: Word; Const AKey: word; Const AModifier: TShiftState);
@ -620,7 +620,7 @@ var AccelCount: integer; {number of accelerators in table}
end;
Begin
OldAccel := LongWord(InterfaceObject.GetProp(Window, 'Accel'));
OldAccel := Windows.GetProp(Window, 'Accel');
NullAccel := nil;
AccelCount := CopyAcceleratorTable(OldAccel, NullAccel, 0);
Assert(False,Format('Trace: AccelCount=%d',[AccelCount]));
@ -639,7 +639,7 @@ Begin
NewAccel[ControlIndex].fVirt := GetVirtFromState(AModifier);
NewAccel[ControlIndex].key := AKey;
DestroyAcceleratorTable(OldAccel);
InterfaceObject.SetProp(Window, 'Accel', Pointer(CreateAcceleratorTable(NewAccel, NewCount)));
Windows.SetProp(Window, 'Accel', CreateAcceleratorTable(NewAccel, NewCount));
End;
Function GetAccelKey(Const Control: HWND): LPACCEL;
@ -736,6 +736,9 @@ End;
{ =============================================================================
$Log$
Revision 1.37 2004/01/20 22:14:27 micha
REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)
Revision 1.36 2004/01/20 10:26:41 micha
try register globally unique properties

33
lcl/interfaces/win32/win32winapi.inc
View File

@ -160,7 +160,7 @@ var
MoveWindowOrgEx(PaintMsg.DC,-ClientBoundRect.Left,-ClientBoundRect.Top);
try
// call win32 paint handler
PrevWndProc := Pointer(GetProp(Handle, 'DefWndProc'));
PrevWndProc := Pointer(Windows.GetProp(Handle, 'DefWndProc'));
if PrevWndProc = nil then
Windows.DefWindowProc(Handle, WM_PAINT, PaintMsg.DC, 0)
else
@ -1251,7 +1251,7 @@ var
Begin
Result := Boolean(Windows.GetClientRect(Handle, @Rect));
if not Result then exit;
OwnerObject := TObject(GetProp(Handle, 'Wincontrol'));
OwnerObject := TObject(Windows.GetProp(Handle, 'Wincontrol'));
if OwnerObject is TWinControl then begin
TheWinControl:=TWinControl(OwnerObject);
if TheWinControl is TCustomGroupBox then begin
@ -1368,7 +1368,7 @@ var
OverlayWindow: HWND;
ARect: Windows.RECT;
begin
OverlayWindow := HWND(GetProp(WindowHandle, 'Overlay'));
OverlayWindow := HWND(Windows.GetProp(WindowHandle, 'Overlay'));
if OverlayWindow = HWND(nil) then
begin
// create 'overlay' window
@ -1376,10 +1376,10 @@ begin
OverlayWindow := Windows.CreateWindowEx(WS_EX_TRANSPARENT,
'STATIC', '', WS_CHILD or WS_VISIBLE,
ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
WindowHandle, HMENU(nil), System.HInstance, nil);
SetProp(OverlayWindow, 'DefWndProc', Pointer(Windows.SetWindowLong(
OverlayWindow, GWL_WNDPROC, LongInt(@OverlayWindowProc))));
SetProp(WindowHandle, 'Overlay', Pointer(OverlayWindow));
WindowHandle, HMENU(nil), HInstance, nil);
Windows.SetProp(OverlayWindow, 'DefWndProc', Windows.SetWindowLong(
OverlayWindow, GWL_WNDPROC, LongInt(@OverlayWindowProc)));
Windows.SetProp(WindowHandle, 'Overlay', OverlayWindow);
end;
Result := Windows.GetDC(OverlayWindow);
end;
@ -1735,11 +1735,8 @@ End;
Retrieves a pointer to data from the property list of the given window.
------------------------------------------------------------------------------}
Function TWin32Object.GetProp(Handle: HWND; Str: PChar): Pointer;
Var
TempStr: string;
Begin
TempStr := Format('%s%.8x', [Str, Windows.GetCurrentThreadId]);
Result := Pointer(Windows.GetProp(Handle, PChar(TempStr)));
Result := Pointer(Windows.GetProp(Handle, Str));
End;
@ -2593,12 +2590,9 @@ End;
for a properties-enumeration function that's called when the program is quit.
------------------------------------------------------------------------------}
Function TWin32Object.SetProp(Handle: HWND; Str: PChar; Data: Pointer): Boolean;
Var
TempStr: string;
Begin
Assert(False, 'Trace:TWin32Object.SetProp - Start');
TempStr := Format('%s%.8x', [Str, Windows.GetCurrentThreadId]);
Result := Boolean(Windows.SetProp(Handle, PChar(TempStr), Windows.HANDLE(Data)));
Result := Boolean(Windows.SetProp(Handle, Str, Windows.HANDLE(Data)));
Assert(False, Format('Trace:TWin32Object.SetProp --> Window handle: 0x%X, Propery to set: %S, Data to set: 0x%P, Property was successfully set: %S', [Handle, String(Str), Data, BOOL_RESULT[Result]]));
End;
@ -2856,8 +2850,14 @@ End;
Retrieves the handle of the window that contains the specified point.
------------------------------------------------------------------------------}
Function TWin32Object.WindowFromPoint(Point: TPoint): HWND;
Var
ProcessID: DWORD;
Begin
Result := Windows.WindowFromPoint(Windows.POINT(Point));
// check if window created by this process
Windows.GetWindowThreadProcessId(Result, @ProcessID);
if ProcessID <> Windows.GetCurrentProcessID then
Result := 0;
End;
@ -2910,6 +2910,9 @@ end;
{ =============================================================================
$Log$
Revision 1.95 2004/01/20 22:14:27 micha
REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)
Revision 1.94 2004/01/20 10:26:41 micha
try register globally unique properties