Tuesday, July 08, 2008

Centering / Customize VFP MessageBox in any Form

As you know, by default, VFP MessageBox() is always centered in VFP Main Screen You might have noticed that if we resize VFP Screen, the MessageBox() no longer centered in VFP Main Screen. So, looks like it is centered in the desktop, but not quite centered too. Now, that is bad.

Years ago when I still use VFP6, I used Timer() object, to re-positioning VFP MessageBox, but it's quite an ugly solution, especially on a slow computer. I can still see the window moving right before my eyes. So the best solution is to use FLL/DLL and use windows hook.

Until recently I still see so many VFP developer out there, still questioning the same old question. Such as re-position the MessageBox, changing the Button caption, etc. For some people it's simply create your own custom form and design the form to look similar with MessageBox. Or you can even design a much more nice looking dialog. However there are some behavior that make it different with MessageBox behavior. So again, FLL/DLL is the best solution.

Now, I'm not going to talk about making the FLL. There are several FLL already exist out there for this purposes. You can find it in UniversalThread download area, or goto Craig Boyd homepage. But here, I will show you how to customize VFP MessageBox using BINDEVENT(). This solution is quite nice actually :)

Let's dig into Windows Messages first. You can use a tools such SPY++ to discover this message. Notice that everytime the MessageBox is called, there is a WM_ACTIVATE message sent to VFP. This message is sent twice, the first one is to let VFP aware, that VFP is about to be deactivated, WPARAM = 0. This is our best chance. So you can Bind the WM_ACTIVATE and look for WParam equal to 0. One more thing is, the HWND parameter is actually the VFP.HWND (or Form.hWnd). But the LPARAM contained the HWND to the new window which just about to be activated. Now we can wrap this up. The class can center other dialog too, such as InputBox(). Just try and experiment with the class. Enjoy!

Local lo_MsgBox

lo_MsgBox = CreateObject( 'cls_MessageBox' )
?lo_MsgBox.ShowMsg( 'Test MessageBox', 64, 'MessageBox Title' )

lo_MsgBox.lChangeButton = .T. && Change MessageBox Button
lo_MsgBox.aButtons[1] = '&Good' && 1st button
?lo_MsgBox.ShowMsg( 'Test MessageBox', 64, 'MessageBox Title' )

**** Uncomment the line below and change myForm to any form you wanted the MessageBox to display
** lo_MsgBox.hWnd = myForm.hWnd && center MessageBox in myForm
lo_MsgBox.lTransparent = .T. && transparent MessageBox
lo_MsgBox.nTransValue = 85 && 85% transparent
lo_MsgBox.aButtons[2] = '&Bad' && 2nd button
lo_MsgBox.aButtons[3] = '&Worst' && 3rd button
?lo_MsgBox.ShowMsg( 'Test MessageBox', 64+2, 'MessageBox Title' )

?lo_MsgBox.ShowMsg( 'Test MessageBox With Timer (5sec)', 64+2, 'MessageBox Title', 5000 )

?lo_MsgBox.ShowMsg( 'Test MessageBox with TimeOut (5sec)', 273, 'MessageBox Title', 5000 )
lo_MsgBox = Null
Release lo_MsgBox


*** Updated : timer is working correctly

Define class cls_MessageBox as Custom

#Define WM_TIMER  0x0113
#Define IDT_TIMER 1

hWnd = 0

hWnd_MsgBox = 0
pOrgProc = 0

lChangeButton = .F.
lTransparent = .F.

nTimeout = 0
lTimeout = .F.
nTransValue = 100 && in percentage, 100% = opaque

Dimension aButtons[3] = .F.

Procedure Init
Declare Long SetLayeredWindowAttributes in User32 ;
Long nhWnd, Long crKey, Short bAlpha, Long dwFlags

Declare Long GetDesktopWindow in User32

Declare Long GetWindowLong in User32 ;
Long nhWnd, Integer nIndex

