//
  QFRestore ¯228,13®
*************************************************************************
*              Tool Tips Derived from Alaska Example Source
*            Thanks to the Alaska Crew for Doing th Hard Part!)
*************************************************************************
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Font.ch"
*************************************************************************

* While the ToolTips system that was included with the original
* xBase++ release worked fine, it was a little too complex for me.
* I took the liberty to bring it down a notch and clean up the nested
* source for ease of understanding.

* I removed the Help database and simplified by using the ":helplink"
* instance variable of the xbPart as the repository for Tooltip
* information.  If you already are using the :helplink variable for
* other purposes (like help!), make it an array and modify the code
* below (and your help code) to reference the appropriate elements of
* the :helplink array.

* Additionally, I dislike wide Tooltips so I modified the code
* to wrap extra long tip text.  The default maximum is 45.  You and
* change this below (nMaxWidth).  I also added a check to prevent the
* tips from running off the screen.

* To activate the tool tip system, copy the following line to
* in your main procedure before the action starts. Enjoy!
* Nick Ramoundos, NYC (January, 2002)

*         Public oToolTips:=ToolTips():New():Start()

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

CLASS ToolTips FROM Thread

   HIDDEN:
   METHOD DisplayToolTip()

   EXPORTED:
   VAR producerID
   VAR oLastMotionXBP
   VAR oLastTipXBP
   VAR oBlockedXBP
   VAR nLastTipTime
   VAR aLastMotionPos
   VAR oTip
   VAR lTipIsShown
   VAR nTipSensitivity

   INLINE METHOD init()
      ::nTipSensitivity:=1
      ::thread:init()
      ::producerID:=ThreadID()
   Return

   EXPORTED:
   METHOD execute()
   METHOD atStart()
   METHOD showTip()
   METHOD hideTip()

ENDCLASS

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

METHOD ToolTips:atStart()

::lTipIsShown   :=.F.
::oLastMotionXBP:=NIL
::aLastMotionPos:=NIL

Return

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

METHOD ToolTips:Execute()

Local nEvent, mp1:=0, mp2:=0, oXbp:=NIL
Local nLastMotionTime:=0

Do While .T.

   * Pause to Avoid Consuming to Many CPU Resources
   Sleep(10) //300

   * Use LastAppEvent to Sniff into the Main Event Queue
   nEvent:=LastAppEvent(@mp1,@mp2,@oXbp,1)

   * Check for User Suppression of Tool Tips
   //If !M->ShowToolTips
   //   Loop
   //EndIf

   * Blocked XBP have input focus and have to be left out
   * in the tip heuristics
   If ValType(::oBlockedXBP)=="O" .and. oXbp==::oBlockedXBP
      Loop
   EndIf

   * Make Sure there is Helptext Assocated eith the part
   If ValType(oXbp)="O" .and. !ValType(oXbp:HelpLink)="C"
      ::HideTip(); Loop
   EndIf

   * Only Respont to Movements of the Mouse!
   If nEvent=xbeM_Motion

      * Ok, a motion Event has occured, and it was not over the
      * XBP which is Blocked - means of input-focus - so we
      * remove the Block
      ::oBlockedXBP:=NIL

      * We check here If the motion was again over the same XBP as the
      * last motion Event was, then we validate for the same mouse pos.
      * If that's all the case we only have to ensure that the
      * ::nTipSensitivity timeframe was reached, If so we post the tip.

      If (ValType(::oLastMotionXBP) =="O" .and. oXbp ==::oLastMotionXBP)

         If::aLastMotionPos[1]=mp1[1] .and.::aLastMotionPos[2]=mp1[2]
            If (Seconds() - nLastMotionTime) >::nTipSensitivity
              ::showTip()
            EndIf
           Else
           ::aLastMotionPos:=AClone(mp1)
            nLastMotionTime:=Seconds()
         EndIf

      * Check If the current XBP we are over has the same parent
      * as the XBP for which we have posted the last TIP. In that
      * case we check out If the timeframe between these two actions
      * was under half a second. Are all prev. conditions fullfilled
      * we assume the user is interested in another tip for the XBP
      * in the neighborhood of its current - so it goes.

      ElseIf ValType(::oLastTipXBP)=="O" .and. ;
             oXbp:setParent()==::oLastTipXBP:setParent() .and. ;
             oXbp !=::oLastTipXBP

        ::hideTip()
        ::oLastMotionXBP:=oXbp
        ::aLastMotionPos:=AClone(mp1)
        nLastMotionTime:=Seconds()

        If ::nLastTipTime>0 .and. (Seconds()-::nLastTipTime)<=0.5
           ::showTip()
        EndIf

      * Ok, nothing special has occured, so we simply store the
      * Event data related to the motion to be used in the next
      * pass.

      Else

         ::oLastMotionXBP:=oXbp
         ::aLastMotionPos:=AClone(mp1)
         nLastMotionTime :=Seconds()
         ::hideTip()

      EndIf

   * Any Event except PaintEvent has to hide the Tip. In
   * addition, we mark the XBP as Blocked - because
   * user-interaction via Keyboard or Mouse has taken
   * place - to avoid Tip postings While the user
   * interacts with the XbasePART

   ElseIf nEvent !=xbeP_Paint

      If oXbp==::oLastTipXBP
         ::oBlockedXBP:=oXbp
      EndIf
      ::oLastMotionXBP:=NIL
      ::hideTip()

   EndIf

