Is there a way to center the message box over the current form ?

If you find a useful example written in C# or VB.NET it is not a requirement that you rewrite it in COBOL in order to use the code from within a Visual COBOL application.

I have attached a solution here which uses a main Windows Form application written in Visual COBOL which can use a class called MessageBoxEx which will do the centering of the MessageBox window. The solution contains a project called MsgBoxcs which is a C# project containing the original source code to an example found and a project called MsgBox which is a COBOL converted version of the same program.

I have done the conversion here to show you that there is no difference in calling the C# project and the Visual COBOL project. The solution is setup by default to call the COBOL project as there is a project reference to MsgBox within the References folder for CenterMessage.

If you wish to use the C# version instead then simply remove the reference to MsgBox and add a reference to MsgBoxcs.

This example also shows how to use new Visual COBOL syntax to handle ValueTypes (structs), Delegates, Enums and P/Invokes.

Visual COBOL version of MessageBoxEx:

     $set ilusing"System"
     $set ilusing"System.Windows.Forms"
     $set ilusing"System.Text"
     $set ilusing"System.Drawing"
     $set ilusing"System.Runtime.InteropServices"
     $set preservecase
      class-id MessageBoxEx.    
      special-names.
         call-convention 66 is winapi.
      working-storage section.
      01 _owner type IWin32Window static.
      01 _hookProc type HookProc static.
      01 _hHook type IntPtr static.  
      78 WH_CALLWNDPROCRET value 12.
      method-id Show static public.
      local-storage section.
      procedure division using mytext as string
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext)
          goback.          
      end method.
      method-id Show static public.
      procedure division using mytext as string caption as string
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext, caption)
          goback.          
      end method.
      method-id Show static public.
      procedure division using mytext as string, caption as string, buttons as type MessageBoxButtons
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext, caption, buttons)
          goback.          
      end method.
      method-id Show static public.
      procedure division using mytext as string, caption as string,
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext, caption, buttons, icon)
          goback.          
      end method.
      method-id Show static public.
      procedure division using mytext as string, caption as string,
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                               defButton as type MessageBoxDefaultButton
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext, caption, buttons, icon, defButton)
          goback.          
      end method.
      method-id Show static public.
      procedure division using mytext as string, caption as string,
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                               defButton as type MessageBoxDefaultButton, options as type MessageBoxOptions
                         returning dr as type DialogResult.
          invoke self::InitializeIt
          set dr to type MessageBox::Show(mytext, caption, buttons, icon, defButton, options)
          goback.          
      end method.
      method-id Show static public.
      procedure division using by value owner as type IWin32Window, mytext as string
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext)
          goback.
      end method.
      method-id Show static public.
      procedure division using owner as type IWin32Window, mytext as string, caption as string
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext, caption)
          goback.
      end method.
      method-id Show static public.
      procedure division using owner as type IWin32Window, mytext as string, caption as string
                               buttons as type MessageBoxButtons
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext, caption, buttons)
          goback.
      end method.
      method-id Show static public.
      procedure division using owner as type IWin32Window, mytext as string, caption as string
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext, caption, buttons, icon)
          goback.
      end method.
      method-id Show static public.
      procedure division using owner as type IWin32Window, mytext as string, caption as string
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                               defButton as type MessageBoxDefaultButton
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext, caption, buttons, icon, defButton)
          goback.
      end method.
      method-id Show static public.
      procedure division using owner as type IWin32Window, mytext as string, caption as string
                               buttons as type MessageBoxButtons, icon as type MessageBoxIcon
                               defButton as type MessageBoxDefaultButton, options as type MessageBoxOptions
                         returning dr as type DialogResult.
          set _owner to owner
          invoke self::InitializeIt
          set dr to type MessageBox::Show(owner, mytext, caption, buttons, icon, defButton, options)
          goback.
      end method.
      method-id new public static.
      procedure division.
          set _hookProc to new HookProc(self::MessageBoxHookProc)
          set _hHook to type IntPtr::Zero
          goback.
      end method.
      method-id InitializeIt private static.
      01 threadid binary-long.
      procedure division.
          if _hHook not = type IntPtr::Zero
             raise new NotSupportedException("multiple calls are not supported")
          end-if  
          if _owner not = null
             set threadid to type AppDomain::GetCurrentThreadId
             call winapi "SetWindowsHookExA" using by value WH_CALLWNDPROCRET size 4
                                                  by value _hookProc
                                                  by value 0
                                                  by value threadid
                                            returning _hHook
             end-call
          end-if
          goback.
      end method.
      method-id MessageBoxHookProc private static.
      01 msg type CWPRETSTRUCT.
      01 hook type IntPtr.
      01 hptr type IntPtr.
      procedure division using by value nCode as binary-long, wParam as type IntPtr, lParam as type IntPtr
                         returning myret as type IntPtr.
          if nCode < 0
              call winapi "CallNextHookEx" using by value _hHook
                                                 by value nCode
                                                 by value wParam
                                                 by value lParam
                                           returning myret
              end-call
              goback
          end-if
          set msg to type Marshal::PtrToStructure(lParam, type of CWPRETSTRUCT) as type CWPRETSTRUCT
          set hook to _hHook
          if msg::message1 = type CbtHookAction::HCBT_ACTIVATE as binary-long
             try
               set hptr to msg::hwnd
               invoke self::myCenterWindow(hptr)
             finally
                call winapi "UnhookWindowsHookEx" using by value _hHook
                set _hHook to type IntPtr::Zero
             end-try
          end-if
          call winapi "CallNextHookEx" using by value hook
                                             by value nCode
                                             by value wParam
                                             by value lParam
                                       returning myret
          end-call
          goback
      end method.
      method-id myCenterWindow private static.
      01 recChild type Rectangle.
      01 success  condition-value.
      01 width binary-long.
      01 height binary-long.
      01 recParent type Rectangle.
      01 ptCenter type Point.
      01 ptStart type Point.
      01 result binary-long.
      01 ownhandle type IntPtr.
      01 xpoint binary-long.
      01 ypoint binary-long.
      procedure division using by value hChildWnd as type IntPtr.
          set recChild to new Rectangle(0, 0, 0, 0)
          call winapi "GetWindowRect" using by value hChildWnd
                                            by reference recChild
                                      returning success
          end-call
          set width to recChild::Width - recChild::X
          set height to recChild::Height - recChild::Y
          set recParent to new Rectangle(0, 0, 0, 0)
          set ownhandle to _owner::Handle
          call winapi "GetWindowRect" using by value ownhandle
                                            by reference recParent
                                      returning success
          end-call
          set ptCenter to new Point(0, 0)
          set ptCenter::X to recParent::X ((recParent::Width - recParent::X) / 2)
          set ptCenter::Y to recParent::Y ((recParent::Height - recParent::Y) / 2)
          set ptStart to new Point(0, 0)
          set ptStart::X to (ptCenter::X - (width / 2))
          set ptStart::Y to (ptCenter::Y - (height / 2))
          if ptStart::X < 0
             set ptStart::X to 0
          end-if
          if ptStart::Y < 0
             set ptStart::Y to 0
          end-if
          set xpoint to ptStart::X
          set ypoint to ptStart::Y
          call winapi "MoveWindow" using by value hChildWnd
                                         by value xpoint
                                         by value ypoint
                                         by value width
                                         by value height
                                         by value false
                                   returning result
          end-call
          goback.
      end method.
      end class.

      valuetype-id CWPRETSTRUCT.
      01 lResult type IntPtr public.
      01 lParam type IntPtr public.
      01 wParam type IntPtr public.
      01 message1 binary-long unsigned public.
      01 hwnd type IntPtr public.
      method-id new.
      procedure division using by value _lResult as type IntPtr,
                                 _lParam as type IntPtr,
                                 _wParam as type IntPtr,
                                 _message1 as binary-long unsigned,
                                 _hwnd as type IntPtr.
          set lResult to _lResult
          set lParam to _lParam
          set wParam to _wParam
          set message1 to _message1
          set hwnd to _hwnd
      end method.
      end valuetype.

      delegate-id HookProc.
      procedure division using by value nCode as binary-long, wParam as type IntPtr, lParam as type IntPtr
                         returning myret as type IntPtr.
      end delegate.

      delegate-id TimerProc.
      procedure division using hWnd as type IntPtr, uMsg as binary-long unsigned,
                               nIDEvent as type UIntPtr, dwTime as binary-long unsigned.
      end delegate.

      enum-id CbtHookAction public.
      working-storage section.
      01 binary-long unsigned.
      78 HCBT_MOVESIZE value 0.
      78 HCBT_MINMAX value 1.
      78 HCBT_QS value 2.
      78 HCBT_CREATEWND value 3.
      78 HCBT_DESTROYWND value 4.
      78 HCBT_ACTIVATE value 5.
      78 HCBT_CLICKSKIPPED value 6.
      78 HCBT_KEYSKIPPED value 7.
      78 HCBT_SYSCOMMAND value 8.
      78 HCBT_SETFOCUS value 9.
      end enum.

Thanks for the solution!  I can center messages now over my forms.

Maybe this isn't something we need to worry about but when I build the C# project I get a warning that System.AppDomain.GetCurrentThreadId is obsolete and has been deprecated because it does not provide a stable id when managed threads are running on fibers (lightweight threads).  I get a similar warning when I build the COBOL MsgBox project.

In the COBOL project, the line giving the error is:

set threadid to type AppDomain::GetCurrentThreadId

I replaced this with:

set threadid to type System.Threading.Thread::CurrentThread::ManagedThreadId

but this always returns a threadid = 1 and it does not center the message box.

I'm not sure if we need to get ManagedThreadId working or if we should just use GetCurrentThreadId.

The ManagedThreadId will not work with this approach as it is strictly a managed solution and we are passing the threadId to native code at this point.

From what I have read, you should be able to use GetCurrentThreadId without a problem.

You could also try the following if your application is running on a single thread:

   set threadid to type Process::GetCurrentProcess::Threads[0]::Id

Thanks