summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/gdi/gfx_gdi.pas47
-rw-r--r--src/corelib/gfx_widget.pas3
-rw-r--r--src/corelib/gfxbase.pas6
-rw-r--r--src/corelib/x11/gfx_x11.pas61
4 files changed, 74 insertions, 43 deletions
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index eb211bb3..dca5ce15 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -127,6 +127,7 @@ type
FParentWinHandle: TfpgWinHandle;
procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override;
procedure DoReleaseWindowHandle; override;
+ procedure DoSetWindowVisible(const AValue: Boolean); override;
function HandleIsValid: boolean; override;
procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override;
procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override;
@@ -853,24 +854,6 @@ begin
// the forms require some adjustments before the Window appears
SetWindowParameters;
-
- BringWindowToTop(FWinHandle);
-
- if FWindowType in [wtPopup] then
- Windows.ShowWindow(FWinHandle, SW_SHOWNOACTIVATE)
- else
- Windows.ShowWindow(FWinHandle, SW_SHOWNORMAL);
-
- if (waAutoPos in FWindowAttributes) or
- (waScreenCenterPos in FWindowAttributes) then
- begin
- GetWindowRect(FWinHandle, r);
- FLeft := r.Left;
- FTop := r.Top;
- end;
-
- // send the first paint message
- Windows.UpdateWindow(FWinHandle);
end;
procedure TfpgWindowImpl.DoReleaseWindowHandle;
@@ -881,6 +864,34 @@ begin
FWinHandle := 0;
end;
+procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean);
+var
+ r: TRect;
+begin
+ if AValue then begin
+ BringWindowToTop(FWinHandle);
+
+ if FWindowType in [wtPopup] then
+ Windows.ShowWindow(FWinHandle, SW_SHOWNOACTIVATE)
+ else
+ Windows.ShowWindow(FWinHandle, SW_SHOWNORMAL);
+
+ if (waAutoPos in FWindowAttributes) or
+ (waScreenCenterPos in FWindowAttributes) then
+ begin
+ GetWindowRect(FWinHandle, r);
+ FLeft := r.Left;
+ FTop := r.Top;
+ end;
+
+ Windows.UpdateWindow(FWinHandle);
+ end
+ else begin
+ Windows.ShowWindow(FWinHandle, SW_HIDE);
+ end;
+
+end;
+
procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord);
begin
if HandleIsValid then
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index 5cb5281d..dcb4a133 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -364,7 +364,8 @@ begin
if FVisible then
begin
AllocateWindowHandle;
-
+ DoSetWindowVisible(True);
+
for n := 0 to ComponentCount - 1 do
begin
c := Components[n];
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 5687daf9..0d85a642 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -307,6 +307,7 @@ type
procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual; abstract;
procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); virtual; abstract;
procedure DoReleaseWindowHandle; virtual; abstract;
+ procedure DoSetWindowVisible(const AValue: Boolean); virtual; abstract;
procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); virtual; abstract;
function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; virtual; abstract;
procedure DoSetWindowTitle(const ATitle: string); virtual; abstract;
@@ -342,17 +343,12 @@ type
end;
- { TfpgApplicationBase }
-
TfpgApplicationBase = class(TObject)
- private
- FTopModalForm: TfpgWindowBase;
protected
FIsInitialized: Boolean;
public
constructor Create(const AParams: string); virtual; abstract;
property IsInitialized: boolean read FIsInitialized;
- property TopModalForm: TfpgWindowBase read FTopModalForm write FTopModalForm;
end;
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 0a763d63..53b8c12c 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -41,6 +41,11 @@ type
end;
type
+
+ TXWindowStateFlag = (xwsfMapped);
+
+ TXWindowStateFlags = set of TXWindowStateFlag;
+
TfpgWindowImpl = class;
@@ -121,10 +126,12 @@ type
TfpgWindowImpl = class(TfpgWindowBase)
protected
+ FWinFlags : TXWindowStateFlags;
FWinHandle: TfpgWinHandle;
FModalForWin: TfpgWindowImpl;
procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override;
procedure DoReleaseWindowHandle; override;
+ procedure DoSetWindowVisible(const AValue: Boolean); override;
function HandleIsValid: boolean; override;
procedure DoSetWindowTitle(const ATitle: string); override;
procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override;
@@ -610,20 +617,15 @@ begin
xfd := XConnectionNumber(display);
repeat
- if (atimeoutms >= 0) and (XPending(display) <= 0) then
+ if (atimeoutms > 0) and (XPending(display) <= 0) then
begin
// waiting some event for the given timeout
// this Select handles only the first 256 file descriptors
// poll would be better but FPC has no official poll interface (if I'm right)
- if atimeoutms > 0 then
- begin
- fpFD_ZERO(rfds);
- fpFD_SET(xfd, rfds);
- r := fpSelect(xfd + 1, @rfds, nil, nil, atimeoutms);
- end
- else
- r := 0;
+ fpFD_ZERO(rfds);
+ fpFD_SET(xfd, rfds);
+ r := fpSelect(xfd + 1, @rfds, nil, nil, atimeoutms);
if r <= 0 then
Exit; // no event received.
@@ -689,11 +691,11 @@ begin
msgp.mouse.shiftstate := ConvertShiftState(ev.xbutton.state);
w := FindWindowByHandle(ev.xbutton.window);
- if xapplication.TopModalForm <> nil then
+ if fpgTopModalForm <> nil then
begin
// This is ugly!!!!!!!!!!!!!!!
ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
- if (ew <> nil) and (xapplication.TopModalForm <> ew) then
+ if (ew <> nil) and (fpgTopModalForm <> ew) then
blockmsg := true;
end;
@@ -756,11 +758,11 @@ begin
until not XCheckTypedWindowEvent(display, ev.xbutton.window, X.MotionNotify, @ev);
w := FindWindowByHandle(ev.xany.window);
- if xapplication.TopModalForm <> nil then
+ if fpgTopModalForm <> nil then
begin
// This is ugly!!!!!!!!!!!!!!!
ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
- if (ew <> nil) and (xapplication.TopModalForm <> ew) then
+ if (ew <> nil) and (fpgTopModalForm <> ew) then
blockmsg := true;
end;
@@ -778,11 +780,11 @@ begin
X.ClientMessage:
begin
w := FindWindowByHandle(ev.xany.window);
- if xapplication.TopModalForm <> nil then
+ if fpgTopModalForm <> nil then
begin
// This is ugly!!!!!!!!!!!!!!!
ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
- if (ew <> nil) and (xapplication.TopModalForm <> ew) then
+ if (ew <> nil) and (fpgTopModalForm <> ew) then
blockmsg := true;
end;
@@ -848,11 +850,19 @@ begin
X.LeaveNotify:
fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_MOUSEEXIT);
- { We handle these two event manually in the TfpgForm class }
- X.MapNotify,
+ X.MapNotify:
+ begin
+ w := FindWindowByHandle(ev.xmap.window);
+ if w <> nil then begin
+ Include(w.FWinFlags, xwsfMapped);
+ end;
+ end;
X.UnmapNotify:
begin
- //Writeln('UnmapNotify');
+ w := FindWindowByHandle(ev.xunmap.window);
+ if w <> nil then begin
+ Exclude(w.FWinFlags, xwsfMapped);
+ end;
end;
{ We handle this event manually as well. }
@@ -987,7 +997,7 @@ begin
StructureNotifyMask);
SetWindowParameters;
- XMapWindow(xapplication.Display, wh);
+
AddWindowLookup(self);
end;
@@ -1002,6 +1012,19 @@ begin
FWinHandle := 0;
end;
+procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean);
+begin
+ if AValue then begin
+ if not HandleIsValid then AllocateWindowHandle;
+ XMapWindow(xapplication.Display, FWinHandle);
+ Include(FWinFlags, xwsfMapped);
+ end
+ else begin
+ if HandleIsValid and (xwsfMapped in FWinFlags) then
+ XUnmapWindow(xapplication.Display, FWinHandle);
+ end;
+end;
+
function TfpgWindowImpl.HandleIsValid: boolean;
begin
Result := (FWinHandle > 0);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 05:57:49 +0000