FiveTech Software tech support forums

Posted: **Mon Aug 22, 2011 8:41 am**

Dear Friends,
This last week of August, I thought how could I create a class that would show a tooltip with 3 parts: a header, a footer and a message to the possibility in the future to include a picture, I took the cue from the class Super tooltips DoNEtTcomponents (http : / / http://www.devcomponents.com / dotnetbar / SuperTooltips.aspx)

I think thi class could run ok if there is a CLASSDATA on WIndows CLASS called otooltip

on ttoltip class see the line // ::oWnd:oToolTip := Self where oWnd is the control where we want show the tooltip

I see this otooltip is only a static value now , but I think Antonio make it for speed!!

Now I use this class simply on bMMoved action then we can insert it as tooltip system

I not know how insert Balloons tooltip But I think Antonio found the solution for it

we can set the size of tooltip and the timer for now and insert an header, an footer, an message
if not therea re not headers and footer it show only the message as the tooltip system

this is the test.prg

Code: Select all


#include "fivewin.ch"

#define CLRTEXTBACK         RGB( 113, 106, 183 )
#define COLOR_GRAYTEXT       17
#define DEFAULT_GUI_FONT     17

#define CS_DROPSHADOW       0x00020000
#define GCL_STYLE           (-26)

fUNCTION TEST ()

Local oDlg,oBtn

DEFINE DIALOG oDlg SIze 400,400


@ 1,1 BUTTON oBtn PROMPT "TEST" SIZE 40,20 OF oDlg

oBtn:cTooltip:= NIL

          oToolTip := TTooltip():New(oBtn)

          cMessage :="This is a Super Tooltip for Fivewin Power"+CRLF+CRLF+CRLF+;
                     "This is also on Beta Test" +CRLF+CRLF+CRLF+;
                     " SuperTooltip with Image (on Future)"
          cHeader := "Header Super Tooltip"
          cFooter := "Press F1 for more Help "

        *  oToolTip:nHeightTip :=300
        *  oToolTip:nWidthTip  :=300
          oToolTip:nTimer     :=1000



          // With header , message and footer 
            oBtn:bMMoved := { || oToolTip:Show( oBtn:ntop - 6, oBtn:nLeft - 6, cHeader, oBtn,cFooter, cMessage ) }  // rem this for try 

           // With header , message   rem this for try 
         // oBtn:bMMoved := { || oToolTip:Show( oBtn:ntop - 6, oBtn:nLeft - 6, cHeader, oBtn,, cMessage ) }    // rem this for try 

        // with only a message
       //  oBtn:bMMoved := { || oToolTip:Show( oBtn:ntop - 6, oBtn:nLeft - 6, , oBtn,, cMessage ) }       // rem this for try 



ACTIVATE DIALOG oDLg


return nil

this the class TToltip .prg

Code: Select all


CLASS TTooltip FROM TWindow


      DATA nHeightRow
      DATA oTimer, nTimer

      DATA oToolTip
      DATA nHeightTip,nWidthTip
      DATA nColorTooltip
      DATA cImage

      DATA cHeader
      DATA cMessage
      DATA cFooter


      CLASSDATA lRegistered AS LOGICAL

      METHOD New( oWnd, nClrText, nClrPane, oFont,nHeightTip,nWidthTip,nTimer,nColorTooltip,cImage) CONSTRUCTOR

      METHOD Hide() INLINE ::lVisible := .f., Super:Hide()

      METHOD Show( nRow, nCol, cHeader, oWnd,cFooter,cMessage )

      METHOD Paint()

      METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor )

     METHOD CalcLen( cMessage )  // calc the text width for simply tooltip

ENDCLASS



 METHOD New( oWnd, nClrText, nClrPane, oFont,nHeightTip,nWidthTip,nTimer,nColorTooltip,cImage )   CLASS TTooltip
         Local  nWText


   DEFAULT nClrText := CLR_BLACK,;
           nColorTooltip  := CLR_YELLOW ,;
           nClrPane := nColorTooltip,;
           nHeightTip:= 300 ,;
           nWidthTip := 300,;
           nTimer    := 1000

       ::nTimer        := nTimer
       ::lVisible      := .f.
       ::oWnd          := oWnd
       ::nHeightTip    := nHeightTip
       ::nWidthTip     := nWidthTip
       ::nColorTooltip := nColorTooltip
       ::cImage        := cImage



      * ::oWnd:oToolTip := Self    //if there is  oToolTip     as class data   on window class



      DEFINE FONT ::oFont NAME GetSysFont() SIZE 0, -8




       ::nHeightRow     := ::oFont:nHeight + 3

       ::nStyle    := nOR( WS_POPUP, WS_BORDER )


       ::SetColor( nClrText, nClrPane )

       ::Register()
       ::Create()
       ::Hide()