Declare Long SetWindowLong in User32 ;
Long nhWnd, Integer nIndex, Long dwNewLong

Declare Long GetWindowRect in User32 ;
Long nhWnd, String @O_lpRect

Declare Long SetWindowPos in User32 ;
Long nhWnd, Long hWndInsertAfter, ;
Integer nX, Integer nY, Integer nWidth, Integer nHeight, Long nFlags

Declare Long CallWindowProc in User32 ;
Long lpPrevWndFunc, Long nhWnd, ;
Long uMsg, Long wParam, Long lParam

Declare Long FindWindowEx in User32 ;
Long hWndParent, Long hWndChildAfter, ;
String lpszClass, String lpszWindow

Declare Long SendMessage in User32 as SendMessageStr ;
Long nhWnd, Long uMsg, Long wParam, String @lParam

Declare Long SetTimer in User32 ;
Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc

Declare Long KillTimer in User32 Long nhWnd, Long nEventId

This.hWnd = iif( (VarType( th_Wnd )== 'N'), ;
iif( th_Wnd != 0, th_Wnd, GetDesktopWindow() ), _VFP.hWnd )
This.pOrgProc = GetWindowLong( _VFP.hWnd, -4 )

Procedure ShowMsg( tc_Msg, tn_Type, tc_Title, tn_Timeout )

Local ln_Return

If (varType( tn_Timeout ) == 'N')
This.nTimeout = iif( tn_Timeout < 1000, 1000, tn_Timeout )
BindEvent( 0, 0x06, This, 'WndProc' )
If (VarType( tc_Title ) == 'C')
ln_Return = MessageBox( tc_Msg, tn_Type, tc_Title )
ln_Return = MessageBox( tc_Msg, tn_Type )
UnBindEvents( 0, 0x06 )

If (This.nTimeout > 0)
If ( This.lTimeout )
ln_Return = -1
KillTimer( This.hWnd_MsgBox, IDT_TIMER )
UnBindEvents( This.hWnd_MsgBox, IDT_TIMER )
KillTimer( This.hWnd, IDT_TIMER )
UnBindEvents( This.hWnd, IDT_TIMER )

Store 0 to This.nTimeout, This.hWnd_MsgBox
This.lTimeout = .F.
Return ln_Return

Procedure CenterWindow( th_WndParent, th_WndChild )
Local ls_Rect

ls_Rect = space( 16 )
** Get container area (parent)
GetWindowRect( th_WndParent, @ls_Rect )
ln_TargetLeft = CToBin( substr( ls_Rect, 1, 4 ), '4rs' )
ln_TargetTop = CToBin( substr( ls_Rect, 5, 4 ), '4rs' )
ln_Right = CToBin( substr( ls_Rect, 9, 4 ), '4rs' ) + 1
ln_Bottom = CToBin( substr( ls_Rect, 13, 4 ), '4rs' ) + 1
ln_Width = ln_Right - ln_TargetLeft
ln_Height = ln_Bottom - ln_TargetTop

** Get contained area (child)
GetWindowRect( th_WndChild, @ls_Rect )
ln_Left = CToBin( substr( ls_Rect, 1, 4 ), '4rs' )
ln_Top = CToBin( substr( ls_Rect, 5, 4 ), '4rs' )
ln_Right = CToBin( substr( ls_Rect, 9, 4 ), '4rs' ) + 1
ln_Bottom = CToBin( substr( ls_Rect, 13, 4 ), '4rs' ) + 1

** Get Left & Top position (XY coordinate)
ln_Left = ((ln_Width - (ln_Right - ln_Left)) / 2) + ln_TargetLeft
ln_Top = (ln_Height - (ln_Bottom - ln_Top)) / 2 + ln_TargetTop
SetWindowPos( th_WndChild, 0, ln_Left,ln_Top, 0,0, BitOr( 0x1, 0x10, 0x400 ))

