学步园

急着要用，先做出这个功能。

例子:
 *------------
text to cCode
? 'haha'
? ' screen dblclick'
endtext

? glHookCode(_screen,'dblclick',cCode)
然后 对着screen 双击，代码将执行。

Function glHookCode()Function glHookCode
    Lparameters toSourceObj, tcSourceMethod, tcCode, tnFlag

    If Not Pemstatus(_Screen,'oCodeHooker',5)
        _Screen.AddObject('oCodeHooker','CodeHooker')
    Endif
    If Isnull(_Screen.oCodeHooker)
        _Screen.oCodeHooker = Createobject('CodeHooker')
    Endif
    *---

    Return _Screen.oCodeHooker._lRegisterHook(toSourceObj, tcSourceMethod, tcCode, tnFlag)
Endfunc


Define Class CodeHookerClass CodeHooker As Session

    Dimension aHookTable[1,6]

    Function _uHandleHook()Function _uHandleHook
        Lparameters uPara1,uPara2,uPara3,uPara4,uPara5,uPara6,uPara7,uPara8,uPara9,uPara10
        Local nParaCnt,aList(1),oObj,cMethod,cCode,uRet,cTmp,nParaCnt,cScript,j
        Private poThisform, poThis
        uRet = .T.
        nParaCnt=Parameters()

        Aevents(aList,0)
        poThis=aList(1)
        poThisform = goObj2Form(oObj)
        cMethod=Upper( aList(2) )

        For i =1 To Alen(This.aHookTable,1)
            If Vartype(This.aHookTable(i,1))='L'
                Loop
            Endif

            If Not ( This.aHookTable(i,1)=poThisform And This.aHookTable(i,2)==Sys(1272,poThis)    ;
                    and This.aHookTable(i,3)==cMethod )
                Loop
            Endif
            cCode = This.aHookTable(i, 4)
            
            cScript=' ExecScript( cCode,'
            For j=1 to Min( nParaCnt, This.aHookTable(i, 5))
                cScript = cScript + 'uPara' + Alltrim(Str(j,3)) + ','
            Next 
            cScript = Iif(Right(cScript,1)=',',  Left(cScript,Len(cScript)-1), cScript)
            cScript = cScript + ')'
            
            *-------
            Try
                uRet = &cScript
            Catch To oErr
                TEXT to cTmp PRETEXT 1+2
                     Error in CodeHooker, Code: <<oErr.message>>

                     ----------<code segment below>------------------

                     <<Left(cCode,300)>>
                ENDTEXT
                Wait Window Nowait cTmp
            Endtry
        Next

        Return uRet

    Endfunc


    Function _lRegisterHook()Function _lRegisterHook 
        Lparameters toSourceObj, tcSourceMethod, tcCode, tnFlag
        Local cTmp,oThisform,lRet,i,cCheckSum
        tnFlag = Evl(tnFlag,0)
        tcCode = Strtran( Strtran(tcCode,'thisform','poThisform',-1,-1,1), 'this','poThis',-1,-1,1)
        cCheckSum = Sys(2007,tcCode,-1,1)
        
        If Vartype(This.aHookTable[1]) <> 'L'
            For i=1 to Alen(this.aHookTable,1)
                If glEqual(this.aHookTable(i, 1), goObj2Form(toSourceObj)) ;
                    and glEqual( This.aHookTable(i, 2), Sys(1272,toSourceObj)) ;
                    and This.aHookTable(i, 3) == Upper( tcSourceMethod ) ;
                    and this.aHookTable(i, 6) == cCheckSum 
            
                    Return .t. && duplicate bind
                EndIf             
            Next  
        EndIf     


        If Not Vartype(This.aHookTable[1])='L'
            Dimension This.aHookTable(Alen(This.aHookTable,1)+1,6)
        Endif
    
        lRet = ( Bindevent(toSourceObj, tcSourceMethod, This, '_uHandleHook', tnFlag)=1 )
        
        If lRet 
            This.aHookTable(Alen(This.aHookTable,1), 1) = goObj2Form(toSourceObj)
            This.aHookTable(Alen(This.aHookTable,1), 2) = Sys(1272,toSourceObj)
            This.aHookTable(Alen(This.aHookTable,1), 3) = Upper( tcSourceMethod )
            This.aHookTable(Alen(This.aHookTable,1), 4) = tcCode
            this.aHookTable(Alen(this.aHookTable,1), 5) = this.nParaCount(tcCode)
            this.aHookTable(Alen(this.aHookTable,1), 6) = cCheckSum
        EndIf 
        
        Return lRet
    Endfunc


    Function nParaCount()Function nParaCount
        Lparameters cCode 
        Local i,nParaCnt,cLine
        *- 求一段CODE中,有无参数语句, 有几个参数
        
        nParaCnt=0
        For i=1 To Getwordcount(cCode,Chr(13) )
            cLine = Lower( Alltrim( Getwordnum(cCode,i,Chr(13)), 1, Chr(9),Chr(32),Chr(10),Chr(13) ))
            If Left(cLine,1)='*' Or Left(cLine,2)='&'+'&' Or Empty(cLine)
                Loop
            Endif
            If At('&'+'&',cLine)>0
                cLine = Substr(cLine,1,At('&'+'&',cLine) )
            Endif

            If Not ( Left(cLine,4)='para' Or Left(cLine,4)='lpar' )
                Exit  &&参数不是第一个,当无就是
            Endif

            nParaCnt = Getwordcount(cLine,',')
            Exit
        Next

        Return  nParaCnt

    EndFunc 
        
Enddefine

补充两个函数

Function glEqual()Function glEqual
Lparameters tuVar1,tuVar2,tlIgnoreSpace
*- 判断两个变量是否相等
*- 变量的类型可不相同, 类型不同当然不等
*- null 等于 null
*-
If Parameters()<3
    tlIgnoreSpace=.T.
Endif

If Isnull(tuVar1) And Isnull(tuVar2)
    Return .T.
Endif

If Isnull(tuVar1) And !Isnull(tuVar2) Or !Isnull(tuVar1) And Isnull(tuVar2)
    Return .F.
Endif

If Vartype(tuVar1)<>Vartype(tuVar2)
    Return .F.
Endif

If tlIgnoreSpace And Vartype(tuVar1)='C'
    Return Trim(tuVAR1)==Trim(tuVAR2)
Else
    Return tuVAR1==tuVAR2
Endif

Function goGetFormRef()Function goGetFormRef
*- 由表单的formname或caption,取得form的 对象ref
Lparameters tcCaptionOrName,tnSearchType
*- SearchType: 1 Caption, 2 Name
If Empty(tnSearchType)
    tnSearchType=1
Endif

tcCaptionOrName=Upper(tcCaptionOrName)

Local i,oRet
oRet=.Null.
For i=1 To _Screen.FormCount
    If tnSearchType=1
        If _Screen.Forms(i).Caption==tcCaptionOrName
            oRet=_Screen.Forms(i)
            Exit
        Endif
    Else
        If _Screen.Forms(i).Name==tcCaptionOrName
            oRet=_Screen.Forms(i)
            Exit
        Endif
    Endif
Next

Return oRet