Return Self



 METHOD Paint()       CLASS TTooltip

Local hDC := ::GetDC()
Local oThis := self
Local hOldFont
local lHeader :=.f.





IF ::oTimer != nil
   ::oTimer:Deactivate()
endif

DEFINE   TIMER ::oTimer INTERVAL ::nTimer ACTION oThis:Hide() OF Self
ACTIVATE TIMER ::oTimer




         FillSolidRect( ::hDC, GetClientRect(::hWnd), ::nClrPane )




   SetBkMode( ::hDC, 1 )
   hOldFont  := SelectObject( ::hDC,  ::oFont:hFont  )
   SetTextColor( ::hDC, ::nClrText )


   if ::cHeader != nil
      DrawText  ( ::hDC, ::cHeader, { 1, 1  , ::nHeight, ::nWidth }, 16  )
      DrawText  ( ::hDC, ::cMessage, { 40, 10 , ::nHeight, ::nWidth }, 16  )
       oThis:Line( ::hDC, 35, 0, 35,::nWidthTip, CLR_BLUE)
   else
       DrawText  ( ::hDC, ::cMessage, {1, 1 , ::nHeight, ::nWidth }, 16  )
     endif


    if ::cFooter != nil
       DrawText  ( ::hDC, ::cFooter, { ::nHeightTip-30, 40 , ::nHeight, ::nWidth }, 16  )
       oThis:Line( ::hDC, ::nHeightTip-35, 0, ::nHeightTip-35,::nWidthTip, CLR_BLUE)
    endif



   SetBkMode   ( ::hDC, 0 )
   SelectObject( ::hDC, hOldFont )









   if ::bPainted != nil
   Eval( ::bPainted, ::hDC, self )
endif





::ReleaseDC()

return nil



METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor )  CLASS TTooltip

   local hPen, hOldPen


   hPen = CreatePen( PS_SOLID, 1, nColor )
   hOldPen = SelectObject( hDC, hPen )
   MoveTo( hDC, nLeft, nTop )
   LineTo( hDC, nRight, nBottom )
   SelectObject( hDC, hOldPen )
   DeleteObject( hPen )


return nil





 METHOD Show( nRow, nCol, cHeader, oWnd, cFooter, cMessage)   CLASS TTooltip


Local n
Local aPoint := { nRow, nCol }
Local aLin, nCalcLen
Local nHeight
Local nWidth
Local nHScreen := GetSysMetrics(  1  )
Local nWScreen := GetSysMetrics(  0  )
Local nLines

if ::lVisible
   ::Hide()
endif


 //if there is the header and the footer

   if cHeader != nil

     ::cHeader := cHeader
      if  cFooter != nil
      ::cFooter := cFooter
      endif
    if  cMessage  != nil
   ::cMessage:=cMessage
    endif

      nWidth:= ::nHeightTip
      nHeight:=::nWidthTip


   else


    // if there is only the message

   if cMessage != nil
     ::cMessage := cMessage
     aLin :=  ::CalcLen( cMessage )
     nCalcLen  := aLin[1]
     nLines   := aLin[2]
     nWidth   := nCalcLen + 4
     nHeight  := ( nLines * ::nHeightRow ) + 2
  endif

 endif



  ClientToScreen( oWnd:hWnd, aPoint )

  if aPoint[ 1 ] == nRow
     aPoint := ClientToScreen( oWnd:hWnd, aPoint )
  endif

  nRow := aPoint[ 1 ]
  nCol := aPoint[ 2 ]

  if nRow + nHeight > nHScreen
     nRow := nHScreen - nHeight - 10
  endif

  if nCol + nWidth > nWScreen
     nCol := nWScreen - nWidth - 10
  endif




  ::Move( nRow, nCol, nWidth, nHeight , .t. )

  Super:Show()





  ::lVisible := .t.

Return nil






 METHOD CalcLen( cMessage )      CLASS TTooltip

 Local n, cLine
 Local nLines  := mlcount( cMessage )
 Local nCalcLen := 0

  For n := 1 to nLines
      cLine := rtrim( memoline( cMessage,, n))
      nCalcLen := max( nCalcLen, ::GetWidth( cLine, ::oFont ) + 8 )
  next n

return { nCalcLen, nLines }






















#pragma BEGINDUMP
#include "Windows.h"
#include "hbapi.h"


