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

customdrawn-x11: Finishes the handle rework

Browse Source 
git-svn-id: trunk@33732 -
This commit is contained in:
sekelsenmat 2011-11-23 17:32:24 +00:00
parent 6966f1da55
commit 72ea67ba06
12 changed files with 47 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5438,7 +5438,6 @@ lcl/interfaces/customdrawn/customdrawnwinapih.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwscontrols.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwscontrols.pp svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnwscontrols_win.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwscontrols_x11.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwsfactory.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnwsforms.pp svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawnwsforms_cocoa.inc svneol=native#text/pascal

4
lcl/interfaces/customdrawn/customdrawn_x11proc.pas
View File

@ -12,13 +12,15 @@ uses
// Custom Drawn Canvas
IntfGraphics, lazcanvas,
//
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc;
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc,
customdrawnproc;
type
TX11WindowInfo = class
public
Window: X.TWindow;
LCLControl: TWinControl;
CDWinControl: TCDWinControl;
// Used and valid only during event processing
XEvent: PXEvent;
// X11 extra objects

2
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -130,7 +130,7 @@ type
FWMDeleteWindow: TAtom; // Atom for "WM_DELETE_WINDOW"
FWMHints: TAtom; // Atom for "_MOTIF_WM_HINTS"
function FindWindowByXID(XWindowID: X.TWindow; out AIndex: Integer): TWinControl;
function FindWindowByXID(XWindowID: X.TWindow; out AWindowInfo: TX11WindowInfo): TWinControl;
{$endif}
protected
{function CreateThemeServices: TThemeServices; override;}

16
lcl/interfaces/customdrawn/customdrawnobject_x11.inc
View File

@ -18,7 +18,7 @@
*****************************************************************************
}
function TCDWidgetSet.FindWindowByXID(XWindowID: X.TWindow; out AIndex: Integer): TWinControl;
function TCDWidgetSet.FindWindowByXID(XWindowID: X.TWindow; out AWindowInfo: TX11WindowInfo): TWinControl;
var
i: Integer;
EndSubSearch: Boolean; { Necessary to quit the recursion }
@ -27,7 +27,7 @@ begin
{$ifdef VerboseFindX11Window}
DbgOut(Format('[TCDWidgetSet.FindWindowByXID] XWindowID=%x', [PtrInt(XWindowID)]));
{$endif}
AIndex := -1;
AWindowInfo := nil;
Result := nil;
{ Loops througth all windows on the application }
@ -35,7 +35,7 @@ begin
begin
lWindowInfo := TX11WindowInfo(Screen.Forms[i].Handle);
Result := lWindowInfo.LCLControl;
AIndex := i;
AWindowInfo := lWindowInfo;
{$ifdef VerboseFindX11Window}
DbgOut(Format(' Item %d Window=%x', [i, PtrInt(lWindowInfo.Window)]));
@ -57,7 +57,7 @@ end;
------------------------------------------------------------------------------}
procedure TCDWidgetSet.BackendCreate;
begin
WindowList := TFPList.Create();
end;
{------------------------------------------------------------------------------
@ -69,7 +69,7 @@ end;
------------------------------------------------------------------------------}
procedure TCDWidgetSet.BackendDestroy;
begin
WindowList.Free;
end;
{------------------------------------------------------------------------------
@ -116,7 +116,6 @@ var
Sum: Integer;
NewEvent: TXEvent;
DoBreakRun: Boolean = False;
lWindowListIndex: Integer;
CurWindowInfo: TX11WindowInfo;
begin
while (DoBreakRun = False) do
@ -136,7 +135,7 @@ begin
// According to a comment in X.h, the valid event types start with 2!
if XEvent._type >= 2 then
begin
WindowEntry := FindWindowByXID(XEvent.XAny.Window, lWindowListIndex);
WindowEntry := FindWindowByXID(XEvent.XAny.Window, CurWindowInfo);
if not Assigned(WindowEntry) then
begin
@ -145,13 +144,12 @@ begin
Continue;
end;
CurWindowInfo := TX11WindowInfo(WindowList.Items[lWindowListIndex]);
CurWindowInfo.XEvent := @XEvent;
case XEvent._type of
X.DestroyNotify:
begin
WindowList.Delete(lWindowListIndex);
//WindowList.Delete(lWindowListIndex);
end;
X.KeyPress:
begin

8
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -9,13 +9,19 @@ uses
Types, Classes, SysUtils,
fpimage, fpcanvas,
// Custom Drawn Canvas
IntfGraphics, lazcanvas,
IntfGraphics, lazcanvas, lazregions,
//
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc;
type
TUpdateLazImageFormat = (clfRGB24, clfBGR24, clfBGRA32);
TCDWinControl = class
public
Region: TLazRegionWithChilds;
WinControl: TWinControl;
end;
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; AWidth, AHeight: Integer; AFormat: TUpdateLazImageFormat);
function DateTimeToMilliseconds(aDateTime: TDateTime): Int64;

