* Move some modal form requirements as global variable to properties

  inside the TfpgApplication class.
* Minor improvements to the modal form workings under Windows. Still
  not 100%, but better.

4 files changed, 202 insertions, 187 deletions

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.