tag:blogger.com,1999:blog-293069442024-02-21T03:53:14.981+07:00Herman Tan's BlogSome idea's and tip's for Visual Foxpro developerHerman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.comBlogger9125tag:blogger.com,1999:blog-29306944.post-83210330318278074392008-07-08T09:31:00.006+07:002015-12-27T18:32:57.780+07:00Centering / Customize VFP MessageBox in any Form<span style="font-family: times new roman;"><span style="font-size: 100%;">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.<br /><br />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.<br /><br />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.<br /><br />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 :)<br /><br />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!<br /><br />[CODE]<br /><span style="color: #3333ff;">Local lo_MsgBox</span><br /><br /><span style="color: #3333ff;">lo_MsgBox = CreateObject( 'cls_MessageBox' )</span><br /><span style="color: #3333ff;">?lo_MsgBox.ShowMsg( 'Test MessageBox', 64, 'MessageBox Title' )</span><br /><br /><span style="color: #3333ff;">lo_MsgBox.lChangeButton = .T. <span style="color: #009900;">&& Change MessageBox Button</span></span><br /><span style="color: #3333ff;">lo_MsgBox.aButtons[1] = '&Good' <span style="color: #009900;">&& 1st button</span></span><br /><span style="color: #3333ff;">?lo_MsgBox.ShowMsg( 'Test MessageBox', 64, 'MessageBox Title' )</span></span></span><span style="color: #009900; font-family: 'times new roman'; font-size: 16px;"><br /></span><br />
<span style="color: #009900; font-family: 'times new roman'; font-size: 16px;"><br /></span>
<span style="color: #009900; font-family: 'times new roman'; font-size: 16px;">**** Uncomment the line below and change myForm to any form you wanted the MessageBox to display</span><span style="font-family: times new roman;"><span style="font-size: 100%;"><br /><span style="color: #009900;">** lo_MsgBox.hWnd = myForm.hWnd && center MessageBox in myForm</span><br /><span style="color: #3333ff;">lo_MsgBox.lTransparent = .T. <span style="color: #009900;">&& transparent MessageBox</span></span><br /><span style="color: #3333ff;">lo_MsgBox.nTransValue = 85 <span style="color: #009900;">&& 85% transparent</span></span><br /><span style="color: #3333ff;">lo_MsgBox.aButtons[2] = '&Bad' <span style="color: #009900;">&& 2nd button</span></span><br /><span style="color: #3333ff;">lo_MsgBox.aButtons[3] = '&Worst' <span style="color: #009900;">&& 3rd button</span></span><br /><span style="color: #3333ff;">?lo_MsgBox.ShowMsg( 'Test MessageBox', 64+2, 'MessageBox Title' )</span></span></span><br />
<span style="color: #3333ff; font-family: times new roman;">?lo_MsgBox.ShowMsg( 'Test MessageBox With Timer (5sec)', 64+2, 'MessageBox Title', 5000 )</span><br />
<span style="font-family: times new roman;"><span style="color: #3333ff;"></span></span><br />
<span style="color: #3333ff; font-family: times new roman;">?lo_MsgBox.ShowMsg( 'Test MessageBox with TimeOut (5sec)', 273, 'MessageBox Title', 5000 )</span><br />
<div>
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 100%;">lo_MsgBox = Null</span></div>
<span style="font-family: times new roman;"><span style="color: #3333ff; font-size: 100%;">Release lo_MsgBox</span><br /><br /><span style="color: #009900; font-size: 100%;">*************************</span></span><br />
<span style="color: #009900; font-family: 'times new roman'; font-size: 16px;">*** Updated : timer is working correctly</span><br />
<span style="color: #009900; font-family: 'times new roman'; font-size: 16px;">*************************</span><br />
<span style="color: #009900; font-family: 'times new roman'; font-size: 16px;"><br /></span>
<span style="font-family: times new roman;"><span style="color: #3333ff; font-size: 100%;">Define class cls_MessageBox as Custom</span></span><br />
<br />
<span style="font-family: times new roman;"><span style="color: #3333ff;">#Define WM_TIMER 0x0113</span></span><br />
<span style="font-family: times new roman;"><span style="color: #3333ff;">#Define IDT_TIMER 1</span></span><br />
<span style="font-family: times new roman;"><span style="color: #3333ff;"><br /><span style="font-size: 100%;"> hWnd = 0</span></span></span><br />
<span style="font-family: times new roman;"><span style="color: #3333ff;">hWnd_MsgBox = 0<br /><span style="font-size: 100%;"> pOrgProc = 0</span></span><br /><span style="color: #3333ff; font-size: 100%;"> lChangeButton = .F.</span><br /><span style="color: #3333ff; font-size: 100%;"> lTransparent = .F.</span></span><br />
<span style="color: #3333ff; font-family: times new roman;">nTimeout = 0</span><br />
<span style="color: #3333ff; font-family: times new roman;">lTimeout = .F.</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"> nTransValue = 100 <span style="color: #009900;">&& in percentage, 100% = opaque</span></span><br /><br /><span style="color: #3333ff;"> Dimension aButtons[3] = .F.</span><br /><br /><span style="color: #3333ff;"> Procedure Init</span><br /><span style="color: #3333ff;"> Declare Long SetLayeredWindowAttributes in User32 ;</span><br /><span style="color: #3333ff;"> Long nhWnd, Long crKey, Short bAlpha, Long dwFlags</span></span></span><br />
<span style="color: #3333ff; font-family: 'times new roman';"><br /></span>
<span style="color: #3333ff; font-family: 'times new roman';">Declare Long GetDesktopWindow in User32</span><br />
<span style="color: #3333ff; font-family: 'times new roman';"><br /></span>
<span style="font-family: times new roman;"><span style="color: #3333ff; font-size: 100%;">Declare Long GetWindowLong in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long nhWnd, Integer nIndex</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long SetWindowLong in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long nhWnd, Integer nIndex, Long dwNewLong</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long GetWindowRect in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long nhWnd, String @O_lpRect</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long SetWindowPos in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long nhWnd, Long hWndInsertAfter, ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Integer nX, Integer nY, Integer nWidth, Integer nHeight, Long nFlags</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long CallWindowProc in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long lpPrevWndFunc, Long nhWnd, ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long uMsg, Long wParam, Long lParam</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long FindWindowEx in User32 ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long hWndParent, Long hWndChildAfter, ;</span><br /><span style="color: #3333ff; font-size: 100%;"> String lpszClass, String lpszWindow</span><br /><br /><span style="color: #3333ff; font-size: 100%;"> Declare Long SendMessage in User32 as SendMessageStr ;</span><br /><span style="color: #3333ff; font-size: 100%;"> Long nhWnd, Long uMsg, Long wParam, String @lParam</span></span><br />
<span style="color: blue; font-family: times new roman;">Declare Long SetTimer in User32 ;</span><br />
<span style="color: blue; font-family: times new roman;">Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc</span><br />
<span style="color: blue; font-family: 'times new roman';"><br /></span>
<span style="color: blue; font-family: 'times new roman';">Declare Long KillTimer in User32 Long nhWnd, Long nEventId</span><br />
<span style="color: blue; font-family: 'times new roman';"><br /></span>
<span style="color: blue; font-family: 'times new roman';">This.hWnd = iif( (VarType( th_Wnd )== 'N'), ;</span><br />
<span style="color: blue;"><span style="font-family: 'times new roman';">iif( th_Wnd != 0, th_Wnd, GetDesktopWindow() ), _VFP.hWnd )</span></span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 100%;">This.pOrgProc = GetWindowLong( _VFP.hWnd, -4 )</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"> EndProc</span><br /><br /><br /><span style="color: #3333ff;"> Procedure ShowMsg( tc_Msg, tn_Type, tc_Title, tn_Timeout )</span></span></span><br />
<span style="color: #3333ff; font-family: times new roman;">Local ln_Return</span><br />
<span style="color: #3333ff; font-family: times new roman;"><br /></span>
<span style="color: #3333ff; font-family: times new roman;">If (varType( tn_Timeout ) == 'N')</span><br />
<span style="color: #3333ff; font-family: times new roman;">This.nTimeout = iif( tn_Timeout < 1000, 1000, tn_Timeout )</span><br />
<span style="color: #3333ff; font-family: times new roman;">endif</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;">BindEvent( 0, 0x06, This, 'WndProc' )</span></span></span><br />
<span style="color: #3333ff; font-family: times new roman;">If (VarType( tc_Title ) == 'C')</span><br />
<span style="color: #3333ff; font-family: times new roman;">ln_Return = MessageBox( tc_Msg, tn_Type, tc_Title )</span><br />
<span style="color: #3333ff; font-family: times new roman;">else</span><br />
<span style="color: #3333ff; font-family: times new roman;">ln_Return = MessageBox( tc_Msg, tn_Type )</span><br />
<span style="color: #3333ff; font-family: times new roman;">endif</span><br />
<div>
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 100%;">UnBindEvents( 0, 0x06 )</span></div>
<br />
<span style="color: #3333ff; font-family: times new roman;">If (This.nTimeout > 0)</span><br />
<span style="color: #3333ff; font-family: times new roman;">If ( This.lTimeout )</span><br />
<span style="color: #3333ff; font-family: times new roman;">ln_Return = -1</span><br />
<span style="color: #3333ff; font-family: times new roman;">KillTimer( This.hWnd_MsgBox, IDT_TIMER )</span><br />
<span style="color: #3333ff; font-family: times new roman;">UnBindEvents( This.hWnd_MsgBox, IDT_TIMER )</span><br />
<span style="color: #3333ff; font-family: times new roman;">else</span><br />
<span style="color: #3333ff; font-family: times new roman;">KillTimer( This.hWnd, IDT_TIMER )</span><br />
<span style="color: #3333ff; font-family: times new roman;">UnBindEvents( This.hWnd, IDT_TIMER )</span><br />
<span style="color: #3333ff; font-family: times new roman;">endif</span><br />
<span style="color: #3333ff; font-family: 'times new roman';">endif</span><br />
<div>
<br /></div>
<span style="color: #3333ff; font-family: times new roman;">Store 0 to This.nTimeout, This.hWnd_MsgBox</span><br />
<span style="color: #3333ff; font-family: times new roman;">This.lTimeout = .F.</span><br />
<span style="color: #3333ff; font-family: times new roman;">Return ln_Return</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;">EndProc</span><br /><br /><br /><span style="color: #3333ff;"> Procedure CenterWindow( th_WndParent, th_WndChild )</span><br /><span style="color: #3333ff;"> Local ls_Rect</span><br /><br /><span style="color: #3333ff;"> ls_Rect = space( 16 )</span><br /><span style="color: #3333ff;"> <span style="color: #009900;">** Get container area (parent)</span></span><br /><span style="color: #3333ff;"> GetWindowRect( th_WndParent, @ls_Rect )</span><br /><span style="color: #3333ff;"> ln_TargetLeft = CToBin( substr( ls_Rect, 1, 4 ), '4rs' )</span><br /><span style="color: #3333ff;"> ln_TargetTop = CToBin( substr( ls_Rect, 5, 4 ), '4rs' )</span><br /><span style="color: #3333ff;"> ln_Right = CToBin( substr( ls_Rect, 9, 4 ), '4rs' ) + 1</span><br /><span style="color: #3333ff;"> ln_Bottom = CToBin( substr( ls_Rect, 13, 4 ), '4rs' ) + 1</span><br /><span style="color: #3333ff;"> ln_Width = ln_Right - ln_TargetLeft</span><br /><span style="color: #3333ff;"> ln_Height = ln_Bottom - ln_TargetTop</span><br /><br /><span style="color: #3333ff;"> <span style="color: #009900;">** Get contained area (child)</span></span><br /><span style="color: #3333ff;"> GetWindowRect( th_WndChild, @ls_Rect )</span><br /><span style="color: #3333ff;"> ln_Left = CToBin( substr( ls_Rect, 1, 4 ), '4rs' )</span><br /><span style="color: #3333ff;"> ln_Top = CToBin( substr( ls_Rect, 5, 4 ), '4rs' )</span><br /><span style="color: #3333ff;"> ln_Right = CToBin( substr( ls_Rect, 9, 4 ), '4rs' ) + 1</span><br /><span style="color: #3333ff;"> ln_Bottom = CToBin( substr( ls_Rect, 13, 4 ), '4rs' ) + 1</span><br /><br /><span style="color: #3333ff;"> <span style="color: #009900;">** Get Left & Top position (XY coordinate)</span></span><br /><span style="color: #3333ff;"> ln_Left = ((ln_Width - (ln_Right - ln_Left)) / 2) + ln_TargetLeft</span><br /><span style="color: #3333ff;"> ln_Top = (ln_Height - (ln_Bottom - ln_Top)) / 2 + ln_TargetTop</span><br /><span style="color: #3333ff;"> SetWindowPos( th_WndChild, 0, ln_Left,ln_Top, 0,0, BitOr( 0x1, 0x10, 0x400 ))</span><br /><span style="color: #3333ff;"> EndProc</span><br /><br /><br /><span style="color: #3333ff;"> Procedure WndProc( th_Wnd, tn_Msg, t_wParam, t_lParam )</span><br /><span style="color: #3333ff;"> If (tn_Msg == 0x06) and (t_wParam == 0)</span><br /><span style="color: #3333ff;"> Local ln_X, lh_Wnd, lh_WndChild, ln_OldStyle, ln_Transparent</span></span></span><br />
<span style="color: #3333ff; font-family: times new roman;">If (This.nTimeout > 0)</span><br />
<span style="color: #3333ff; font-family: 'times new roman';">This.hWnd_MsgBox = t_lParam</span><br />
<span style="color: #3333ff; font-family: times new roman;">BindEvent( th_Wnd, WM_TIMER, This, 'TimerProc' )</span><br />
<span style="color: #3333ff; font-family: times new roman;">SetTimer( th_Wnd, IDT_TIMER, This.nTimeOut-60, 0 )</span><br />
<span style="color: #3333ff; font-family: times new roman;">This.nTimeout = 200</span><br />
<span style="color: #3333ff; font-family: 'times new roman';">endif</span><br />
<div>
<br /></div>
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;">With This</span></span></span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">.CenterWindow( .hWnd, t_lParam )</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"><br /></span></span></span>
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;">If ( .lChangeButton )</span><br /><span style="color: #3333ff;"> lh_WndChild = 0</span><br /><span style="color: #3333ff;"> For ln_X = 1 to 3</span><br /><span style="color: #3333ff;"> lh_WndChild = FindWindowEx( t_lParam, lh_WndChild, 'Button', 0 )</span><br /><span style="color: #3333ff;"> If (lh_WndChild == 0)</span><br /><span style="color: #3333ff;"> ln_X = 4</span><br /><span style="color: #3333ff;"> else</span><br /><span style="color: #3333ff;"> If !empty( .aButtons[ ln_X ] )</span><br /><span style="color: #3333ff;"> SendMessageStr( lh_WndChild, 0x0C, 0, .aButtons[ ln_X ] )</span><br /><span style="color: #3333ff;"> endif</span><br /><span style="color: #3333ff;"> endif</span><br /><span style="color: #3333ff;"> Next</span><br /><span style="color: #3333ff;"> endif</span></span></span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"><br /></span></span></span><span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">If ( .lTransparent ) and (.nTransValue > 0)</span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">ln_Transparent = int((255 * This.nTransValue) / 100)</span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">SetWindowLong( t_lParam, -20, ;</span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">BitOr( GetWindowLong( t_lParam, -20 ), 0x80000 ))</span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">SetLayeredWindowAttributes( t_lParam, 0, ln_Transparent, 2 )</span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 16px;">endif</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;">EndWith</span></span></span><br />
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 100%;"><br /></span>
<span style="color: #3333ff; font-family: 'times new roman'; font-size: 100%;">Return 0</span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"> endif</span><br /><br /><span style="color: #3333ff;"> Return CallWindowProc( This.pOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )</span><br /><span style="color: #3333ff;"> EndProc</span></span></span><br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"><br /></span></span></span>
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"><br /></span></span></span>
<span style="color: #3333ff; font-family: times new roman;">Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )</span><br />
<span style="color: #3333ff; font-family: times new roman;">KillTimer( th_Wnd, IDT_TIMER)</span><br />
<span style="color: #3333ff; font-family: times new roman;">UnBindEvents( th_Wnd, IDT_Timer )</span><br />
<span style="color: #3333ff; font-family: 'times new roman';"><br /></span>
<span style="color: #3333ff; font-family: 'times new roman';">SetTimer( This.hWnd_MsgBox, IDT_TIMER, This.nTimeout, 0 )</span><br />
<span style="color: #3333ff; font-family: times new roman;">This.lTimeout = .T.</span><br />
<span style="color: #3333ff; font-family: times new roman;">Return 0</span><br />
<span style="color: #3333ff; font-family: times new roman;">EndProc</span><br />
<br />
<span style="font-family: times new roman;"><span style="font-size: 100%;"><span style="color: #3333ff;"></span><br /><span style="color: #3333ff;"> Procedure Destroy</span><br /><span style="color: #3333ff;"> Clear DLLs</span><br /><span style="color: #3333ff;"> EndProc</span><br /><span style="color: #3333ff;">EndDefine</span><br />[/CODE]</span></span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com10tag:blogger.com,1999:blog-29306944.post-62227589867864056452008-03-15T14:58:00.005+07:002014-04-18T03:52:34.747+07:00Getting PaperSize ID programmatically<span style="font-family: times new roman;">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.</span><br />
<span style="font-family: Times New Roman;"></span><br />
<span style="font-family: Times New Roman;">Notes:</span><br />
<span style="font-family: Times New Roman;">- As usual, cut & paste the code below into PRG, then run "beautify" to make the code readable</span><br />
<span style="font-family: Times New Roman;">- </span><span style="font-family: Times New Roman;">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.</span><br />
<div>
<br /></div>
[CODE]<br />
<span style="color: #009900; font-family: times new roman;">** Updated: July 07, 2008<br />** Bug fixed by: Julio Veloz</span><span style="font-family: times new roman;"><br /></span><span style="color: #3333ff; font-family: times new roman;">#Define DC_PAPERS 2<br />#Define DC_PAPERS_Size 2<br />#Define DC_PAPERNAMES 16<br />#Define DC_PAPERNAMES_Size 64<br />Declare Long DeviceCapabilities in WinSpool.drv ;<br />String cPrinterName, String cPort, Short nCapFlags, ;<br />String @O_cBuffer, Long pDevMode<br /><br />Local array la_Printer[1]<br />Local ln_Row, ln_Result, ln_I, ln_Index<br />Local lc_PrinterName, lc_Buffer<br />Local lc_FindPaperName, lc_PaperName, lc_PaperSizeID<br />lc_PrinterName = set( 'Printer', 2 ) && Get default windows printer<br />= APrinters( la_Printer )<br />ln_Row = AScan( la_Printer, lc_PrinterName, 1, 0, 0, 9 )<br />ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;<br />la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, 0, 0 )<br />If (ln_Result > 0)<br />ln_Index = -1<br />lc_FindPaperName = upper( 'MyCustom - Half A4' )<br />lc_Buffer = replicate( chr(0), ln_Result * DC_PAPERNAMES_Size )<br />ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;<br />la_Printer[ ln_Row, 2 ], DC_PAPERNAMES, @lc_Buffer, 0 )<br />For ln_I = 0 to ln_Result-1<br />lc_PaperName = upper( substr( lc_Buffer, (ln_I * DC_PAPERNAMES_Size )+1, ;<br />DC_PAPERNAMES_Size ))<br />If (lc_FindPaperName $ lc_PaperName)<br />ln_Index = ln_I<br />Exit<br />endif<br />Next<br />If (ln_Index != -1)<br /><span style="color: #009900;">** Paper Name found, Get The PaperSize ID</span></span><br />
<span style="color: #3333ff; font-family: times new roman;">ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;<br />la_Printer[ ln_Row, 2 ], DC_PAPERS, 0, 0 )<br />If (ln_Result > 0)<br />lc_Buffer = replicate( chr(0), ln_Result * DC_PAPERS_Size )<br />ln_Result = DeviceCapabilities( la_Printer[ ln_Row, 1 ], ;<br />la_Printer[ ln_Row, 2 ], DC_PAPERS, @lc_Buffer, 0 )<br />lc_PaperSizeID = substr( lc_Buffer, (ln_Index * DC_PAPERS_Size )+1, DC_PAPERS_Size )<br />? 'PaperSize ID for "' + lc_FindPaperName + '" is', CToBin( lc_PaperSizeID, '2rs' )<br />endif<br />endif<br />endif</span><br />
<span style="color: black; font-family: Times New Roman;">[/CODE]</span><br />
<span style="color: black; font-family: Times New Roman;"></span><br />
<span style="color: black; font-family: Times New Roman;">Happy coding!</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com9tag:blogger.com,1999:blog-29306944.post-51609962580124280312007-09-10T07:23:00.000+07:002007-11-23T07:47:44.463+07:00Using VFP Resource File<span style="font-family:times new roman;">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<br />[CODE]<br /><span style="color:#009900;">*** Updated: Nov 23, 2007 - 07:45 AM</span></span><br /><br /><span style="font-family:times new roman;"><span style="color:#009900;">*** API Declaration</span><br /><span style="color:#3333ff;">Declare Long LoadLibrary in Kernel32 String cFilename</span><br /><span style="color:#3333ff;">Declare Long FreeLibrary in Kernel32 Long hModule<br /><br /></span><span style="color:#3333ff;"></span><span style="color:#3333ff;">Declare Long LoadImage in User32 ;</span><br /><span style="color:#3333ff;">Long hInstance, String lpszName, Long uType, ;</span><br /><span style="color:#3333ff;">Integer cxDesired, Integer cyDesired, Long nLoadFlags</span><br /><br /><span style="color:#3333ff;">Declare Long GdipCreateBitmapFromResource in GdiPlus.dll ;</span><br /><span style="color:#3333ff;">Long hInstance, String cBitmapName, Long @O_Bitmap<br /></span><br /><span style="color:#3333ff;">hBitmap = 0</span><br /><span style="color:#3333ff;">hLibrary = LoadLibrary( 'myResource.LIB' )</span><br /><span style="color:#3333ff;">If (hLibrary != 0)</span><br /><span style="color:#009900;">** Use GDI</span><br /><span style="color:#3333ff;">cResName = 'myImage'</span><span style="color:#009900;"> && Resource name<br /></span><span style="color:#3333ff;">hBitmap = LoadImage( hLibrary, cResName, 0, 0, 0, 0 )</span><br /><br /><span style="color:#009900;">** Use GDI+</span><br /><span style="color:#3333ff;">wResName = strconv( strconv( cResName + chr(0), 1 ), 5 )</span><br /><span style="color:#3333ff;">GdipCreateBitmapFromResource( hLibrary, wResName, @hBitmap )<br /></span><br /><span style="color:#3333ff;">FreeLibrary( hLibrary )</span><br /><span style="color:#3333ff;">endif<br /></span><br /><span style="color:#3333ff;">If (hBitmap != 0)</span><br /><span style="color:#009900;">** We have a bitmap, do what you want to do here</span><br /><span style="color:#009900;">** Don't forget to delete the bitmap,</span><br /><span style="color:#009900;">** DeleteObject() for GDI, GdipDisposeImage() for GDI+</span><br /><span style="color:#3333ff;">endif</span><br />[/CODE]<br /><br />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.<br />[CODE]<br /><span style="color:#009900;">*** API Declaration</span><br /><span style="color:#3333ff;">Declare Long FindResource in Kernel32 as FindResourceStr ;</span><br /><span style="color:#3333ff;">Long hModule, String lpName, String lpType<br /></span><br /><span style="color:#3333ff;">Declare Long SizeofResource in Kernel32 Long hModule, Long hResource</span><br /><span style="color:#3333ff;">Declare Long LoadResource in Kernel32 Long hModule, Long hResource</span><br /><span style="color:#3333ff;">Declare Long LockResource in Kernel32 Long hResData<br /></span><br /><span style="color:#3333ff;">cData = ''</span><br /><span style="color:#3333ff;">hLibrary = LoadLibrary( 'myResource.LIB' )</span><br /><span style="color:#3333ff;">If (hLibrary != 0)</span><br /><span style="color:#3333ff;">cResName = 'myPNG'</span><br /><span style="color:#3333ff;">hResource = FindResourceStr( hLibrary, cResName, 'MYIMAGES' )</span><br /><span style="color:#3333ff;">If (hResource != 0)</span><br /><span style="color:#3333ff;">nSize = SizeofResource( hLibrary, hResource )</span><br /><span style="color:#3333ff;">hData = LoadResource( hLibrary, hResource )</span><br /><span style="color:#3333ff;">pData = LockResource( hData )</span><br /><span style="color:#3333ff;">cData = sys( 2600, pData, nSize )</span><br /><span style="color:#3333ff;">endif<br />FreeLibrary( hLibrary )</span><br /><span style="color:#3333ff;">endif</span><br /><br /><span style="color:#3333ff;">If !empty( cData )</span><br /><span style="color:#009900;">** We got the raw data, do what you want to do here</span><br /><span style="color:#3333ff;">endif</span><br />[/CODE]<br /><br />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.<br /><br />Happy coding!</span><br /><br /></span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com4tag:blogger.com,1999:blog-29306944.post-32914605668772923272007-09-03T22:56:00.000+07:002007-11-23T07:47:20.636+07:00Creating a VFP Resource File<span style="font-family:times new roman;">What is a resource file? A resource file is sort of a container file. Using resource file, you only have to distribute one single file instead of distribute many files. You can use this file to put any file such as image (BMP, JPG, PNG, etc). You can use this to distribute a hidden report file. You can also use this file in conjunction with my OwnerDrawn menu class. In short, you can use this file for many purposes.<br /><br />How to create it? Very simple! Here is the step:<br />1. Create a new program (for the Main program)<br />2. Put a QUIT command into it<br />3. Create a new project.<br />4. Add the Main program into the project<br />5. Uncheck the project debug info<br />6. Build the project as an EXE, but name it as "myResource.LIB" (give the extension yourself)<br /><br />Once you created your LIB file, how can you put your file into it? You must put the raw data into the resource file. There are three WinAPI functions to help you to put the raw data into it. BeginUpdateResource(), UpdateResource() and EndUpdateResource().<br /><br />Let's look at the example. Suppose you want to put an image file ("myPNG.PNG") into it, here's how you do it:<br />[CODE] </span><br /><span style="font-family:times new roman;"><span style="color:#009900;">*** Updated: Nov 23, 2007 - 07:45 AM<br /></span><span style="color:#009900;"><span style="color:#009900;"></span></span></span><br /><span style="font-family:times new roman;"><span style="color:#009900;"><span style="color:#009900;">*** API Declaration</span><br /></span><span style="color:#3333ff;">Declare Long BeginUpdateResource in Kernel32 ;<br />String cFileName, Long bDeleteExistingResources<br /><br />Declare Long UpdateResource in Kernel32 as UpdateResourceStr ;<br />Long hUpdate, String lpType, String lpName, ;<br />Short wLanguage, String lpData, Long nLenData<br /><br />Declare Long UpdateResource in Kernel32 as UpdateResourceStr2 ;<br />Long hUpdate, Long lpType, String lpName, ;<br />Short wLanguage, String lpData, Long nLenData<br /><br />Declare Long EndUpdateResource in Kernel32 ;<br />Long hUpdate, Long fDiscard<br /><br /><span style="color:#009900;">*** Start code<br /></span>cImageFile = 'myPNG.PNG'<br />cResFile = 'myResource.LIB'<br />cResGroup = 'MYIMAGES' <span style="color:#009900;">&& a resource section group, make uppercase</span><br />cResName = upper( JustStem( cImageFile )) </span><span style="color:#009900;">&& a resource name, make uppercase</span></span><br /><span style="font-family:times new roman;"><span style="color:#3333ff;"><br />cRawData = FileToStr( cImageFile )<br />hResFile = BeginUpdateResource( cResFile, .F. ) </span></span><br /><span style="font-family:times new roman;"><span style="color:#3333ff;">If (hResFile != 0)<br />UpdateResourceStr( hResFile, cResGroup, cResName, 0, ;<br />cRawData, len( cRawData))<br />EndUpdateResource( hResFile, .F. ) </span></span><br /><span style="font-family:times new roman;"><span style="color:#3333ff;">endif<br /></span>[/CODE]<br /><br />Suppose you want to put an image file that has a BMP extension, you better put it into the predefined resource section group. Change the code above into this:<br /><br />[CODE]<br /><span style="color:#009900;">*** Start code</span><br /><span style="color:#3333ff;">cImageFile = 'myImage.BMP'<br />cResFile = 'myResource.LIB'<br />nResGroup = 2 <span style="color:#009900;">&& RT_BITMAP, a predefined resource section group</span><br />cResName = upper( JustStem( cImageFile )) </span><span style="color:#009900;">&& a resource name, make uppercase</span><br /></span><span style="color:#3333ff;"></span><br /><span style="font-family:times new roman;color:#3333ff;">cRawData = FileToStr( cImageFile )<br />cRawData = substr( cRawData, 15 ) && eliminate BITMAPFILEHEADER structure (14 chars)<br />hResFile = BeginUpdateResource( cResFile, .F. )<br />If (hResFile != 0)</span><br /><span style="font-family:times new roman;color:#3333ff;">UpdateResourceStr2( hResFile, nResGroup, cResName, 0, ;<br />cRawData, len( cRawData))<br />EndUpdateResource( hResFile, .F. ) </span><br /><span style="font-family:times new roman;color:#3333ff;">endif<br /></span><span style="font-family:times new roman;">[/CODE]<br /><br />That's it, try and experiment yourself. In the next tips, I will show you how to use the resource file.<br /><br />Happy coding!</span><br /></span><br /><br /><br /></span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com2tag:blogger.com,1999:blog-29306944.post-1588174928771020502007-08-12T12:32:00.000+07:002014-04-18T03:58:06.849+07:00Adding Custom Paper Size Programmatically<span style="font-family: times new roman;">There are times when we need to make a custom report size. Before you can create a custom size, you have to manually add a Printer Form Size (Control Panel -> Printer & Faxes -> File -> Server Properties). Then you can set the Page Setup in your report to use the custom printer form.</span><br />
<span style="font-family: Times New Roman;"></span><br />
<span style="font-family: Times New Roman;">The hard part is, when you distribute the application to the client, you must also set the same Custom Form Size for their printer configuration. Of course you don't want to do it one by one manually! So, what you need is create a small procedure to detect whether the custom printer form is already exist. If not then add it.</span><br />
<span style="font-family: Times New Roman;"><br /></span>
<span style="font-family: Times New Roman;">Notes:</span><br />
<span style="font-family: Times New Roman;">- Cut * paste the code below into PRG, then run "beautify" to make the code readable</span><br />
<span style="font-family: Times New Roman;">- BinToC() function in this code is an Enhanced function in VFP9. For VFP8 and lower version, use UDF called Long2Str or Num2Str. You can find the function on UT or other VFP forums.</span><br />
<br />
<span style="font-family: Times New Roman;">[Code]</span><br />
<span style="color: #3333ff; font-family: Times New Roman;">Local hPrinter<br />Local cPrinterName, cPaperName<br />Local pPaperName, sPaperSize<br />Local nResult, nBufLen, nPaperWidth, nPaperHeight</span><br />
<span style="color: #3333ff; font-family: Times New Roman;"><br />Declare Long GetLastError in Kernel32<br />Declare Long ClosePrinter in WinSpool.Drv Long hPrinter<br />Declare Long OpenPrinter in WinSpool.Drv ;<br /> String cPrinterName, Long @O_hPrinter, Long pDefault<br /><br />Declare Long GetForm in WinSpool.drv as GetPrinterForm ;<br />Long hPrinter, String pFormName, ;<br />Long nLevelInfo, String @O_pFormInfo, ;<br />Long nBufSize, Long @O_nBufNeeded<br /><br />Declare Long AddForm in WinSpool.drv as AddPrinterForm ;<br />Long hPrinter, Long nLevelInfo, String @pFormInfo<br /><br />Declare Long LocalAlloc in Kernel32 Long uFlags, Long dwBytes<br />Declare Long LocalFree in Kernel32 Long hMem<br /><br />cPrinterName = set( 'Printer', 2 ) && Get default Windows printer<br />hPrinter = 0<br /><br />If (OpenPrinter( cPrinterName, @hPrinter, 0 ) != 0)<br />cPaperName = 'MyCustom - Half A4'<br />nBufLen = 32 && FORM_INFO_1_Size<br />cInfo = replicate( chr(0), 32 )<br />nResult = GetPrinterForm( hPrinter, cPaperName, 1, ;<br />@cInfo, nBufLen, @nBufLen )<br /><br />If (nResult == 0) && Get printer form failed<br />nResult = GetLastError()<br /><br />If (nResult == 1902) && ERROR_INVALID_FORM_NAME<br />** Custom Printer Form not exist, add the new one<br />nPaperWidth = 210000 / 2 && Paper size is in 1/1000 millimeters<br />nPaperHeight = 297000 / 2<br />sPaperSize = BinToC( nPaperWidth, '4rs' ) + BinToC( nPaperHeight, '4rs' )<br />pPaperName = LocalAlloc( 64, 32 )<br /><br />If (pPaperName != 0)<br />sys( 2600, pPaperName, len( cPaperName ), cPaperName )<br />cInfo = BinToC( 0, '4rs' ) + BinToC( pPaperName, '4rs' ) + ;<br />sPaperSize + BinToC( 0, '4rs' ) + BinToC( 0, '4rs' ) + sPaperSize<br /><br />If (AddPrinterForm( hPrinter, 1, cInfo ) != 0)<br />? 'Custom paper form (' + cPaperName + ') has been added! '<br />else<br />? 'Error:', GetLastError()<br />endif<br /><br />LocalFree( pPaperName )<br />endif<br /><br />else<br />If (nResult == 122) && Insufficient buffer<br />? 'Error: Custom Paper Form already exist!'<br />else<br />? 'Error: ', nResult<br />endif<br />endif<br />else<br />? 'Error: ', nResult<br />endif<br />ClosePrinter( hPrinter )<br />endif</span><br />
<span style="font-family: Times New Roman;">[/Code]</span><br />
<span style="color: black; font-family: Times New Roman;"></span><br />
<span style="color: black; font-family: Times New Roman;">Happy coding! :)</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com13tag:blogger.com,1999:blog-29306944.post-1158959591388124082006-09-23T02:58:00.000+07:002007-08-12T13:35:39.153+07:00A more reliable timer (unstoppable)<span style="font-family:times new roman;">VFP Timer is known not so reliable. Under certain conditions, the VFP timer event can be pending/stopped. In Win32API There is a more reliable timer, SetTimer() API. However, since the older VFP version does not support the callback, many VFP'er go to C/C++ for the solution.<br /><br />In VFP9, there is a way to use the SetTimer() API. BindEvent() can make this possible. Since our apps is under VFP control, there might a bit delay before the timer is fired. Anyway, again, thanks to enhanced of BindEvent() command :)<br /><br />Actually, I had shown how to use SetTimer() in my OwnerDrawn Menu class. But you might not noticed that or maybe you don't get the idea about how it works. Here is the explanation.<br /><br />Let's see the SetTimer declaration first:<br />[code]<br />Declare Long SetTimer in User32 ;<br />Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc<br />[/code]<br /><br />As you see, the last parameter of SetTimer is pointer to a function (callback procedure). So how can you use this function. Very simple, pass in NULL pointer. Once you pass a NULL pointer, the OS will post a WM_TIMER message instead of calling the procedure. Now, simply bind the WM_TIMER into your top-level form. That would be all. For more info on SetTimer, take a look at MSDN (as usual)<br /><br />This example will show you one condition that will pending/stopped the VFP timer, while SetTimer() will continue running.<br />[code]<br />Clear<br />? 'Using VFP Timer. Do you see the wait window?'<br />? 'Press ESC key or click on cancel button when ready...'<br />oVFPTimer = CreateObject( 'VFP_Timer' )<br />GetFile()<br />oVFPTimer = Null<br /><br />?<br />? 'Using SetTimer() API. Watch for the wait window counting'<br />oWMTimer = CreateObject( 'TimerProc', _VFP.hWnd )<br />GetFile()<br />oWMTimer = Null<br /><br />****************<br /><br />Define Class VFP_Timer as Timer<br />Interval = 500<br />Enabled = .T.<br />nCounter = 0<br /><br />Procedure Timer<br />*** You won't see the wait window<br />Wait 'Using VFP Timer: ' + transform( This.nCounter ) window nowait<br />This.nCounter = This.nCounter + 1<br />EndProc<br />EndDefine<br /><br /><br />Define Class TimerProc as Custom<br />#Define WM_TIMER 0x0113<br />#Define IDT_TIMER 1<br /><br />nCounter = 0<br />hWnd = 0<br /><br />Procedure Init( th_Wnd )<br />Declare Long SetTimer in User32 ;<br />Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc<br /><br />Declare Long KillTimer in User32 Long nhWnd, Long nEventId<br /><br />** Bind the event first before SetTimer<br />BindEvent( th_Wnd, WM_TIMER, This, 'TimerProc' )<br />SetTimer( th_Wnd, IDT_TIMER, 500, 0 )<br />This.hWnd = th_Wnd<br />EndProc<br /><br />Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )<br />Wait 'Using BindEvent (WM_TIMER): ' + transform( This.nCounter ) window nowait<br />This.nCounter = This.nCounter + 1<br />Return 0<br />EndProc<br /><br />Procedure Destroy<br />KillTimer( This.hWnd, IDT_TIMER )<br />UnBindEvents( This.hWnd )<br />EndProc<br />EndDefine<br />[/code]<br /><br />Happy coding :)</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com1tag:blogger.com,1999:blog-29306944.post-1158481855271988182006-09-17T15:29:00.000+07:002007-08-12T13:37:50.194+07:00Detecting WinXP Active Theme<span style="font-family:times new roman;">Many recent VFP applications is designed to be look more consistent with WinXP. One of the important factor is to know what is the active theme that the user is using.<br /><br />There are two API Theme functions that comes in handy for this purpose, IsThemeActive() and GetCurrentThemeName().<br /><br />Here is how to use them:<br />[code]<br />#Define MAX_WCHAR 512<br /><br />Declare Long IsThemeActive in uxTheme<br />Declare Long GetCurrentThemeName in uxTheme ;<br />String @ O_pwszThemeFileName, Integer nMaxNameChars, ;<br />String @ O_pwszColorBuff, Integer nMaxColorChars, ;<br />String @ O_pwszSizeBuff, Integer nMaxSizeChars<br /><br />Local lw_ThemeFileName, lw_ColorBuff, lw_SizeBuff<br />Local lc_ColorBuff, lc_SizeBuff, ll_Themed<br /><br />If (IsThemeActive() == 1)<br />lw_ThemeFileName = space( MAX_WCHAR )<br />lw_ColorBuff = space( MAX_WCHAR )<br />lw_SizeBuff = space( MAX_WCHAR )<br />ll_Themed = (GetCurrentThemeName( @lw_ThemeFileName, MAX_WCHAR, @lw_ColorBuff, MAX_WCHAR, ;<br />@lw_SizeBuff, MAX_WCHAR ) == 0)<br /><br />? 'Theme filename : '<br />If ll_Themed<br />?? MakeANSI( lw_ThemeFileName )<br />lc_ColorBuff = MakeANSI( lw_ColorBuff )<br /><br />? 'Color scheme : '<br />Do case<br />Case (lc_ColorBuff == 'NormalColor')<br />?? 'Default'<br />Case (lc_ColorBuff == 'Metallic')<br />?? 'Silver'<br />Otherwise<br />?? 'Olive Green'<br />EndCase<br />?? ' ( ' + lc_ColorBuff + ' )'<br /><br />? 'Font size : '<br />lc_SizeBuff = MakeANSI( lw_SizeBuff )<br />Do case<br />Case (lc_SizeBuff == 'NormalSize')<br />?? 'Normal'<br />Case (lc_SizeBuff == 'LargeFonts')<br />?? 'Large Fonts'<br />Otherwise<br />?? 'Extra Large Fonts'<br />EndCase<br />?? ' ( ' + lc_SizeBuff + ' )'<br />else<br />?? 'NONE ( Windows Classic )'<br />endif<br />else<br />? 'Theme is not active ( Windows Classic )'<br />endif<br />Clear DLLs<br /><br /><br />Procedure MakeANSI( tw_String )<br />Local lc_String, ln_Pos<br /><br />lc_String = strconv( strconv( tw_String, 6 ), 2 )<br />ln_Pos = at( chr(0), lc_String )<br />If (ln_Pos > 0)<br />lc_String = left( lc_String, ln_Pos - 1 )<br />endif<br /><br />Return lc_String<br />EndProc<br />[/code]<br /><br />To make your apps sensing the theme changes, you can bind the apps top-level form to WM_THEMECHANGED. Then use the code above (in your procedure handler) to detect the new theme.<br /><br />Happy coding!</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com1tag:blogger.com,1999:blog-29306944.post-1157155753436771812006-09-02T07:06:00.000+07:002015-12-27T02:52:41.643+07:00Updated OwnerDrawn menu class<span style="font-family: times new roman;">Today, the OwnerDrawn menu class has been updated (the article was published on UT Magazine October 2005 edition). A few bug has been fixed. And few features has been added based on e-mail I received lately.<br /><br />I hope you enjoy the new class,<br />happy coding!<br /><br />Download </span><a href="https://drive.google.com/file/d/0B4fsrGj1YVpPdVVnclZuTHJKOTQ/view?usp=sharing" target="_blank"><span style="font-family: times new roman;">OwnerDrawn Menus</span></a><span style="font-family: times new roman;"> class & sample</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com10tag:blogger.com,1999:blog-29306944.post-1150318843669955602006-06-15T03:51:00.000+07:002015-12-27T02:53:22.520+07:00<span style="font-family: times new roman;">Hello foxer!<br /><br />Today is my first time posting. I 'd like to share my first tips about changing the VFP tooltips appearance (margin, font, color, etc..). This idea is based on a UT thread by Malcolm Greene who is also greatly supported and encouraging me for months. Malcolm is also a team member for my blogger. So, my special thanks to Malcolm :)<br /><br />Anyway, here is the tips:<br /><br /><b>How to change VFP tooltips appearance using BINDEVENT()</b><br /><br />VFP Tooltips is just another window that was created and the classname was registered by VFP. All you need is to find the window with that classname. To find VFP tooltips window you need to enumerate the window (start from the desktop), and look for the window that has WS_EX_TOOLWINDOW for the extended style.<br /><br />hWnd = 0<br />lFound = .F.<br />cClassName = space( 32 )<br />nLen = GetClassName( _VFP.hWnd, @cClassName, 32 )<br />If WIN_2K_XP<br />cClassName = left( cClassName, nLen ) + '3'<br />else<br />cClassName = left( cClassName, nLen ) + '2'<br />endif<br /><br />Do while !( lFound )<br />hWnd = FindWindowEx( 0, hWnd, cClassName, Null )<br />If (hWnd != 0)<br />nExStyle = GetWindowLong( hWnd, GWL_EXSTYLE )<br />lFound = (BitAnd( nExStyle, WS_EX_TOOLWINDOW ) != 0)<br />else<br />lFound = .T.<br />endif<br />enddo<br /><br />Then bind WM_SHOWWINDOW, WM_ERASEBKGND and WM_WINDOWPOSCHANGED into that window.<br /><br />If (hWnd != 0)<br />** hWnd = Handle to Tooltips window<br />** This = Object handler for Window Messages<br />** WndProc = name of the Procedure/Method for the callback<br />This.pOrgProc = GetWindowLong( hWnd, GWL_WNDPROC )<br />BindEvent( hWnd, WM_SHOWWINDOW, This, 'WndProc' )<br />BindEvent( hWnd, WM_ERASEBKGND, This, 'WndProc' )<br />BindEvent( hWnd, WM_WINDOWPOSCHANGED, This, 'WndProc' )<br />endif<br /><br /><br />** WndProc method<br />LParameters hWnd, nMsg, wParam, lParam<br /><br />Do case<br />Case (nMsg == WM_ERASEBKGND)<br />This.lEraseBackground = .T.<br /><br />Case (nMsg == WM_SHOWWINDOW)<br />** Process WM_SHOWWINDOW if the window is being *shown*<br />** Otherwise, let default VFP process this message<br />If (wParam == SW_SHOWNORMAL)<br />This.On_ShowWindow( hWnd )<br />Return 0<br />endif<br /><br />Case (nMsg == WM_WINDOWPOSCHANGED)<br />** Only process WM_WINDOWPOSCHANGED after WM_ERASEBKGND<br />If This.lEraseBackGround<br />This.On_WindowPosChanged( hWnd )<br />This.lEraseBackGround = .F.<br />Return 0<br />endif<br />EndCase<br /><br />Return CallWindowProc( This.pOrgProc, hWnd, nMsg, wParam, lParam )<br /><br /><br />** On_ShowWindow method<br />LParameters hWnd<br /><br />Local sRect<br />Local nLeft, nTop, nRight, nBottom, nWidth, nHeight<br /><br />sRect = space( RECT_Size )<br />GetWindowRect( hWnd, @sRect )<br />With This<br />nLeft = .Buff2Num( sRect, 1, .T. )<br />nTop = .Buff2Num( sRect, 5, .T. )<br />nRight = .Buff2Num( sRect, 9, .T. )<br />nBottom = .Buff2Num( sRect, 13, .T. )<br />nWidth = (nRight - nLeft) + .nAddWidth &&amp;amp;amp; default .nAddWidth = 14<br />nHeight = (nBottom - nTop) + .nAddHeight && default .nAddHeight = 12<br />EndWith<br /><br />SetWindowPos( hWnd, HWND_TOP, nLeft, nTop+SysMetric(4), ; nWidth, nHeight, SWP_NOZORDER + SWP_NOACTIVATE )<br /><br /><br />** On_WindowPosChanged method<br />LParameters hWnd<br /><br />Local hDC, sRect, hOldBrush<br />Local nLeft, nTop, nRight, nBottom<br />Local cText, nLen<br /><br />cText = replicate( c0, MAX_PATH )<br />nLen = GetWindowText( hWnd, @cText, MAX_PATH )<br />If (nLen > 0)<br />cText = left( cText, nLen )<br />sRect = space( RECT_Size )<br />GetClientRect( hWnd, @sRect )<br />hDC = GetDC( hWnd )<br />hOldBrush = SelectObject( hDC, GetSysColorBrush( COLOR_INFOBK ))<br /><br />With This<br />nLeft = .Buff2Num( sRect, 1, .T. ) - 1<br />nTop = .Buff2Num( sRect, 5, .T. ) - 1<br />nRight = .Buff2Num( sRect, 9, .T. ) + 1<br />nBottom = .Buff2Num( sRect, 13, .T. ) + 1<br /><br />Rectangle( hDC, nLeft, nTop, nRight, nBottom )<br />nLeft = nLeft + (.nAddWidth / 2) + 2<br />nTop = nTop + (.nAddHeight / 2) + 2<br />EndWith<br /><br />SetRect( @sRect, nLeft, nTop, nRight, nBottom )<br />DrawText( hDC, cText, nLen, sRect, DT_LEFT + DT_NOCLIP )<br />SelectObject( hDC, hOldBrush )<br />ReleaseDC( hWnd, hDC )<br />endif<br /><br />Download </span><a href="https://drive.google.com/file/d/0B4fsrGj1YVpPSWJ1cGg1QWVNeEk/view?usp=sharing" target="_blank"><span style="font-family: times new roman;">VFP Tooltips</span></a><span style="font-family: times new roman;"> source code<br /><br />Enjoy the tips. And we (me and Malcolm) hope to put more contents here soon.<br />Long live VFP!</span>Herman Tanhttp://www.blogger.com/profile/14586267478337456208noreply@blogger.com0