HB_FUNC( FILLSOLIDRECT )
{
    RECT rct;
    COLORREF nColor;
    HPEN hPen, hOldPen;
    HDC hDC = ( HDC ) hb_parnl( 1 );
    rct.top    = hb_parni( 2, 1 );
    rct.left   = hb_parni( 2, 2 );
    rct.bottom = hb_parni( 2, 3 );
    rct.right  = hb_parni( 2, 4 );

    nColor = SetBkColor( hDC, hb_parnl( 3 ) );
    ExtTextOut( hDC, 0, 0, ETO_OPAQUE, &rct, NULL, 0, NULL);
    SetBkColor( hDC, nColor );

    if( hb_pcount()  > 3 )
    {
       hPen = CreatePen( PS_SOLID, 1,(COLORREF)hb_parnl( 4 ));
       hOldPen = (HPEN) SelectObject( hDC, hPen );
       MoveToEx( hDC, rct.left, rct.top, NULL );
       LineTo( hDC, rct.right-3, rct.top );
       LineTo( hDC, rct.right-3, rct.bottom );
       LineTo( hDC, rct.left, rct.bottom );
       LineTo( hDC, rct.left, rct.top );
       SelectObject( hDC, hOldPen );
       DeleteObject( hPen );
    }
}

#pragma ENDDUMP

Posted: **Mon Aug 22, 2011 7:43 pm**

on microsoft site I found we can use the tooltip_class32 with Win32 API

as we made when we use on tfolder the call to ::Create( "SysTabControl32" ) but I not found how make

from microsoft site

" ......To do that you need to create the window using CreateWindowEx and set the class name for it to "tooltip_class32" and a good idea would be to use the TTS_ALWAYSTIP style. You must then send the TTM_ADDTOOL message to this newly created window and use the TTF_SUBCLASS flag (you should also use the TTF_IDISHWND flag and set the hWnd of the tooltip window in the uID member of the TOOLINFO stucture). After that subclass this window and check for the WM_PRINT message in which case you should post a WM_PAINT message and return TRUE. Then do all the work of moving and painting the tooltip when you recieve the WM_PAINT message (just make sure you show the tooltip window before you resize it otherwise you will get another WM_PRINT message and end up with an endless loop. For any other message just let the default WndProc handle it. ...."

Now there is a custom tooltip window class in this forum... I hope You help me to implement it

Posted: **Mon Aug 22, 2011 7:45 pm**

I found a tooltip in PureBasic

Code: Select all

Procedure ToolTip(Win, Id, Style, Center, Icon , FgColor, BgColor, Title.s, Tip.s)

;Adds a tooltip to Id. Style: 0 = ordinary, 1 = balloon. Center: 1 = center the stem

;Icon: 0 = No icon, 1 = Info, 2 = Warn, 3 = Error, (See #TOOLTIP_ constants)

TT = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_BALLOON * Style, 0, 0, 0, 0, 0, 0, 0, 0)
;Color. RGB() or GetSysColor_(See #COLOR_ constants)
If FgColor
;Set the tip text color, also the tip outline color for balloon tooltips
SendMessage_(TT, #TTM_SETTIPTEXTCOLOR, FgColor, 0)
EndIf
If BgColor
;Set the tip background color
SendMessage_(TT, #TTM_SETTIPBKCOLOR, BgColor, 0)
EndIf
TI.TOOLINFO\cbSize = SizeOf(TOOLINFO)
TI\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS | (#TTF_CENTERTIP * Center)
TI\hWnd = WindowID(Win)
TI\uId = GadgetID(Id)
TI\lpszText = @Tip
;Register tooltip with the control
SendMessage_(TT, #TTM_ADDTOOL, 0, TI)
;Set as a multiline tooltip with wordwrap
SendMessage_(TT, #TTM_SETMAXTIPWIDTH, 0, 150)
;Set the icon style and tip title
SendMessage_(TT, #TTM_SETTITLE, Icon, Title)
EndProcedure

Posted: **Wed Aug 24, 2011 7:02 am**

NICE WORK GOOD

Posted: **Sat Aug 27, 2011 7:33 am**

Thanks but I am convinced that the group of Linares is not interested in this class and the changes that must
make windows in the class...

Gracias, pero estoy convencido de que el grupo de Linares no está interesado en esta clase y _ que deben
hacer que las ventanas de la clase

Posted: **Tue Jul 23, 2019 5:53 pm**

Cuasi perfecto.

FiveTech Software tech support forums

Contribution to Forum : new TTOOLTIP CLASS

Contribution to Forum : new TTOOLTIP CLASS

Re: Contribution to Forum : new TTOOLTIP CLASS

Re: Contribution to Forum : new TTOOLTIP CLASS

Re: Contribution to Forum : new TTOOLTIP CLASS

Re: Contribution to Forum : new TTOOLTIP CLASS

Re: Contribution to Forum : new TTOOLTIP CLASS