15
lcl/interfaces/customdrawn/customdrawnwscontrols.inc
View File

@ -84,14 +84,15 @@ end;
class function TCDWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
lRegion: TLazRegionWithChilds;
lCDWinControl: TCDWinControl;
begin
lRegion := TLazRegionWithChilds.Create;
lRegion.AddRectangle(Bounds(AParams.Left, AParams.Right, AParams.Width, AParams.Height));
BackendAddChildRegionToForm(AWinControl, lRegion);
//AddRectangle(ARect: TRect);
//property ClipRect : TRect read GetClipRect write SetClipRect;
//property Clipping : boolean read GetClipping write SetClipping;
lCDWinControl := TCDWinControl.Create;
lCDWinControl.WinControl := AWinControl;
lCDWinControl.Region := TLazRegionWithChilds.Create;
lCDWinControl.Region.AddRectangle(Bounds(AWinControl.Left, AWinControl.Top, AParams.Width, AParams.Height));
lCDWinControl.Region.IsSimpleRectRegion := True;
TCDWSCustomForm.BackendAddCDWinControlToForm(TCustomForm(AWinControl.Parent), lCDWinControl);
end;
class procedure TCDWSWinControl.DestroyHandle(const AWinControl: TWinControl);

7
lcl/interfaces/customdrawn/customdrawnwscontrols.pp
View File

@ -35,7 +35,8 @@ uses
Controls, LCLType, LCLProc, Forms, Graphics,
lazcanvas, lazregions,
// Widgetset
InterfaceBase, WSProc, WSControls, WSLCLClasses, customdrawnint;
InterfaceBase, WSProc, WSControls, WSLCLClasses, customdrawnint,
customdrawnproc;
type
@ -157,6 +158,8 @@ procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreate
implementation
uses customdrawnwsforms;
{$ifdef CD_Windows}
{$include customdrawnwscontrols_win.inc}
{$endif}
@ -164,7 +167,7 @@ implementation
{$include customdrawnwscontrols.inc}
{$endif}
{$ifdef CD_X11}
{$include customdrawnwscontrols_x11.inc}
{$include customdrawnwscontrols.inc}
{$endif}
end.

165
lcl/interfaces/customdrawn/customdrawnwscontrols_x11.inc
View File

