mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 10:19:36 +02:00
Patch from Giuliano Colla with a new timer, it is disabled by default because it crashes the test nonandroidtest
git-svn-id: trunk@36513 -
This commit is contained in:
sekelsenmat
parent
2c9423e0c0
commit
6f76486093
@ -2,6 +2,8 @@ unit customdrawn_x11proc;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{$I customdrawndefines.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -28,12 +30,36 @@ type
|
||||
ColorDepth: Byte;
|
||||
end;
|
||||
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
TWSTimerProc = procedure of object;
|
||||
|
||||
{ TCDX11Timer }
|
||||
TCDX11Timer = class (TObject)
|
||||
Next: TCDX11Timer;
|
||||
Previous: TCDX11Timer;
|
||||
Interval: Integer;
|
||||
Expires: TDateTime;
|
||||
func: TWSTimerProc;
|
||||
constructor create (WSInterval: Integer; WSfunc: TWSTimerProc);
|
||||
procedure Insert;
|
||||
procedure Remove;
|
||||
procedure Expired;
|
||||
destructor destroy;
|
||||
end;
|
||||
|
||||
const
|
||||
KMsToDateTime = 86400000; // # of milliseconds in a day
|
||||
{$endif}
|
||||
|
||||
function RectToXRect(const ARect: TRect): TXRectangle;
|
||||
function XRectToRect(const ARect: TXRectangle): TRect;
|
||||
function XButtonToMouseButton(const XButton: cint; var MouseButton: TMouseButton): Boolean;
|
||||
function GetXEventName(Event: LongInt): String;
|
||||
|
||||
implementation
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
uses CustomDrawnInt;
|
||||
{$endif}
|
||||
|
||||
function RectToXRect(const ARect: TRect): TXRectangle;
|
||||
begin
|
||||
@ -84,5 +110,129 @@ begin
|
||||
Result := '#' + IntToStr(Event);
|
||||
end;
|
||||
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
{ TCDX11Timer }
|
||||
|
||||
constructor TCDX11Timer.create(WSInterval: Integer; WSfunc: TWSTimerProc);
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
var
|
||||
lTInterval: Integer;
|
||||
TDiff,TNow: TDateTime;
|
||||
{$endif}
|
||||
begin
|
||||
Interval:= WSInterval; // Interval in ms
|
||||
Func:= WSfunc; // OnTimeEvent
|
||||
Expires:= Now + Interval/KMsToDateTime; //
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
TNow:= Now;
|
||||
TDiff:= Expires - TNow;
|
||||
lTInterval:=DateTimeToMilliseconds(Tdiff);
|
||||
DebugLn(Format('X11_Timer create: Interval= %d, Calculated=%d',[Interval,lTInterval]));
|
||||
{$endif}
|
||||
Previous:= Nil;
|
||||
Next:= Nil;
|
||||
end;
|
||||
|
||||
procedure TCDX11Timer.Insert;
|
||||
var
|
||||
lTimer,PTimer,NTimer: TCDX11Timer;
|
||||
begin
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
DebugLn(Format('TCDX11Timer Insert: Interval := %d',[Interval]));
|
||||
{$endif}
|
||||
if CDWidgetSet.XTimerListHead = nil then begin// The list is empty
|
||||
CDWidgetSet.XTimerListHead:= self;
|
||||
Previous:=Nil; // This is the first and only timer
|
||||
Next:=Nil;
|
||||
end
|
||||
else begin
|
||||
PTimer:=nil; // previous in list
|
||||
NTimer:=nil; // Next in list
|
||||
lTimer := CDWidgetSet.XTimerListHead;
|
||||
while lTimer.Expires <= Expires do begin
|
||||
PTimer := ltimer;
|
||||
if not assigned(lTimer.Next) then Break
|
||||
else lTimer:= lTimer.Next;
|
||||
end;
|
||||
if PTimer<>nil then begin //We're not the first one
|
||||
Previous := PTimer;
|
||||
NTimer := PTimer.Next;
|
||||
if Assigned(NTimer) then begin
|
||||
Next := NTimer;
|
||||
NTimer.Previous := self;
|
||||
end
|
||||
else Next := Nil;
|
||||
PTimer.Next := self;
|
||||
end
|
||||
else begin // we're in first place. previous first becomes Next
|
||||
NTimer := CDWidgetSet.XTimerListHead;
|
||||
CDWidgetSet.XTimerListHead := Self;
|
||||
NTimer.Previous := Self;
|
||||
Next:= NTimer;
|
||||
Previous := nil;
|
||||
end;
|
||||
end;
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
lTimer := CDWidgetSet.XTimerListHead;
|
||||
while lTimer <> Nil do begin
|
||||
DebugLn(Format('TCDX11Timer Insert results: Interval := %d',[lTimer.Interval]));
|
||||
lTimer:= lTimer.Next;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TCDX11Timer.remove;
|
||||
begin
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
DebugLn(Format('TCDX11Timer Remove: Interval := %d',[Interval]));
|
||||
{$endif}
|
||||
if Previous <> Nil then begin
|
||||
if Next <> Nil then begin
|
||||
Previous.Next := Next;
|
||||
Next.Previous := Previous;
|
||||
end
|
||||
else Previous.Next:= Nil;
|
||||
end
|
||||
else begin
|
||||
CDWidgetSet.XTimerListHead := Next;
|
||||
if Next <> nil then begin
|
||||
Next.Previous:= Nil;
|
||||
end;
|
||||
end;
|
||||
Previous:= Nil;
|
||||
Next := Nil;
|
||||
end;
|
||||
|
||||
procedure TCDX11Timer.Expired;
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
var
|
||||
lInterval,lTInterval: Integer;
|
||||
TDiff,TNow: TDateTime;
|
||||
{$endif}
|
||||
begin
|
||||
Expires:= Expires+Interval/KMsToDateTime; // don't leak
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
TNow:= Now;
|
||||
TDiff:= Expires - TNow;
|
||||
lTInterval:=DateTimeToMilliseconds(Tdiff);
|
||||
DebugLn(Format('X11_Timer Expired: Interval= %d, Calculated=%d',[Interval,lTInterval]));
|
||||
{$endif}
|
||||
Remove; // Remove from list Head
|
||||
if func <> nil then
|
||||
func(); // Execute OnTimer
|
||||
Insert; // And insert again in right place
|
||||
end;
|
||||
|
||||
destructor TCDX11Timer.destroy;
|
||||
begin
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
DebugLn(Format('TCDX11Timer Destroy: Interval := %d',[Interval]));
|
||||
{$endif}
|
||||
remove;
|
||||
//Free;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -48,14 +48,17 @@
|
||||
// X11 options
|
||||
// ==================
|
||||
{$define CD_X11_NewNativePaint}
|
||||
{$define CD_X11_UseLCL_MainLoop}
|
||||
{.$define CD_X11_UseNewTimer}
|
||||
|
||||
// ==================
|
||||
// Debug options
|
||||
// ==================
|
||||
{.$define VerboseCDPaintProfiler}
|
||||
{.$define Verbose_CD_X11_Timer}
|
||||
{.$define CD_Debug_TTF}
|
||||
{.$define VerboseCDDrawing}
|
||||
{ $define VerboseCDBitmap}
|
||||
{ $define VerboseCDForms}
|
||||
{.$define VerboseCDBitmap}
|
||||
{.$define VerboseCDForms}
|
||||
{.$define VerboseCDX11WinAPI}
|
||||
{.$define VerboseCDAccessibility}
|
||||
{ $define CD_Debug_TTF}
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ uses
|
||||
// Platform specific
|
||||
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
|
||||
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaGDIObjects,{$endif}
|
||||
{$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc, contnrs,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
|
||||
{$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc, {contnrs,}{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
|
||||
{$ifdef CD_Android}
|
||||
customdrawn_androidproc, jni, bitmap, log, keycodes,
|
||||
{$endif}
|
||||
@ -166,6 +166,10 @@ type
|
||||
XConnections: TFPList;
|
||||
// Windows Info List
|
||||
XWindowList: TStringList;
|
||||
// Timer queue head
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
XTimerListHead: customdrawn_x11proc.TCDX11Timer;
|
||||
{$endif}
|
||||
|
||||
// Functions to keep track of windows needing repaint
|
||||
function CheckInvalidateWindowForX(XWIndowID: X.TWindow): Boolean;
|
||||
@ -424,7 +428,7 @@ const
|
||||
{$ifdef CD_X11}
|
||||
const
|
||||
CDBackendNativeHandle = nhtX11TWindow;
|
||||
|
||||
fpFD_SETSIZE = 1024; // As defined in deprecated Libc. Large enough for any practical purpose
|
||||
{$define CD_HasNativeFormHandle}
|
||||
{$endif}
|
||||
{$ifdef CD_Cocoa}
|
||||
|
||||
@ -113,6 +113,9 @@ begin
|
||||
|
||||
XConnections := TFPList.Create;
|
||||
XWindowList := TStringList.Create;
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
XTimerListHead := nil;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -202,6 +205,9 @@ procedure TCDWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
|
||||
var
|
||||
DoBreakRun: Boolean = False;
|
||||
begin
|
||||
{$IFDEF CD_X11_UseLCL_MainLoop}
|
||||
Inherited;
|
||||
{$ELSE}
|
||||
while (DoBreakRun = False) do
|
||||
begin
|
||||
if XPending(FDisplay) <= 0 then AppProcessInvalidates();
|
||||
@ -211,6 +217,7 @@ begin
|
||||
DoBreakRun := Application.Terminated;
|
||||
end;
|
||||
DoBreakRun := False;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
(*
|
||||
@ -246,7 +253,6 @@ end;
|
||||
|
||||
Restore minimized whole application from taskbar
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
procedure TCDWidgetSet.AppRestore;
|
||||
begin
|
||||
// Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
|
||||
@ -346,6 +352,9 @@ var
|
||||
Sum: Integer;
|
||||
NewEvent: TXEvent;
|
||||
CurWindowInfo: TX11WindowInfo;
|
||||
{$IFDEF VerboseCDPaintProfiler}
|
||||
lMessageTime: Integer;
|
||||
{$ENDIF}
|
||||
begin
|
||||
XNextEvent(FDisplay, @XEvent);
|
||||
|
||||
@ -438,6 +447,10 @@ begin
|
||||
{$ifdef VerboseCDEvents}
|
||||
DebugLn(Format('X11 event WM_PAINT - Window %d',[CurWindowInfo.Window]));
|
||||
{$endif}
|
||||
{$IFDEF VerboseCDPaintProfiler}
|
||||
lMessageTime:= DateTimeToMilliseconds(Now)-XClientEvent.data.l[1];
|
||||
DebugLn(Format('X11 event WM_PAINT - Window %d, Delay %d ms',[CurWindowInfo.Window,lMessageTime]));
|
||||
{$ENDIF}
|
||||
TCDWSCustomForm.EvPaintEx(WindowEntry, CurWindowInfo);
|
||||
WindowUpdated(CurWindowInfo.Window);
|
||||
end
|
||||
@ -531,23 +544,44 @@ var
|
||||
xconnnum, selectresult: integer;
|
||||
IsFirstTimeout: Boolean;
|
||||
AnyTimerProcessed: Boolean = False;
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
lTimer,lNextTimer: TCDX11Timer;
|
||||
{$else}
|
||||
lTimer: TCDTimer;
|
||||
{$endif}
|
||||
lTimeoutInterval: Integer; // miliseconds
|
||||
i: Integer;
|
||||
begin
|
||||
IsFirstTimeout := True;
|
||||
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
if XTimerListHead = nil then lTimeoutInterval:= -1
|
||||
else begin
|
||||
lTimer := XTimerListHead;
|
||||
lTimeoutInterval:= trunc((lTimer.Expires-now)*KMsToDateTime);
|
||||
if lTimeoutInterval < 0 then lTimeoutInterval:= 0; // we missed a timer: a quick look to
|
||||
// pending messages then go process the timer
|
||||
end;
|
||||
{$else}
|
||||
lTimeoutInterval := GetSmallestTimerInterval();
|
||||
// Limit the maximum interval, even if only to process Application.OnIdle or
|
||||
(*// Limit the maximum interval, even if only to process Application.OnIdle or
|
||||
// for general safety
|
||||
if (lTimeoutInterval < 0) or (lTimeoutInterval >= 1000) then lTimeoutInterval := 1000;
|
||||
// To avoid consuming too much CPU, if the interval is zero, act as if it was 1
|
||||
if lTimeoutInterval = 0 then lTimeoutInterval := 1;
|
||||
if lTimeoutInterval = 0 then lTimeoutInterval := 1;*)
|
||||
|
||||
if lTimeoutInterval < 0 then lTimeoutInterval:= -1 ;// No timers - wait forever
|
||||
{$endif}
|
||||
while not Application.Terminated do
|
||||
begin
|
||||
xconnnum := XConnectionNumber(FDisplay);
|
||||
XFlush(FDisplay);
|
||||
{---------------------------------------------------------------------------
|
||||
We should not call XFlush here to flush the output buffer because:
|
||||
1 - We may throw away unprocessed messages, calling XFlush before XPending
|
||||
2 - XPending already performs a flush of the output buffer
|
||||
so calling XFlush is never required, except in very special cases
|
||||
---------------------------------------------------------------------------}
|
||||
//XFlush(FDisplay);
|
||||
|
||||
if XPending(FDisplay) > 0 then Exit; // We have a X message to process
|
||||
|
||||
@ -561,9 +595,33 @@ begin
|
||||
// Add all other X connections
|
||||
for i := 0 to XConnections.Count-1 do
|
||||
fpFD_SET(cint(PtrInt(XConnections.Items[i])), rfds);
|
||||
{---------------------------------------------------------------------------
|
||||
Using here fpFD_SETSIZE (=1024) ensures that we will get a result for all
|
||||
of our connections selected with fpFD_SET. Connection numbers are assigned
|
||||
in sequence, including connections opened inside the application. Either
|
||||
we keep track of the highest value in XConnections.Items, or we simply
|
||||
use a large value. In old times one had to be more careful because a large
|
||||
value gave a speed penalty, but in modern Unice's it doesn't make a difference.
|
||||
Gnu Linux doesn't set an upper limit for that value,
|
||||
---------------------------------------------------------------------------}
|
||||
selectresult := fpSelect(fpFD_SETSIZE, @rfds, nil, nil, lTimeoutInterval);
|
||||
|
||||
selectresult := fpSelect(xconnnum + 1, @rfds, nil, nil, lTimeoutInterval);
|
||||
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
// Process all timers
|
||||
while (lTimer <> nil) and (lTimer.Expires <= now) do begin
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
Debugln('This Timer %d',[lTimer.Interval]);
|
||||
{$endif}
|
||||
lNextTimer := lTimer.Next;
|
||||
lTimer.Expired;// Exec OnTimer, and readjust list
|
||||
AnyTimerProcessed := True;
|
||||
lTimer := lNextTimer;
|
||||
{$ifdef Verbose_CD_X11_Timer}
|
||||
if (lTimer <> nil) then
|
||||
Debugln('Next Timer %d',[lTimer.Interval]);
|
||||
{$endif}
|
||||
end;
|
||||
{$else}
|
||||
// Process all timers
|
||||
for i := 0 to GetTimerCount()-1 do
|
||||
begin
|
||||
@ -581,8 +639,13 @@ begin
|
||||
lTimer.NativeHandle := 0;
|
||||
end;
|
||||
end;
|
||||
if AnyTimerProcessed then AppProcessInvalidates();
|
||||
|
||||
{$endif}
|
||||
if AnyTimerProcessed then
|
||||
{$IFDEF CD_X11_UseLCL_MainLoop}
|
||||
selectresult:=1;
|
||||
{$ELSE}
|
||||
AppProcessInvalidates();
|
||||
{$ENDIF}
|
||||
if selectresult <> 0 then // We got a X event or the timeout happened
|
||||
Exit
|
||||
else
|
||||
@ -645,6 +708,16 @@ end;
|
||||
The TimerCallBackProc calls the TimerFunc.
|
||||
------------------------------------------------------------------------------}
|
||||
function TCDWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle;
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
var
|
||||
lTimer: TCDX11Timer;
|
||||
begin
|
||||
lTimer := TCDX11Timer.create(Interval,TimerFunc);
|
||||
lTimer.Insert;
|
||||
Result:= THandle(lTimer);
|
||||
end;
|
||||
|
||||
{$else}
|
||||
var
|
||||
lTimer: TCDTimer;
|
||||
begin
|
||||
@ -654,6 +727,7 @@ begin
|
||||
AddTimer(lTimer);
|
||||
Result := THandle(lTimer);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function: DestroyTimer
|
||||
@ -661,6 +735,16 @@ end;
|
||||
Returns:
|
||||
------------------------------------------------------------------------------}
|
||||
function TCDWidgetSet.DestroyTimer(TimerHandle: THandle) : boolean;
|
||||
{$ifdef CD_X11_UseNewTimer}
|
||||
var
|
||||
lTimer: TCDX11Timer absolute TimerHandle;
|
||||
begin
|
||||
if TimerHandle <> 0 then begin
|
||||
lTimer.destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$else}
|
||||
var
|
||||
lTimer: TCDTimer absolute TimerHandle;
|
||||
begin
|
||||
@ -670,6 +754,7 @@ begin
|
||||
lTimer.Free;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
(*
|
||||
procedure TWinCEWidgetSet.HandleWakeMainThread(Sender: TObject);
|
||||
begin
|
||||
|
||||
@ -843,7 +843,7 @@ begin
|
||||
FontPath:= APath+Rslt.Name;
|
||||
|
||||
{$ifdef CD_Debug_TTF}
|
||||
DebugLn(Format('[FontsScanForTTF] font=', [FontPath]));
|
||||
DebugLn(Format('[FontsScanForTTF] font=%s', [FontPath]));
|
||||
{$endif}
|
||||
|
||||
// Work around for fonts which cause errors. See bug 21456
|
||||
|
||||
@ -637,6 +637,7 @@ var
|
||||
Doc: TXMLDocument;
|
||||
lFontDirectories: TStringList;
|
||||
i, j, FontsCount: cint;
|
||||
l: Integer;
|
||||
lXFontPath: PPChar;
|
||||
APath, strTmp: string;
|
||||
XMLFontConfig, XMLDir: TDOMNode;
|
||||
@ -648,9 +649,11 @@ begin
|
||||
lXFontPath := XGetFontPath(FDisplay, @FontsCount);
|
||||
for i:= 0 to FontsCount-1 do begin
|
||||
if Copy(lXFontPath[i],1,10) = 'catalogue:' then
|
||||
APath:= PathDelim + Copy(lXFontPath[0],12,strlen(lXFontPath[0]))+ PathDelim
|
||||
APath:= PathDelim + Copy(lXFontPath[0],12,strlen(lXFontPath[0]))
|
||||
else
|
||||
APath:= lXFontPath[i] + PathDelim;
|
||||
APath:= lXFontPath[i];
|
||||
l:= Length(APath); ;
|
||||
if APath[l] <> PathDelim then APath:= APath+PathDelim;
|
||||
FontsScanDir(APath,AFontPaths,AFontList);
|
||||
end;
|
||||
XFreeFontPath(lXFontPath);
|
||||
@ -3697,17 +3700,18 @@ end;*)
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: GetSystemMetrics
|
||||
Params:
|
||||
Returns: Nothing
|
||||
|
||||
Params: nIndex Integer
|
||||
Returns: Integer
|
||||
|
||||
It returns the value for the System Metric requested in nIndex.
|
||||
SM_.. constants are declared in LCLTypes
|
||||
------------------------------------------------------------------------------}
|
||||
function TCDWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
|
||||
var
|
||||
R: TRect;
|
||||
begin
|
||||
{$ifdef VerboseQtWinAPI}
|
||||
WriteLn(Format('Trace:> [TQtWidgetSet.GetSystemMetrics] %d', [nIndex]));
|
||||
{$ifdef VerboseCDX11WinAPI}
|
||||
WriteLn(Format('Trace:> [TCDWidgetSet.GetSystemMetrics] %d', [nIndex]));
|
||||
{$endif}
|
||||
Result := 0;
|
||||
case nIndex of
|
||||
|
||||
@ -102,11 +102,18 @@ begin
|
||||
lx := APosition.x;
|
||||
ly := APosition.y;
|
||||
|
||||
XTranslateCoordinates(CDWidgetSet.FDisplay, lWindow,
|
||||
{---------------------------------------------------------------------------
|
||||
We must not call XTranslate:
|
||||
if applied to the root window, this makes X crazy, because it attempts
|
||||
to translate the coordinates to themselves.
|
||||
If applied to another window, it's wrong, because window position has already
|
||||
been determined by LCL
|
||||
---------------------------------------------------------------------------}
|
||||
{XTranslateCoordinates(CDWidgetSet.FDisplay, lWindow,
|
||||
XDefaultRootWindow(CDWidgetSet.FDisplay),
|
||||
lx, ly, @dx, @dy, @cw);
|
||||
lx := dx;
|
||||
ly := dy;
|
||||
ly := dy;}
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -630,6 +637,7 @@ var
|
||||
reslt: Integer;
|
||||
{$IFDEF VerboseCDPaintProfiler}
|
||||
lTimeStart, lCDTimeEnd, lNativeTimeStart: TDateTime;
|
||||
lTimeSend: Integer;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF VerboseCDPaintProfiler}
|
||||
@ -677,6 +685,9 @@ begin
|
||||
Event.message_type:= CDWidgetSet.FWMPaint;
|
||||
Event.format:= 32; // Must hold a culong for TXID
|
||||
Event.data.l[0]:= AWindowInfo.Window;
|
||||
{$IFDEF VerboseCDPaintProfiler}
|
||||
Event.data.l[1]:= DateTimeToMilliseconds(Now());
|
||||
{$ENDIF}
|
||||
reslt := XSendEvent(CDWidgetSet.FDisplay,AWindowInfo.Window,{Propagate=}True,0,@Event);
|
||||
// Painting will carried out from main event loop
|
||||
end;
|
||||
@ -700,6 +711,7 @@ class procedure TCDWSCustomForm.EvPaintEx(const AWinControl: TWinControl;
|
||||
var
|
||||
lWidth, lHeight: Integer;
|
||||
lRawImage: TRawImage;
|
||||
reslt: integer;
|
||||
begin
|
||||
lWidth := Round(AWinControl.width);
|
||||
lHeight := Round(AWinControl.height);
|
||||
@ -734,20 +746,32 @@ end;
|
||||
|
||||
class procedure TCDWSCustomForm.EvClientMessage(const AWinControl: TWinControl;
|
||||
AWindowInfo: TX11WindowInfo; var Event: TXClientMessageEvent);
|
||||
var
|
||||
CanClose: Boolean;
|
||||
begin
|
||||
if Event.message_type = CDWidgetset.FWMProtocols then
|
||||
begin
|
||||
if Event.Data.l[0] = CDWidgetset.FWMDeleteWindow then
|
||||
begin
|
||||
// Message results : 0 - do nothing, 1 - destroy window (felipe: is this comment correct? taken from lcl-cocoa)
|
||||
CanClose:=LCLSendCloseQueryMsg(AWinControl)>0;
|
||||
if {CanClose} True then // CanClose is returning false -> ToDo: find out why
|
||||
{--------------------------------------------------------
|
||||
LCLSendCloseQueryMsg sends the message to TCustomForm.WMCloseQuery which
|
||||
performs the close actions (query included) and always returns 0
|
||||
No way to know here if the close action will actually be performed.
|
||||
-----------------------------------------------------------------------}
|
||||
LCLSendCloseQueryMsg(AWinControl);
|
||||
{----------------------------------------------------------------------
|
||||
No need to call LCLSendCloseUpMsg, because the form has already been closed,
|
||||
if allowed by CanClose.
|
||||
We can't ask X to destroy the window, because we don't know if CanClose was
|
||||
true or false. Here we're just told by X that someone tried to close the
|
||||
window, using WM functions. Moreover there are still hanging X events
|
||||
to process. Either we implement AppTerminate, or we take yhe lazy
|
||||
path and let the window be destroyed by the WM when the application terminates.
|
||||
--------------------------------------------------------------------------}
|
||||
(*if {CanClose} True then // CanClose is returning false -> ToDo: find out why
|
||||
begin
|
||||
LCLSendCloseUpMsg(AWinControl);
|
||||
XDestroyWindow(CDWidgetset.FDisplay, AWinControl.Handle);
|
||||
end;
|
||||
end;*)
|
||||
end
|
||||
else
|
||||
DebugLn(Format('LCL-CustomDrawn-X11: Unknown client protocol message: %d', [Event.Data.l[0]]));
|
||||
@ -2700,7 +2724,13 @@ begin
|
||||
{$ifdef VerboseCDForms}
|
||||
DebugLn(Format('[TCDWSCustomForm.ShowHide] Visible=False AWinControl=%x', [PtrInt(AWinControl)]));
|
||||
{$endif}
|
||||
XUnmapWindow(CDWidgetSet.FDisplay, lWindow);
|
||||
// Don't remove it here, wait for a X11 Destroy event
|
||||
{---------------------------------------------------------------------------
|
||||
We will never get an X11 event, if we don't tell X11 to unmap the window!
|
||||
Even if the WM attempts to close the window, it's the application which
|
||||
triggers the actual operation. If CanClose is false, it doesn't do it.
|
||||
---------------------------------------------------------------------------}
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user