转载

转载 2013年02月25日 14:02:16

几篇老文章,只能翻墙阅读,麻烦,贴过来以后再看

1.  A more reliable timer (unstoppable)

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.

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

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.

Let's see the SetTimer declaration first:
Declare Long SetTimer in User32 ;
    Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc

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)

This example will show you one condition that will pending/stopped the VFP timer, while SetTimer() will continue running.

Clear
? 'Using VFP Timer. Do you see the wait window?'
? 'Press ESC key or click on cancel button when ready...'
oVFPTimer = Createobject( 'VFP_Timer' )
Getfile()
oVFPTimer = Null

?
? 'Using SetTimer() API. Watch for the wait window counting'
oWMTimer = Createobject( 'TimerProc', _vfp.HWnd )
Getfile()
oWMTimer = Null

****************

Define Class VFP_Timer As Timer
    Interval = 500
    Enabled = .T.
    nCounter = 0

    Procedure Timer
  *** You won't see the wait window
        Wait 'Using VFP Timer: ' + Transform( This.nCounter ) Window Nowait
        This.nCounter = This.nCounter + 1
    Endproc
Enddefine


Define Class TimerProc As Custom
    #Define WM_TIMER 0x0113
    #Define IDT_TIMER 1

    nCounter = 0
    HWnd = 0

    Procedure Init( th_Wnd )
        Declare Long SetTimer In User32 ;
            Long nhWnd, Long nEventId, Long uElapse, Long lpTimerFunc

        Declare Long KillTimer In User32 Long nhWnd, Long nEventId

  ** Bind the event first before SetTimer
        Bindevent( th_Wnd, WM_TIMER, This, 'TimerProc' )
        SetTimer( th_Wnd, IDT_TIMER, 500, 0 )
        This.HWnd = th_Wnd
    Endproc

    Procedure TimerProc( th_Wnd, tn_Msg, t_wParam, t_lParam )
        Wait 'Using BindEvent (WM_TIMER): ' + Transform( This.nCounter ) Window Nowait
        This.nCounter = This.nCounter + 1
        Return 0
    Endproc

    Procedure Destroy
        KillTimer( This.HWnd, IDT_TIMER )
        Unbindevents( This.HWnd )
    Endproc
Enddefine

 

2. Detecting WinXP Active Theme

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.

There are two API Theme functions that comes in handy for this purpose, IsThemeActive() and GetCurrentThemeName().

Here is how to use them:

#Define MAX_WCHAR 512

Declare Long IsThemeActive In uxTheme
Declare Long GetCurrentThemeName In uxTheme ;
    String @ O_pwszThemeFileName, Integer nMaxNameChars, ;
    String @ O_pwszColorBuff, Integer nMaxColorChars, ;
    String @ O_pwszSizeBuff, Integer nMaxSizeChars

Local lw_ThemeFileName, lw_ColorBuff, lw_SizeBuff
Local lc_ColorBuff, lc_SizeBuff, ll_Themed

If (IsThemeActive() == 1)
    lw_ThemeFileName = Space( MAX_WCHAR )
    lw_ColorBuff = Space( MAX_WCHAR )
    lw_SizeBuff = Space( MAX_WCHAR )
    ll_Themed = (GetCurrentThemeName( @lw_ThemeFileName, MAX_WCHAR, @lw_ColorBuff, MAX_WCHAR, ;
        @lw_SizeBuff, MAX_WCHAR ) == 0)

    ? 'Theme filename : '
    If ll_Themed
        ?? MakeANSI( lw_ThemeFileName )
        lc_ColorBuff = MakeANSI( lw_ColorBuff )

        ? 'Color scheme : '
        Do Case
        Case (lc_ColorBuff == 'NormalColor')
            ?? 'Default'
        Case (lc_ColorBuff == 'Metallic')
            ?? 'Silver'
        Otherwise
            ?? 'Olive Green'
        Endcase
        ?? ' ( ' + lc_ColorBuff + ' )'

        ? 'Font size : '
        lc_SizeBuff = MakeANSI( lw_SizeBuff )
        Do Case
        Case (lc_SizeBuff == 'NormalSize')
            ?? 'Normal'
        Case (lc_SizeBuff == 'LargeFonts')
            ?? 'Large Fonts'
        Otherwise
            ?? 'Extra Large Fonts'
        Endcase
        ?? ' ( ' + lc_SizeBuff + ' )'
    Else
        ?? 'NONE ( Windows Classic )'
    Endif
Else
    ? 'Theme is not active ( Windows Classic )'
Endif
Clear Dlls

Procedure MakeANSI( tw_String )
    Local lc_String, ln_Pos

    lc_String = Strconv( Strconv( tw_String, 6 ), 2 )
    ln_Pos = At( Chr(0), lc_String )
    If (ln_Pos > 0)
        lc_String = Left( lc_String, ln_Pos - 1 )
    Endif

    Return lc_String
Endproc


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.

Happy coding!
 
3. How to change VFP tooltips appearance using BINDEVENT()

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.

HWnd = 0
lFound = .F.
cClassName = Space( 32 )
nLen = GetClassName( _vfp.HWnd, @cClassName, 32 )
If WIN_2K_XP
    cClassName = Left( cClassName, nLen ) + '3'
Else
    cClassName = Left( cClassName, nLen ) + '2'
Endif

Do While !( lFound )
    HWnd = FindWindowEx( 0, HWnd, cClassName, Null )
    If (HWnd != 0)
        nExstyle=GetWindowLong( HWnd, GWL_EXSTYLE )
        lFound = (Bitand( nExStyle, WS_EX_TOOLWINDOW ) != 0)
    Else
        lFound = .T.
    Endif
Enddo


Then bind WM_SHOWWINDOW, WM_ERASEBKGND and WM_WINDOWPOSCHANGED into that window.