@ -1,165 +0,0 @@
{$MainUnit customdrawnwscontrols.pp}
(*class procedure TCDWSWinControl.AddControl(const AControl: TControl);
{var
ParentPanelHandle, ParentHandle, ChildHandle: HWND;}
begin
{ with TWinControl(AControl) do
begin
//DebugLn(Format('Trace:[TCDWSWinControl.AddControl] %S --> Calling Add Child: %S', [Parent.ClassName, ClassName]));
ParentHandle := Parent.Handle;
ChildHandle := Handle;
end;
//DebugLn('Trace:AddControl - Parent Window Handle is $' + IntToHex(LongInt(ParentHandle), 8));
//DebugLn('Trace:AddControl - Child Window Handle is $' + IntToHex(LongInt(ChildHandle), 8));
// handle groupbox exception
ParentPanelHandle := GetWindowInfo(ChildHandle)^.ParentPanel;
if ParentPanelHandle <> 0 then
ChildHandle := ParentPanelHandle;
SetParent(ChildHandle, ParentHandle);}
end; *)
class function TCDWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
AText := '';
Result := false;
end;
class procedure TCDWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
RecreateWnd(AWinControl);
end;
class procedure TCDWSWinControl.SetChildZPosition(
const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer;
const AChildren: TFPList);
var
AfterWnd: hWnd;
n, StopPos: Integer;
Child: TWinControl;
begin
{ if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition')
then Exit;
if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)')
then Exit;
if ANewPos = 0 // bottom
then AfterWnd := HWND_BOTTOM
else if ANewPos >= AChildren.Count - 1
then AfterWnd := HWND_TOP
else begin
// Search for the first child above us with a handle
// the child list is reversed form the windows order.
// So the first window is the top window and is the last child
// if we don't find a allocated handle then we are effectively not moved
AfterWnd := 0;
if AOldPos > ANewPos
then StopPos := AOldPos // The child is moved to the bottom, oldpos is on top of it
else StopPos := AChildren.Count - 1; // the child is moved to the top
for n := ANewPos + 1 to StopPos do
begin
Child := TWinControl(AChildren[n]);
if Child.HandleAllocated
then begin
AfterWnd := Child.Handle;
Break;
end;
end;
if AfterWnd = 0 then Exit; // nothing to do
end;
Windows.SetWindowPos(AChild.Handle, AfterWnd, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or
SWP_NOSIZE or SWP_NOSENDCHANGING); }
end;
{------------------------------------------------------------------------------
Method: SetBounds
Params: AWinControl - the object which invoked this function
ALeft, ATop, AWidth, AHeight - new dimensions for the control
Pre: AWinControl.HandleAllocated
Returns: Nothing
Resize a window
------------------------------------------------------------------------------}
class procedure TCDWSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
Handle: HWND;
begin
{ IntfLeft := ALeft;
IntfTop := ATop;
IntfWidth := AWidth;
IntfHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight);
{$IFDEF VerboseSizeMsg}
DebugLn('TWin32WSWinControl.ResizeWindow A ', dbgsName(AWinControl),
' LCL=',Format('%d, %d, %d, %d', [ALeft,ATop,AWidth,AHeight]),
' Win32=',Format('%d, %d, %d, %d', [IntfLeft,IntfTop,IntfWidth,IntfHeight])
);
{$ENDIF}
suppressMove := False;
AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
if not suppressMove then
begin
Handle := AWinControl.Handle;
WindowPlacement.length := SizeOf(WindowPlacement);
if IsIconic(Handle) and GetWindowPlacement(Handle, @WindowPlacement) then
begin
WindowPlacement.rcNormalPosition := Bounds(IntfLeft, IntfTop, IntfWidth, IntfHeight);
SetWindowPlacement(Handle, @WindowPlacement);
end
else
Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
end;
LCLControlSizeNeedsUpdate(AWinControl, True); }
end;
class procedure TCDWSWinControl.SetColor(const AWinControl: TWinControl);
begin
end;
class procedure TCDWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
begin
// Windows.SendMessage(AWinControl.Handle, WM_SETFONT, Windows.WParam(AFont.Reference.Handle), 1);
end;
class procedure TCDWSWinControl.SetText(const AWinControl: TWinControl; const AText: string);
begin
// if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit;
// Windows.SetWindowTextW(AWinControl.Handle, PWideChar(UTF8Decode(AText)));
end;
class procedure TCDWSWinControl.ConstraintsChange(const AWinControl: TWinControl);
begin
end;
class function TCDWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
begin
end;
class procedure TCDWSWinControl.DestroyHandle(const AWinControl: TWinControl);
begin
end;
class procedure TCDWSWinControl.Invalidate(const AWinControl: TWinControl);
begin
// lpRect = nil updates entire client area of window
// InvalidateRect(AWinControl.Handle, nil, true);
end;
class procedure TCDWSWinControl.ShowHide(const AWinControl: TWinControl);
//const
// VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
begin
// Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
// SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
end;

2
lcl/interfaces/customdrawn/customdrawnwsforms.pp
View File

@ -77,7 +77,7 @@ type
TCDWSCustomForm = class(TWSCustomForm)
public
class procedure BackendAddChildRegionToForm(const AForm: TCustomForm; ARegion: TLazRegionWithChilds);
class procedure BackendAddCDWinControlToForm(const AForm: TCustomForm; ACDWinControl: TCDWinControl);
{$ifdef CD_Windows}
class function CalcBorderIconsFlags(const AForm: TCustomForm): dword;
class function CalcBorderIconsFlagsEx(const AForm: TCustomForm): DWORD;

2
lcl/interfaces/customdrawn/customdrawnwsforms_cocoa.inc
View File

@ -2,7 +2,7 @@
{ TCDWSCustomForm }
class procedure TCDWSCustomForm.BackendAddChildRegionToForm(const AForm: TCustomForm; ARegion: TLazRegionWithChilds);
class procedure TCDWSCustomForm.BackendAddCDWinControlToForm(const AForm: TCustomForm; ACDWinControl: TCDWinControl);
begin
end;

2
lcl/interfaces/customdrawn/customdrawnwsforms_win.inc
View File

