apistatusbar.prg

一个状态栏函数

*-----------------------------------------------
* 程序: 纯API状态栏测试
* 设计: 红雨
* 时间: 2005.04.18 00:00:00
* 环境: VFP8.0以上版本
*-----------------------------------------------

*-----------------------------------------------
* _Screen 调用示例
*-----------------------------------------------
Local loStatusBar
loStatusBar = CreateStatusBar( _Screen )
If Type([loStatusBar.Name])=[C]
    loStatusBar.SetStatusText([ 操作员],1)
    loStatusBar.SetStatusText([江南红雨],2)
    loStatusBar.SetStatusText([纯API状态栏测试...],3)
Else
    = Messagebox([无法创建状态栏！],0+64+0,[提示信息])
Endif
Return

*-----------------------------------------------
* 函数: 创建状态栏
* 参数: 父级对象(Form、_Screen、_VFP 等)
* 返回: 计时器对象,带以下方法
*   SetStatusText(文本,栏序号): 设置状态栏文本
*-----------------------------------------------
Function CreateStatusBar( toWindow )
    Set Talk Off
    Local loReturn
    m.loReturn = Null
    If Type([toWindow])=[O] And Type([toWindow.Name])=[C] And Type([toWindow.hWnd])=[N]
        Local loWindow, loObject
        If m.toWindow = _Screen Or m.toWindow = _vfp
            Set Status Bar Off
            m.loWindow = _Screen
            m.loObject = _vfp
        Else
            loWindow = m.toWindow
            loObject = m.toWindow
        Endif
        #Define WS_CHILD     0x40000000
        #Define WS_VISIBLE   0x10000000
        #Define WS_CH_OR_VIS 0x50000000
        #Define IDC_STATBAR  0x2005
        #Define WM_USER      0x400
        #Define SB_SETPARTS  0x404
        #Define SB_SETTEXTA  0x401
        Declare Integer CreateStatusWindow In ComCtl32 Integer intStyle,String lpszText,Integer hwndParent,Integer wID

        Local hWndBar, szText, ParenthWnd, loStTimer
        m.hWndBar = 0
        m.szText = []
        m.ParenthWnd = loObject.HWnd
        m.hWndBar = CreateStatusWindow( WS_CH_OR_VIS, m.szText, m.ParenthWnd, IDC_STATBAR )

        If m.hWndBar > 0
            If Type([loWindow.StatusTimer.Name])=[C]
                loWindow.RemoveObject( [StatusTimer] )
            Endif
            loWindow.AddObject( [StatusTimer], [StatusTimer] )
            loWindow.StatusTimer.SetStatusInit( m.hWndBar, m.loObject, m.loWindow )
            m.loReturn = loWindow.StatusTimer
        Endif
    Endif
    Return m.loReturn
Endfunc