EndDo

Return

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

METHOD ToolTips:showTip()

If !::lTipIsShown  //:DisplayToolTip(::oLastMotionXBP)
   ::DisplayToolTip(::oLastMotionXBP)
   ::oTip:show()
   ::lTipIsShown:=.T.
   ::oLastTipXBP:=::oLastMotionXBP
   ::oBlockedXBP:=NIL
EndIf

Return

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

METHOD ToolTips:hideTip()

If ::lTipIsShown
   ::oTip:hide()
   ::oTip:destroy()
   ::lTipIsShown:=.F.
   ::nLastTipTime:=Seconds()
EndIf

Return

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

METHOD ToolTips:DisplayToolTip(oXbpRequestingHint)

Local cText:="(Tip Error!)"
Local cID :=""
Local aPos
Local aAreaAttr, aStringAttr, oPS
Local aPoints, aSize:={0,0}
Local nTipLines,nTipWidth:=0,nMaxWidth:=45, nRow, I, nTipHeight

* calculate absolute position of motion Event and adjust it
* about the mouse pointer size

aPos:=calcAbsolutePosition(::aLastMotionPos,oXbpRequestingHint)

aPos[1] += 4
aPos[2] += 4

* Check If the XBP for which we have to post a hint has an
* associated Text

If ValType(oXbpRequestingHint:helpLink)=="C" .and. ;
   !Empty(ValType(oXbpRequestingHint:helpLink))
   cText:=oXbpRequestingHint:helpLink
EndIf

* Ok, now lets paint the TIP
::oTip:=XbpStatic():new()
::oTip:options:=XBPSTATIC_TYPE_FGNDFRAME
::oTip:create(AppDesktop(),AppDesktop(),aPos,{0,0})

* Limit the Width of the Tip Box to <nMaxWidth> Characters.
* Allow for Taller Tip Boxes.
nTipLines:=MLCount(cText,nMaxWidth)

oPS:=::oTip:LockPS()
* Find the Maximum Line Width Required
For I:=1 to nTipLines
    aPoints:=GraQueryTextBox(oPS,Trim(MemoLine(cText,nMaxWidth,I)))
    nTipWidth:=Max(nTipWidth,(aPoints[3,1] - aPoints[1,1]))
Next I
nTipHeight:=(aPoints[1,2] - aPoints[2,2])
aSize:={nTipWidth+13,(nTipHeight+1)*nTipLines+10}

::oTip:UnlockPS()
::oTip:setSize(aSize,.F.)

* Make Sure the Tip Doesn't Run Off the End Of the Screen
aPos[1]:=Max(15,aPos[1])
aPos[1]:=Min(aPos[1],AppDeskTop():CurrentSize()[1]-aSize[1]-15)
aPos[2]:=Max(15,aPos[2])
aPos[2]:=Min(aPos[2],AppDeskTop():CurrentSize()[2]-aSize[2]-15)

::oTip:setPos(aPos,.F.)

oPS:=::oTip:LockPS()

aAreaAttr:=Array( GRA_AA_COUNT )
aAreaAttr[GRA_AA_COLOR]:=7 //  XBPSYSCLR_INFOBACKGROUND
GraSetAttrArea( oPS, aAreaAttr )
GraBox(oPS,{0,0},{aSize[1]-1,aSize[2]-1},GRA_OUTLINEFILL)

aStringAttr:=Array(GRA_AS_COUNT)
aStringAttr[GRA_AS_COLOR]:= XBPSYSCLR_INFOTEXT
GraSetAttrString( oPS, aStringAttr )
nRow:=aSize[2]-nTipHeight-4
For I:=1 to nTipLines
    GraStringAt(oPS,{6,nRow},MemoLine(cText,nMaxWidth,I))
    nRow -= (nTipHeight+1)
Next I

::oTip:UnlockPS(oPS)

Return Self

*************************************************************************
* This function calculates the absolute position
* from a given position relative to an XbasePart
*************************************************************************

Static Function CalcAbsolutePosition(aPos,oXbp)
Local aAbsPos:=AClone(aPos)
Local oParent:=oXbp
Local oDesktop:=AppDesktop()

Do While oParent <> oDesktop
   aAbsPos[1] += oParent:currentPos()[1]
   aAbsPos[2] += oParent:currentPos()[2]
   oParent:=oParent:setParent()
EndDo
Return aAbsPos

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