@ -6,7 +6,7 @@ type
{ TCDWSCustomForm }
class procedure TCDWSCustomForm.BackendAddChildRegionToForm(const AForm: TCustomForm; ARegion: TLazRegionWithChilds);
class procedure TCDWSCustomForm.BackendAddCDWinControlToForm(const AForm: TCustomForm; ACDWinControl: TCDWinControl);
begin
end;

23
lcl/interfaces/customdrawn/customdrawnwsforms_x11.inc
View File

@ -2,9 +2,12 @@
{ TCDWSCustomForm }
class procedure TCDWSCustomForm.BackendAddChildRegionToForm(const AForm: TCustomForm; ARegion: TLazRegionWithChilds);
class procedure TCDWSCustomForm.BackendAddCDWinControlToForm(const AForm: TCustomForm; ACDWinControl: TCDWinControl);
var
lWindowInfo: TX11WindowInfo;
begin
lWindowInfo := TX11WindowInfo(AForm.Handle);
lWindowInfo.CDWinControl := ACDWinControl;
end;
class procedure TCDWSCustomForm.UpdateMotifWMHints(const AWinControl: TWinControl; CanMaximize: Boolean);
@ -729,7 +732,7 @@ begin
Attr.Colormap := Colormap;
SizeHints.flags := XUtil.PSize;
SizeHints.x := 0;
SizeHints.x := 0; // If it doesnt start with zero, setting bounds later on fails, no idea why
SizeHints.y := 0;
SizeHints.width := 200;
SizeHints.height := 200;
@ -773,7 +776,7 @@ begin
if lWindow = 0 then
raise Exception.Create('[TCDWSCustomForm.CreateHandle] Window creation failed');
XSelectInput(CDWidgetSet.FDisplay, Result, KeyPressMask or KeyReleaseMask
XSelectInput(CDWidgetSet.FDisplay, lWindow, KeyPressMask or KeyReleaseMask
or ButtonPressMask or ButtonReleaseMask
or EnterWindowMask or LeaveWindowMask
or ButtonMotionMask or PointerMotionMask
@ -785,16 +788,16 @@ begin
// if (not (woX11SkipWMHints in WindowOptions)) and (woWindow in WindowOptions) then
// begin
XSetStandardProperties(CDWidgetSet.FDisplay, Result, nil, nil, 0,
XSetStandardProperties(CDWidgetSet.FDisplay, lWindow, nil, nil, 0,
argv, argc, @SizeHints);
XSetWMNormalHints(CDWidgetSet.FDisplay, Result, @SizeHints);
XSetWMNormalHints(CDWidgetSet.FDisplay, lWindow, @SizeHints);
WindowHints.flags := WindowGroupHint;
WindowHints.window_group := CDWidgetSet.LeaderWindow;
XSetWMHints(CDWidgetSet.FDisplay, Result, @WindowHints);
XSetWMHints(CDWidgetSet.FDisplay, lWindow, @WindowHints);
XChangeProperty(CDWidgetSet.FDisplay, Result, CDWidgetSet.ClientLeaderAtom, 33, 32,
XChangeProperty(CDWidgetSet.FDisplay, lWindow, CDWidgetSet.ClientLeaderAtom, 33, 32,
PropModeReplace, @CDWidgetSet.LeaderWindow, 1);
// We want to get a Client Message when the user tries to close this window
@ -804,7 +807,7 @@ begin
CDWidgetSet.FWMDeleteWindow := XInternAtom(CDWidgetSet.FDisplay, 'WM_DELETE_WINDOW', False);
// send close event instead of quitting the whole application...
XSetWMProtocols(CDWidgetSet.FDisplay, Result, @CDWidgetSet.FWMDeleteWindow, 1);
XSetWMProtocols(CDWidgetSet.FDisplay, lWindow, @CDWidgetSet.FWMDeleteWindow, 1);
// end;
{ Child windows do not appear until parent (lParentHandle) is mapped }
@ -819,7 +822,7 @@ begin
lWindowInfo := TX11WindowInfo.Create;
lWindowInfo.Window := lWindow;
lWindowInfo.LCLControl := AWinControl;
XGetWindowAttributes(CDWidgetSet.FDisplay, Result, @lWindowInfo.Attr);
XGetWindowAttributes(CDWidgetSet.FDisplay, lWindow, @lWindowInfo.Attr);
lWindowInfo.Colormap := XDefaultColormap(CDWidgetSet.FDisplay, XDefaultScreen(CDWidgetSet.FDisplay));
lWindowInfo.ColorDepth := lWindowInfo.Attr.depth;
CreateX11Canvas(lWindowInfo);