Procedure WndProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
If (tn_Msg == 0x06) and (t_wParam == 0)
Local ln_X, lh_Wnd, lh_WndChild, ln_OldStyle, ln_Transparent

If (This.nTimeout > 0)
This.hWnd_MsgBox = t_lParam
BindEvent( th_Wnd, WM_TIMER, This, 'TimerProc' )
SetTimer( th_Wnd, IDT_TIMER, This.nTimeOut-60, 0 )
This.nTimeout = 200

With This
.CenterWindow( .hWnd, t_lParam )

If ( .lChangeButton )
lh_WndChild = 0
For ln_X = 1 to 3
lh_WndChild = FindWindowEx( t_lParam, lh_WndChild, 'Button', 0 )
If (lh_WndChild == 0)
ln_X = 4
If !empty( .aButtons[ ln_X ] )
SendMessageStr( lh_WndChild, 0x0C, 0, .aButtons[ ln_X ] )

If ( .lTransparent ) and (.nTransValue > 0)
ln_Transparent = int((255 * This.nTransValue) / 100)
SetWindowLong( t_lParam, -20, ;
BitOr( GetWindowLong( t_lParam, -20 ), 0x80000 ))
SetLayeredWindowAttributes( t_lParam, 0, ln_Transparent, 2 )

Return 0

Return CallWindowProc( This.pOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )

Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
KillTimer( th_Wnd, IDT_TIMER)
UnBindEvents( th_Wnd, IDT_Timer )

SetTimer( This.hWnd_MsgBox, IDT_TIMER, This.nTimeout, 0 )
This.lTimeout = .T.
Return 0

Procedure Destroy
Clear DLLs


Budi Riva Oktafianto said...

Wow ....it's cool !

nice coding, tidak ada kata2 yang bisa saya ucapkan, selain "it's cool", Thank's for share

Herman Tan said...

Hallo pak Budi.
Terimakasih untuk feedbacknya!

Anonymous said...

Very nice, I am somewhat new to classes, with Messagebox() one can get a RETURN as to the value of the button clicked. Is there a way to to do the same with this class. I have only been able to get a RETURN of .T. from either of two button on the same message.


Herman Tan said...

Hi Bruce, thanks for your feedback!
Yes, you can get the return value. No offense please :) Frankly, I leave that to the readers, because it's really easy to modified the "ShowMsg()" procedure to work the way you want, if you know the bacis of VFP OOP. However since you are new to the class here is the code to get the return value. Take out the "Procedure ShowMsg". Change it with this one:
Procedure ShowMsg( tc_Msg, tn_Type, tc_Title )
Local ln_Return

BindEvent( 0, 0x06, This, 'WndProc' )
ln_Return = MessageBox( tc_Msg, tn_Type, tc_Title )
UnBindEvents( 0, 0x06 )

Return ln_Return


blue said...

Kueren boss... ane baru masuk ke blog anda.
Btw, gimana mensiasati penggunaan WAIT WINDOW di MDI karena wait window hanya bisa berjalan di screen mode. cmiiw.

Herman Tan said...

Thanks untuk komentarnya :)
Kalau untuk wait window, ga bisa di akalin supaya bisa Front Window. Karena windownya dibuat dari Form VFP (secara internal) & juga diatur oleh VFP, jadi bukan dari system.
Paling mungkin buat aja form sendiri, hilangkan titlebar, dll. Tinggal dibentuk seperti wait window.

Bill Opp said...

Beautiful - however, when I add a timeout parameter to ShowMsg, it loses the centering, button change and transparency features - only the basic messagebox works. I guess I don't understand the binding params....

Herman Tan said...

Thanks for the comments! Sorry, I didn't test the timeout parameter. Perhaps there is a conflict with the timer. I'll take a look and post back when I find the solution.

BR. Oktafianto said...

Halo Pak. HermanT,

Sama seperti yang dialami Mr. Bill OP, kira-kira kapan solusinya bisa direlease ...terima kasih.

thesuhu said...

terima kasih pak, sangat berguna.