*-----------------------------------------------
* 自动时钟和位置、相关控制
*-----------------------------------------------
Define Class StatusTimer As Timer
    Interval = 1000
    Enabled = .T.
    nStWHnd = 0
    nStLeft = 0
    nStTop  = 0
    nStWidth = 0
    nStHeight = 20
    oObject = Null
    oWindow = Null
    Name = [StatusTimer]

    Procedure Timer
        If This.nStWHnd <> 0
            Local loObject, lcStatusText
            lcStatusText = []
            If Type([_Screen.ActiveForm.Caption])=[C]
                loObject = _Screen.ActiveForm
                lcStatusText = loObject.Caption
                Do While .T.
                    If Type([loObject.ActiveControl.Name])=[C]
                        loObject = loObject.ActiveControl
                        If Type([loObject.ToolTipText])=[C]
                            lcStatusText = lcStatusText + [ - ] + loObject.ToolTipText
                        Endif
                    Else
                        Exit
                    Endif
                Enddo
            Endif
            #Define SB_SETTEXTA  0x401
            Declare Integer SendMessage In user32 Integer intHWnd,Integer Msg,Integer wParam,String @ Lparam
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 2, lcStatusText)
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 3, Iif(Insmode(), [插入],[替换]))
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 4, Iif(Numlock(), [数字],[方向]))
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 5, Iif(Capslock(),[大写],[小写]))
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 6, Dtoc(Date()))
            = SendMessage(This.nStWHnd, SB_SETTEXTA, 7, Time())
        Endif
    Endproc

    Procedure ScreenResize
        If This.nStWHnd <> 0 And Type([This.oObject.Name])=[C] And Type([This.oWindow.Name])=[C]
            #Define SB_SETPARTS  0x404
            Declare Integer MoveWindow In User32 Integer intHwnd, Integer x, Integer Y, Integer nWidth, Integer nHeight, Integer bRepaint
            Declare Integer SendMessage In User32 Integer intHWnd, Integer Msg, Integer wParam, String @ Lparam
            Declare Integer SetParent In user32 Integer hWndChild, Integer hWndNewParent
            = MoveWindow(This.nStWHnd, 0, This.oObject.Height-This.nStHeight, This.oObject.Width, This.nStHeight, 1)
            * 以下指定分栏线的 Left
            m.nWidth = Iif(This.oWindow=_Screen, 15, 8)
            m.sBar = This.LongToStr(45) ;
                + This.LongToStr(100) ;
                + This.LongToStr(This.oObject.Width-220-m.nWidth) ;
                + This.LongToStr(This.oObject.Width-190-m.nWidth) ;
                + This.LongToStr(This.oObject.Width-160-m.nWidth) ;
                + This.LongToStr(This.oObject.Width-130-m.nWidth) ;
                + This.LongToStr(This.oObject.Width-60-m.nWidth) ;
                + This.LongToStr(-1)
            = SendMessage( This.nStWHnd, SB_SETPARTS, 8, m.sBar)
            = SetParent(This.nStWHnd, This.oObject.HWnd)
        Endif
    Endproc

    Function SetStatusInit( tnhWndBar, toObject, toWindow )
        This.nStWHnd = Iif(Type([m.tnhWndBar])=[N], m.tnhWndBar, 0)
        This.oObject = Iif(Type([m.toObject.Name])=[C], m.toObject, Null)
        This.oWindow = Iif(Type([m.toWindow.Name])=[C], m.toWindow, m.toObject)
        If This.nStWHnd <> 0 And Type([This.oObject.Name])=[C] And Type([This.oWindow.Name])=[C]
            Declare Integer GetWindowRect In user32 Integer HWnd, String @lpRect
            Declare Integer SetParent In user32 Integer hWndChild, Integer hWndNewParent
            = SetParent(This.nStWHnd, This.oObject.HWnd)
            m.lu_RECT = This.Str_Int(0)+This.Str_Int(0)+This.Str_Int(0)+This.Str_Int(0)
            = GetWindowRect(This.nStWHnd, @lu_RECT)   && 得到窗口矩形
            This.nStLeft = This.Str_Int(Subs(m.lu_RECT,1,4))
            This.nStTop  = This.Str_Int(Subs(m.lu_RECT,5,4))
            This.nStWidth = This.Str_Int(Subs(m.lu_RECT,9,4)) - This.nStLeft
            This.nStHeight = This.Str_Int(Subs(m.lu_RECT,13,4)) - This.nStTop
            = Bindevent( This.oWindow, [Resize], This, [ScreenResize] )
            This.oWindow.Resize()
        Endif
    Endfunc

    Function SetStatusText( tcText, tnBar )
        If This.nStWHnd <> 0
            #Define SB_SETTEXTA  0x401
            m.tnBar = Iif(Type([m.tnBar])=[N],Abs(Int(m.tnBar)),3)
            Declare Integer SendMessage In user32 Integer intHWnd,Integer Msg,Integer wParam,String @ Lparam
            = SendMessage( This.nStWHnd, SB_SETTEXTA, m.tnBar-1, m.tcText)
        Endif
    Endfunc

    Function LongToStr( lnLongval )
        Local i, lcRetstr
        m.lcRetstr = ""
        For i = 24 To 0 Step -8
            m.lcRetstr = Chr(Int(m.lnLongval/(2^m.i))) + m.lcRetstr
            m.lnLongval = Mod(m.lnLongval, (2^m.i))
        Next
        Return m.lcRetstr
    Endfunc

    Function Str_Int( tuPara )
        If Type([m.tuPara])=[N]
            m.lnBig = Int(m.tuPara/256)
            m.lnSmall = m.tuPara - m.lnBig * 256
            Return Alltrim(Chr(m.lnSmall))+Alltrim(Chr(m.lnBig))+Chr(0)+Chr(0)
        Else
            m.lnresult = 0
            m.lnlast = Len(m.tuPara)
            For m.lni = 1 To m.lnlast
                m.lnresult = m.lnresult + Asc(Substr(m.tuPara, m.lni, 1)) * (256 ^ (m.lni - 1))
            Endfor
            m.lnmsb = (m.lnlast * 8) - 1
            Return m.lnresult
        Endif
    Endfunc

    Procedure Error( nError, cMethod, nLine )
        * 屏蔽错误
    Endproc

    Procedure Destroy
        If This.nStWHnd <> 0
            = Unbindevent( This )
            Declare Integer SendMessage In user32 Integer intHWnd,Integer Msg,Integer wParam,String @ Lparam
            = SendMessage(This.nStWHnd, 16,0,[])
            If Type([This.oWindow.Name])=[C]
                This.oWindow.Resize()
            Endif
        Endif
    Endproc
Enddefine

*-----------------------------------------------
*Declare Integer SetForegroundWindow In user32 Integer
*Declare Integer ShowWindowAsync In user32 Integer, Integer
*= SetForegroundWindow(This.nStWHnd)
*= ShowWindowAsync(This.nStWHnd, 1)
*-----------------------------------------------