If (HWnd != 0)
** hWnd = Handle to Tooltips window
** This = Object handler for Window Messages
** WndProc = name of the Procedure/Method for the callback
    This.pOrgProc = GetWindowLong( HWnd, GWL_WNDPROC )
    Bindevent( HWnd, WM_SHOWWINDOW, This, 'WndProc' )
    Bindevent( HWnd, WM_ERASEBKGND, This, 'WndProc' )
    Bindevent( HWnd, WM_WINDOWPOSCHANGED, This, 'WndProc' )
Endif


** WndProc method
Lparameters HWnd, nMsg, wParam, Lparam

Do Case
Case (nMsg == WM_ERASEBKGND)
    This.lEraseBackground = .T.

Case (nMsg == WM_SHOWWINDOW)
** Process WM_SHOWWINDOW if the window is being *shown*
** Otherwise, let default VFP process this message
    If (wParam == SW_SHOWNORMAL)
        This.On_ShowWindow( HWnd )
        Return 0
    Endif

Case (nMsg == WM_WINDOWPOSCHANGED)
** Only process WM_WINDOWPOSCHANGED after WM_ERASEBKGND
    If This.lEraseBackGround
        This.On_WindowPosChanged( HWnd )
        This.lEraseBackGround = .F.
        Return 0
    Endif
Endcase

Return CallWindowProc( This.pOrgProc, HWnd, nMsg, wParam, Lparam )


** On_ShowWindow method
Lparameters HWnd

Local sRect
Local nLeft, nTop, nRight, nBottom, nWidth, nHeight

sRect = Space( RECT_Size )
GetWindowRect( HWnd, @sRect )
With This
    nLeft = .Buff2Num( sRect, 1, .T. )
    nTop = .Buff2Num( sRect, 5, .T. )
    nRight = .Buff2Num( sRect, 9, .T. )
    nBottom = .Buff2Num( sRect, 13, .T. )
    nWidth = (nRight - nLeft) + .nAddWidth && default .nAddWidth = 14
    nHeight = (nBottom - nTop) + .nAddHeight && default .nAddHeight = 12
Endwith

SetWindowPos( HWnd, HWND_TOP, nLeft, nTop+Sysmetric(4), ; nWidth, nHeight, SWP_NOZORDER + SWP_NOACTIVATE )


** On_WindowPosChanged method
Lparameters HWnd

Local hDC, sRect, hOldBrush
Local nLeft, nTop, nRight, nBottom
Local cText, nLen

cText = Replicate( c0, MAX_PATH )
nLen = GetWindowText( HWnd, @cText, MAX_PATH )
If (nLen > 0)
    cText = Left( cText, nLen )
    sRect = Space( RECT_Size )
    GetClientRect( HWnd, @sRect )
    hDC = GetDC( HWnd )
    hOldBrush = SelectObject( hDC, GetSysColorBrush( COLOR_INFOBK ))

    With This
        nLeft = .Buff2Num( sRect, 1, .T. ) - 1
        nTop = .Buff2Num( sRect, 5, .T. ) - 1
        nRight = .Buff2Num( sRect, 9, .T. ) + 1
        nBottom = .Buff2Num( sRect, 13, .T. ) + 1

        Rectangle( hDC, nLeft, nTop, nRight, nBottom )
        nLeft = nLeft + (.nAddWidth / 2) + 2
        nTop = nTop + (.nAddHeight / 2) + 2
    Endwith

    SetRect( @sRect, nLeft, nTop, nRight, nBottom )
    DrawText( hDC, cText, nLen, sRect, DT_LEFT + DT_NOCLIP )
    SelectObject( hDC, hOldBrush )
    ReleaseDC( HWnd, hDC )
Endif

 

Download VFP Tooltips source code

Enjoy the tips. And we (me and Malcolm) hope to put more contents here soon.
Long live VFP!
 

4. Centering 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' )

** lo_MsgBox.hWnd = myForm.hWnd && center MessageBox in Form
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 = Null
Release lo_MsgBox

**********************

Define Class cls_MessageBox As Custom
    HWnd = 0
    pOrgProc = 0
    lChangeButton = .F.
    lTransparent = .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 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

        This.HWnd = _vfp.HWnd
        This.pOrgProc = GetWindowLong( _vfp.HWnd, -4 )
    Endproc


    Procedure ShowMsg( tc_Msg, tn_Type, tc_Title )
        Bindevent( 0, 0x06, This, 'WndProc' )
        Messagebox( tc_Msg, tn_Type, tc_Title )
        Unbindevents( 0, 0x06 )
    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

            With This
                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

                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

                .CenterWindow( .HWnd, t_lParam )
            Endwith
            Return 0
        Endif

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

    Procedure Destroy
        Clear Dlls
    Endproc
Enddefine

Threejs 入门 转载

发现一个http://www.hewebgl.com

转载app安全

  • 2017年06月14日 18:29
  • 1.34MB
  • 下载

如何防止sql注入【转载】

  • 2014年10月08日 20:00
  • 33KB
  • 下载

apache kafka技术分享系列(目录索引)--转载

原文地址:http://blog.csdn.net/lizhitao/article/details/39499283 kafka开发与管理: 1)apache kafka消息服务 2)kafak安装...

Axure+RP+pro教程(整理-转载)

  • 2015年11月25日 18:05
  • 1.05MB
  • 下载

ffmpeg参数说明(转载)

ffmpeg.exe -i F:\闪客之家\闪客之歌.mp3 -ab 56 -ar 22050 -b 500 -r 15 -s 320x240 f:\11.flv  ffmpeg -i F:\01....

makefile(转载)

  • 2013年10月19日 16:58
  • 98KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:转载
举报原因:
原因补充:

(最多只允许输入30个字)