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

This is not a feature that is built into the MessageBox class and the message box is always centered over the desktop.  I have found some examples written in C# on how to do this but they run for many lines of code and my C# training is not far enough along to where I can translate them into Visual COBOL.  Has anyone written a routine for this in Visual COBOL ?  Our other option would be to write our own message class or use a third-party control that allows positioning.

Tags:

  • 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.

    CenterMessage.zip
  • 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.

  • Verified Answer

    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