summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/modalforms/modalforms.lpi8
-rw-r--r--prototypes/fpgui2/tests/edittest.lpi8
-rw-r--r--src/corelib/fpgfx.pas1
-rw-r--r--src/corelib/gdi/gfx_gdi.pas365
-rw-r--r--src/corelib/gfxbase.pas5
-rw-r--r--src/gui/gui_form.pas18
6 files changed, 211 insertions, 194 deletions
diff --git a/examples/gui/modalforms/modalforms.lpi b/examples/gui/modalforms/modalforms.lpi
index 4dffc0d7..38db8012 100644
--- a/examples/gui/modalforms/modalforms.lpi
+++ b/examples/gui/modalforms/modalforms.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="/"/>
+ <PathDelim Value="\"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value="./"/>
+ <IconPath Value=".\"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -17,14 +17,13 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
- <IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -43,6 +42,7 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
+ <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi
index 1ecb384f..3a71bafe 100644
--- a/prototypes/fpgui2/tests/edittest.lpi
+++ b/prototypes/fpgui2/tests/edittest.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="/"/>
+ <PathDelim Value="\"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value="./"/>
+ <IconPath Value=".\"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -17,13 +17,14 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
+ <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -42,6 +43,7 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
+ <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 6f8af25f..11845e52 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -455,6 +455,7 @@ begin
FDisplayParams := aparams;
FScreenWidth := -1;
FScreenHeight := -1;
+ TopModalForm := nil;
inherited Create(aparams);
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index a30f343c..eb211bb3 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -174,7 +174,8 @@ implementation
uses
{$Note Remove the dependency on gfx_widget and gfx_form units.}
fpgfx,
- gfx_widget,//, gfx_form;
+ gfx_widget,
+ gui_form, // remove this!!!!!
gfx_UTF8Utils;
var
@@ -321,7 +322,7 @@ begin
if not Assigned(w) then
begin
Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
- Exit;
+ Exit; //==>
end;
blockmsg := False;
@@ -331,38 +332,36 @@ begin
WM_CHAR,
WM_KEYUP,
WM_KEYDOWN:
- begin
- kwg := FindKeyboardFocus;
- if kwg <> nil then
- w := kwg;
+ begin
+ kwg := FindKeyboardFocus;
+ if kwg <> nil then
+ w := kwg;
- msgp.keyboard.shiftstate := GetKeyboardShiftState;
- msgp.keyboard.keycode := VirtKeyToKeycode(wParam);
+ msgp.keyboard.shiftstate := GetKeyboardShiftState;
+ msgp.keyboard.keycode := VirtKeyToKeycode(wParam);
- if uMsg = WM_KEYDOWN then
- begin
- fpgSendMessage(nil, w, FPGM_KEYPRESS, msgp);
+ if uMsg = WM_KEYDOWN then
+ begin
+ fpgSendMessage(nil, w, FPGM_KEYPRESS, msgp);
- // generating WM_CHAR
- fillchar(wmsg, sizeof(wmsg), 0);
+ // generating WM_CHAR
+ fillchar(wmsg, sizeof(wmsg), 0);
- wmsg.hwnd := hwnd;
- wmsg.message := uMsg;
- wmsg.wParam := wParam;
- wmsg.lParam := lParam;
+ wmsg.hwnd := hwnd;
+ wmsg.message := uMsg;
+ wmsg.wParam := wParam;
+ wmsg.lParam := lParam;
- Windows.TranslateMessage(@wmsg);
+ Windows.TranslateMessage(@wmsg);
+ // TranslateMessage sends WM_CHAR ocassionally
+ // but NOBODY KNOWS WHEN!
- // TranslateMessage sends WM_CHAR ocassionally
- // but NOBODY KNOWS WHEN!
-
-
- if (wParam = $2e {VK_DELETE}) then
- begin
- msgp.keyboard.keychar := #127;
- msgp.keyboard.keycode := 0;
- fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
- end;
+ if (wParam = $2e {VK_DELETE}) then
+ begin
+ msgp.keyboard.keychar := #127;
+ msgp.keyboard.keycode := 0;
+ fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
+ end;
// lets generate the FPGM_KEYCHAR for some special keys
// based on this table of Windows virtual keys
@@ -377,16 +376,15 @@ begin
// end;
// end;
- end
- else if uMsg = WM_KEYUP then
- fpgSendMessage(nil, w, FPGM_KEYRELEASE, msgp)
- else if uMsg = WM_CHAR then
- begin
- msgp.keyboard.keychar := Chr(wParam);
- fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
- end;
-
- end;
+ end
+ else if uMsg = WM_KEYUP then
+ fpgSendMessage(nil, w, FPGM_KEYRELEASE, msgp)
+ else if uMsg = WM_CHAR then
+ begin
+ msgp.keyboard.keychar := Chr(wParam);
+ fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp);
+ end;
+ end;
(*
WM_SETCURSOR:
@@ -407,158 +405,169 @@ begin
WM_LBUTTONDBLCLK,
WM_RBUTTONDOWN,
WM_RBUTTONUP:
- begin
- msgp.mouse.x := smallint(lParam and $FFFF);
- msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16);
-
- case uMsg of
- WM_MOUSEMOVE:
- mcode := FPGM_MOUSEMOVE;
- WM_LBUTTONDOWN,
- WM_RBUTTONDOWN:
- mcode := FPGM_MOUSEDOWN;
- WM_LBUTTONUP,
- WM_RBUTTONUP:
- mcode := FPGM_MOUSEUP;
- WM_LBUTTONDBLCLK:
- mcode := FPGM_DOUBLECLICK;
- else
- mcode := 0;
- end;
-
- case uMsg of
- WM_MOUSEMOVE:
begin
- i := 0;
- if (wParam and MK_LBUTTON) <> 0 then
- i := i or MOUSE_LEFT;
- if (wParam and MK_RBUTTON) <> 0 then
- i := i or MOUSE_RIGHT;
- if (wParam and MK_MBUTTON) <> 0 then
- i := i or MOUSE_MIDDLE;
- msgp.mouse.Buttons := i;
+ msgp.mouse.x := smallint(lParam and $FFFF);
+ msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16);
+(*
+ if (wapplication.TopModalForm <> nil) then
+ begin
+ mw := nil;
+ mw := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w)));
+ if (mw <> nil) and (wapplication.TopModalForm <> mw) then
+ blockmsg := True;
+ end;
+*)
+// Writeln('blockmsg ', blockmsg);
+ if not blockmsg then
+ begin
+// writeln(' we are continueing the event processing...');
+ case uMsg of
+ WM_MOUSEMOVE:
+ mcode := FPGM_MOUSEMOVE;
+ WM_LBUTTONDOWN,
+ WM_RBUTTONDOWN:
+ mcode := FPGM_MOUSEDOWN;
+ WM_LBUTTONUP,
+ WM_RBUTTONUP:
+ mcode := FPGM_MOUSEUP;
+ WM_LBUTTONDBLCLK:
+ mcode := FPGM_DOUBLECLICK;
+ else
+ mcode := 0;
+ end;
+
+ case uMsg of
+ WM_MOUSEMOVE:
+ begin
+ i := 0;
+ if (wParam and MK_LBUTTON) <> 0 then
+ i := i or MOUSE_LEFT;
+ if (wParam and MK_RBUTTON) <> 0 then
+ i := i or MOUSE_RIGHT;
+ if (wParam and MK_MBUTTON) <> 0 then
+ i := i or MOUSE_MIDDLE;
+ msgp.mouse.Buttons := i;
+ end;
+
+ WM_LBUTTONDOWN,
+ WM_LBUTTONUP,
+ WM_LBUTTONDBLCLK:
+ msgp.mouse.Buttons := MOUSE_LEFT;
+
+ WM_RBUTTONDOWN,
+ WM_RBUTTONUP:
+ msgp.mouse.Buttons := MOUSE_RIGHT;
+ end;
+
+ msgp.mouse.shiftstate := GetKeyboardShiftState;
+
+ if uMsg = WM_MouseMove then
+ w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam);
+
+ if mcode <> 0 then
+ fpgSendMessage(nil, w, mcode, msgp);
+ end; { if blockmsg }
end;
- WM_LBUTTONDOWN,
- WM_LBUTTONUP,
- WM_LBUTTONDBLCLK:
- msgp.mouse.Buttons := MOUSE_LEFT;
-
- WM_RBUTTONDOWN,
- WM_RBUTTONUP:
- msgp.mouse.Buttons := MOUSE_RIGHT;
- end;
-
- msgp.mouse.shiftstate := GetKeyboardShiftState;
-
- if uMsg = WM_MouseMove then
- w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam);
-
- if mcode <> 0 then
- fpgSendMessage(nil, w, mcode, msgp);
- end;
-
WM_SIZE:
- begin
- // note that WM_SIZING allows some control on sizeing
-
- //writeln('WM_SIZE: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8));
-
- msgp.rect.Width := smallint(lParam and $FFFF);
- msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16);
-
- //writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height);
-
- // skip minimize...
- if lparam <> 0 then
- fpgSendMessage(nil, w, FPGM_RESIZE, msgp);
- end;
-
+ begin
+ // note that WM_SIZING allows some control on sizeing
+ //writeln('WM_SIZE: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8));
+ msgp.rect.Width := smallint(lParam and $FFFF);
+ msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16);
+
+ //writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height);
+ // skip minimize...
+ if lparam <> 0 then
+ fpgSendMessage(nil, w, FPGM_RESIZE, msgp);
+ end;
WM_MOVE:
- begin
- // window decoration correction ...
- if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then
- begin
- GetWindowRect(w.WinHandle, r);
- msgp.rect.Left := r.Left;
- msgp.rect.top := r.Top;
- end
- else
- begin
- msgp.rect.Left := smallint(lParam and $FFFF);
- msgp.rect.Top := smallint((lParam and $FFFF0000) shr 16);
- end;
-
- fpgSendMessage(nil, w, FPGM_MOVE, msgp);
- end;
+ begin
+// writeln('WM_MOVE');
+ // window decoration correction ...
+ if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then
+ begin
+ GetWindowRect(w.WinHandle, r);
+ msgp.rect.Left := r.Left;
+ msgp.rect.top := r.Top;
+ end
+ else
+ begin
+ msgp.rect.Left := smallint(lParam and $FFFF);
+ msgp.rect.Top := smallint((lParam and $FFFF0000) shr 16);
+ end;
+
+ fpgSendMessage(nil, w, FPGM_MOVE, msgp);
+ end;
WM_MOUSEWHEEL:
- begin
- //writeln('MWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); // and $FF00) shr 8);
- pt.x := LoWord(lparam);
- pt.y := HiWord(lparam);
- mw := nil;
- h := WindowFromPoint(pt);
- if h > 0 then // get window mouse is hovering over
- mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA));
-
- if mw <> nil then
- begin
- msgp.mouse.x := pt.x;
- msgp.mouse.y := pt.y;
- msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120;
-
- i := 0;
- if (wParam and MK_LBUTTON) <> 0 then
- i := i or MOUSE_LEFT;
- if (wParam and MK_RBUTTON) <> 0 then
- i := i or MOUSE_RIGHT;
- if (wParam and MK_MBUTTON) <> 0 then
- i := i or MOUSE_MIDDLE;
- msgp.mouse.Buttons := i;
- msgp.mouse.shiftstate := GetKeyboardShiftState;
-
- fpgSendMessage(nil, mw, FPGM_SCROLL, msgp)
- end;
- end;
+ begin
+// writeln('WM_MOUSEWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); // and $FF00) shr 8);
+ pt.x := LoWord(lparam);
+ pt.y := HiWord(lparam);
+ mw := nil;
+ h := WindowFromPoint(pt);
+ if h > 0 then // get window mouse is hovering over
+ mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA));
+
+ if mw <> nil then
+ begin
+ msgp.mouse.x := pt.x;
+ msgp.mouse.y := pt.y;
+ msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120;
+
+ i := 0;
+ if (wParam and MK_LBUTTON) <> 0 then
+ i := i or MOUSE_LEFT;
+ if (wParam and MK_RBUTTON) <> 0 then
+ i := i or MOUSE_RIGHT;
+ if (wParam and MK_MBUTTON) <> 0 then
+ i := i or MOUSE_MIDDLE;
+ msgp.mouse.Buttons := i;
+ msgp.mouse.shiftstate := GetKeyboardShiftState;
+
+ fpgSendMessage(nil, mw, FPGM_SCROLL, msgp)
+ end;
+ end;
WM_ACTIVATE:
- if ((wParam and $FFFF) = WA_INACTIVE) then
- fpgSendMessage(nil, w, FPGM_DEACTIVATE)
- else
- fpgSendMessage(nil, w, FPGM_ACTIVATE);
+ begin
+// writeln('WM_ACTIVATE');
+ if ((wParam and $FFFF) = WA_INACTIVE) then
+ fpgSendMessage(nil, w, FPGM_DEACTIVATE)
+ else
+ fpgSendMessage(nil, w, FPGM_ACTIVATE);
+ end;
WM_TIMER:
- Result := 0;
- //Writeln('TIMER EVENT!!!');
- // used for event wait timeout
-
+ begin
+// writeln('WM_TIMER'); // used for event wait timeout
+ Result := 0;
+ end;
- (*
WM_NCACTIVATE:
- begin
- if (ptkTopModalForm <> nil) then
- begin
- if (wParam = 0) and (ptkTopModalForm = wg) then
begin
- blockmsg := true;
- end
- else if (wParam <> 0) and (ptkTopModalForm <> wg) then
- begin
- blockmsg := true;
+// writeln('WM_NCACTIVATE');
+ if (wapplication.TopModalForm <> nil) then
+ begin
+ if (wParam = 0) and (wapplication.TopModalForm = w) then
+ begin
+ blockmsg := true;
+ end
+ else if (wParam <> 0) and (wapplication.TopModalForm <> w) then
+ begin
+ blockmsg := true;
+ end;
+ end;
+
+ {$Note Complete this!}
+// if (PopupListFirst <> nil) and (PopupListFirst.Visible) then
+// blockmsg := True;
+
+ if not blockmsg then
+ Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
- end;
-
- if (PopupListFirst <> nil) and (PopupListFirst.Visible) then BlockMsg := True;
-
- //writeln('ncactivate: ', ord(BlockMsg));
-
- if not BlockMsg then
- Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
-
- end;
-*)
WM_CLOSE:
fpgSendMessage(nil, w, FPGM_CLOSE, msgp);
@@ -616,7 +625,7 @@ begin
hcr_CROSSHAIR := LoadCursor(0, IDC_CROSS);
FIsInitialized := True;
- wapplication := TfpgApplication(self);
+ wapplication := TfpgApplication(self);
end;
function TfpgApplicationImpl.DoMessagesPending: boolean;
@@ -759,7 +768,7 @@ var
r: TRect;
begin
if FWinHandle > 0 then
- Exit;
+ Exit; //==>
FWinStyle := WS_OVERLAPPEDWINDOW;
FWinStyleEx := WS_EX_APPWINDOW;
@@ -842,7 +851,8 @@ begin
DoMoveWindow(FLeft, FTop);
end;
- SetWindowParameters; // the forms require some adjustments before the Window appears
+ // the forms require some adjustments before the Window appears
+ SetWindowParameters;
BringWindowToTop(FWinHandle);
@@ -859,6 +869,7 @@ begin
FTop := r.Top;
end;
+ // send the first paint message
Windows.UpdateWindow(FWinHandle);
end;
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index efc06cac..43f6bdfb 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -342,12 +342,17 @@ 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/gui/gui_form.pas b/src/gui/gui_form.pas
index c839492b..e45d856b 100644
--- a/src/gui/gui_form.pas
+++ b/src/gui/gui_form.pas
@@ -24,7 +24,7 @@ type
FOnHide: TNotifyEvent;
FOnShow: TNotifyEvent;
protected
- FPrevModalForm: TfpgForm;
+ FPrevModalForm: TfpgWindowBase;
FModalResult: integer;
FParentForm: TfpgForm;
FWindowPosition: TWindowPosition;
@@ -70,7 +70,6 @@ var
// Don't like this. It's a bit of a hack. Possibly move this into
// fpgApplication, but do we want fpgApplication to have that dependency??
fpgMainForm: TfpgForm;
- fpgTopModalForm: TfpgForm;
function WidgetParentForm(wg: TfpgWidget): TfpgForm;
@@ -90,7 +89,7 @@ begin
if w is TfpgForm then
begin
Result := TfpgForm(w);
- Exit;
+ Exit; //==>
end;
w := w.Parent;
end;
@@ -107,7 +106,7 @@ end;
procedure TfpgForm.MsgActivate(var msg: TfpgMessageRec);
begin
- if (fpgTopModalForm = nil) or (fpgTopModalForm = self) then
+ if (fpgApplication.TopModalForm = nil) or (fpgApplication.TopModalForm = self) then
begin
FocusRootWidget := self;
if ActiveWidget = nil then
@@ -190,8 +189,8 @@ end;
function TfpgForm.ShowModal: integer;
begin
- FPrevModalForm := fpgTopModalForm;
- fpgTopModalForm := self;
+ FPrevModalForm := fpgApplication.TopModalForm;
+ fpgApplication.TopModalForm := self;
ModalResult := 0;
Show;
@@ -202,7 +201,7 @@ begin
fpgWaitWindowMessage;
until (ModalResult <> 0) or (not Visible);
- fpgTopModalForm := FPrevModalForm;
+ fpgApplication.TopModalForm := FPrevModalForm;
Result := ModalResult;
end;
@@ -248,8 +247,8 @@ end;
procedure TfpgForm.Hide;
begin
- if (fpgTopModalForm = self) then
- fpgTopModalForm := self.FPrevModalForm;
+ if (fpgApplication.TopModalForm = self) then
+ fpgApplication.TopModalForm := FPrevModalForm;
HandleHide;
if ModalResult = 0 then
ModalResult := -1;
@@ -264,7 +263,6 @@ end;
initialization
fpgMainForm := nil;
- fpgTopModalForm := nil;
end.
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-14 21:43:08 +0000