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.
#VisualCOBOLIf 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.
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.
#VisualCOBOLThanks 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.
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.
#VisualCOBOLThe 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