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!

[CODE]
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 )
EndProc


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 )
endif
BindEvent( 0, 0x06, This, 'WndProc' )
If (VarType( tc_Title ) == 'C')
ln_Return = MessageBox( tc_Msg, tn_Type, tc_Title )
else
ln_Return = MessageBox( tc_Msg, tn_Type )
endif

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 )
else
KillTimer( This.hWnd, IDT_TIMER )
UnBindEvents( This.hWnd, IDT_TIMER )
endif
endif

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


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 ))
EndProc


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
endif

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
else
If !empty( .aButtons[ ln_X ] )
SendMessageStr( lh_WndChild, 0x0C, 0, .aButtons[ ln_X ] )
endif
endif
Next
endif

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 )
endif
EndWith

Return 0
endif

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


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
EndProc


Procedure Destroy
Clear DLLs
EndProc
EndDefine
[/CODE]

Getting PaperSize ID programmatically

In my previous tips, I've shown you how to add a custom paper size programmatically. Then you can modify the report and use the Page Setup to set your report to the custom paper size you have just created. VFP will automatically save the PaperSize ID according the ID when it is created in your PC. Now, when you add a custom paper in some PC, sometimes you can get a different PaperSize ID, because maybe it already have another custom paper size. So you have to hack the FRX to reflect the PaperSize ID in that computer. Here is how to get the PaperSize ID programmatically.

Notes:
- As usual, cut & paste the code below into PRG, then run "beautify" to make the code readable
- CToBin()  function shown in the code is an Enhancements function in VFP9. It doesn't work on earliear version. For VFP8 and lower, use Str2Num UDF to replace the function. You can find the UDF on Universal Thread or many other VFP forums.

[CODE]
** Updated: July 07, 2008
** Bug fixed by: Julio Veloz
#Define DC_PAPERS 2
#Define DC_PAPERS_Size 2
#Define DC_PAPERNAMES 16
#Define DC_PAPERNAMES_Size 64
Declare Long DeviceCapabilities in WinSpool.drv ;
String cPrinterName, String cPort, Short nCapFlags, ;
String @O_cBuffer, Long pDevMode

Local array la_Printer[1]
Local ln_Row, ln_Result, ln_I, ln_Index
Local lc_PrinterName, lc_Buffer
Local lc_FindPaperName, lc_PaperName, lc_PaperSizeID
lc_PrinterName = set( 'Printer', 2 ) && Get default windows printer
= APrinters( la_Printer )
ln_Row = AScan( la_Printer, lc_PrinterName, 1, 0, 0, 9 )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, 0, 0 )
If (ln_Result > 0)
ln_Index = -1
lc_FindPaperName = upper( 'MyCustom - Half A4' )
lc_Buffer = replicate( chr(0), ln_Result * DC_PAPERNAMES_Size )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, @lc_Buffer, 0 )
For ln_I = 0 to ln_Result-1
lc_PaperName = upper( substr( lc_Buffer, (ln_I * DC_PAPERNAMES_Size )+1, ;
DC_PAPERNAMES_Size ))
If (lc_FindPaperName $ lc_PaperName)
ln_Index = ln_I
Exit
endif
Next
If (ln_Index != -1)
** Paper Name found, Get The PaperSize ID
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERS, 0, 0 )
If (ln_Result > 0)
lc_Buffer = replicate( chr(0), ln_Result * DC_PAPERS_Size )
ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;
la_Printer[ ln_Row, 2 ], DC_PAPERS, @lc_Buffer, 0 )
lc_PaperSizeID = substr( lc_Buffer, (ln_Index * DC_PAPERS_Size )+1, DC_PAPERS_Size )
? 'PaperSize ID for "' + lc_FindPaperName + '" is', CToBin( lc_PaperSizeID, '2rs' )
endif
endif
endif
[/CODE]

Happy coding!

Using VFP Resource File

There are several ways to use the resource file. To load a bitmap from RT_BITMAP resource section, you can use GDI or GDI+ to load directly into a (handle) bitmap
[CODE]
*** Updated: Nov 23, 2007 - 07:45 AM

*** API Declaration
Declare Long LoadLibrary in Kernel32 String cFilename
Declare Long FreeLibrary in Kernel32 Long hModule

Declare Long LoadImage in User32 ;
Long hInstance, String lpszName, Long uType, ;
Integer cxDesired, Integer cyDesired, Long nLoadFlags

Declare Long GdipCreateBitmapFromResource in GdiPlus.dll ;
Long hInstance, String cBitmapName, Long @O_Bitmap

hBitmap = 0
hLibrary = LoadLibrary( 'myResource.LIB' )
If (hLibrary != 0)
** Use GDI
cResName = 'myImage' && Resource name
hBitmap = LoadImage( hLibrary, cResName, 0, 0, 0, 0 )

** Use GDI+
wResName = strconv( strconv( cResName + chr(0), 1 ), 5 )
GdipCreateBitmapFromResource( hLibrary, wResName, @hBitmap )

FreeLibrary( hLibrary )
endif

If (hBitmap != 0)
** We have a bitmap, do what you want to do here
** Don't forget to delete the bitmap,
** DeleteObject() for GDI, GdipDisposeImage() for GDI+
endif
[/CODE]

I also shown you about putting an image (PNG) to custom resource section. Since the image was put as a raw data, you can only load it back as raw data. After you get the raw data, you can save it to a file, or you can also create a stream data to create the bitmap from the stream. GdipCreateBitmapFromResource() doesn't work for this resource type.
[CODE]
*** API Declaration
Declare Long FindResource in Kernel32 as FindResourceStr ;
Long hModule, String lpName, String lpType

Declare Long SizeofResource in Kernel32 Long hModule, Long hResource
Declare Long LoadResource in Kernel32 Long hModule, Long hResource
Declare Long LockResource in Kernel32 Long hResData

cData = ''
hLibrary = LoadLibrary( 'myResource.LIB' )
If (hLibrary != 0)
cResName = 'myPNG'
hResource = FindResourceStr( hLibrary, cResName, 'MYIMAGES' )
If (hResource != 0)
nSize = SizeofResource( hLibrary, hResource )
hData = LoadResource( hLibrary, hResource )
pData = LockResource( hData )
cData = sys( 2600, pData, nSize )
endif
FreeLibrary( hLibrary )
endif

If !empty( cData )
** We got the raw data, do what you want to do here
endif
[/CODE]

In my last tips, I didn't show you all the predefined resources. there are several others actually, such as RT_ICON, RT_CURSOR, etc. It is my intention to not using resource file for other images type. Because those images are usually use only with VFP Image object. So, you can still use your project to put other images. Just consider to use the resource file when you have to distribute files physically that you can't put in your project.

Happy coding!