//----------------------16/01/2008 -> By Rossine------------------------------//
#define TTM_SETMAXTIPWIDTH (WM_USER + 24) && By Rossine
#define TTM_SETTIPTEXTCOLOR (WM_USER + 20) && By Rossine
#define TTM_SETTIPBKCOLOR (WM_USER + 19) && By Rossine
#define TTM_SETTITLE (WM_USER + 32) && By Rossine
#define TTI_NONE 0 && By Rossine
#define TTI_INFO 1 && By Rossine
#define TTI_WARNING 2 && By Rossine
#define TTI_ERROR 3 && By Rossine
#define TTM_SETDELAYTIME (WM_USER + 3)
#define TTDT_AUTOMATIC 0
#define TTDT_RESHOW 1
#define TTDT_AUTOPOP 2
#define TTDT_INITIAL 3
//----------------------------------------------------------------------------//
CLASS TWindow
DATA ltooltipBallon, nTooltipWidth, nTooltipTexColor, nTooltipBKColor, ; && By Rossine
cTooltipTitle, nToolTipIcon, nSetDelayType, nSetDelayTime && By Rossine
DATA ntoolTransparent
DATA hWnd, nOldProc
...
//-> By Rossine, 16/01/2008 Modificado
METHOD ShowToolTip( nRow, nCol, cToolTip ) CLASS TWindow
local aToolTip, nLenToolTip, oTemp, hWnd
if ::nToolTransparent != NIL
settransp( oToolTip, ::nToolTransparent ) && For Win XP only
endif
#ifdef __CLIPPER__
local nTxtWidth := 0, nTxtHeight
local oFont, aPos, hOldFont
#endif
DEFAULT nCol := 7, nRow := ::nHeight() + 7, ;
cToolTip := ::cToolTip
if oToolTip == nil
if ValType( cToolTip ) == "B"
cToolTip = Eval( cToolTip )
endif
DEFINE WINDOW oToolTip FROM 0, 0 TO 1, 5 ;
STYLE nOr( WS_POPUP, WS_BORDER ) ;
COLOR 0, RGB( 255, 255, 225 ) OF Self
oTemp = oToolTip
#ifndef __CLIPPER__
**-----------COMECA AQUI AS MUDANCAS -------------
if ::lToolTipBallon == NIL && By Rossine
::lToolTipBallon := .T.
endif
DestroyWindow( oToolTip:hWnd )
hWnd = CreateToolTip( Self:hWnd, cToolTip, iif( ::ltooltipBallon, .t., .f. ) ) && for ballon tooltips !
//-> hWnd = CreateToolTip( Self:hWnd, cToolTip, .t. ) //for ballon tooltips !
oToolTip = oTemp
oToolTip:hWnd = hWnd
if ::cTooltipTitle != NIL && By Rossine
SendMessage(hwnd, TTM_SETTITLE, iif( ::nToolTipIcon = NIL, TTI_NONE, ::nToolTipIcon ), ::cTooltipTitle ) && By Rossine
endif
if ::nTooltipWidth != NIL && By Rossine
SendMessage(hwnd, TTM_SETMAXTIPWIDTH, 0, ::nTooltipWidth ) && By Rossine
endif
if ::nTooltipTexColor != NIL && By Rossine
SendMessage(hwnd, TTM_SETTIPTEXTCOLOR, ::nTooltipTexColor, 0) && By Rossine
endif
if ::nTooltipBKColor != NIL && By Rossine
SendMessage(hwnd, TTM_SETTIPBKCOLOR, ::nTooltipBKColor, 0) && By Rossine
endif
if ::nSetDelayTime != NIL
SendMessage(hwnd, TTM_SETDELAYTIME, iif( ::nSetDelayType = NIL, TTDT_INITIAL, ::nSetDelayType ), ::nSetDelayTime ) && By Rossine
else
SendMessage(hwnd, TTM_SETDELAYTIME, TTDT_INITIAL, 0 ) && By Rossine
endif
if ::nToolTransparent != NIL && By Rossine (07/09/07)
settransp( oToolTip, ::nToolTransparent ) && For Win XP only
endif
**----------- E TERMINA AQUI -------------
#else
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -8
aPos = { nRow, nCol }
aPos = ClientToScreen( ::hWnd, aPos )
nTxtHeight := Max(14, GetTextHeight( oToolTip:hWnd )-2)
aToolTip = Array( nLenToolTip := MLCount( cToolTip, 254 ) )
AEval( aToolTip, {|c, n| aToolTip[ n ] := Trim( MemoLine( cToolTip, 252, n ) ), ;
nTxtWidth := Max( nTxtWidth, GetTextWidth( 0, aToolTip[ n ], oFont:hFont ) + 7 ) } )
if aPos[ 2 ] + nTxtWidth + 3 > GetSysMetrics( SM_CXSCREEN )
aPos[ 2 ] = GetSysMetrics( SM_CXSCREEN ) - nTxtWidth - 3
endif
oToolTip:Move( aPos[ 1 ], aPos[ 2 ], nTxtWidth, nTxtHeight * nLenToolTip + 3 )
oToolTip:Show()
#ifdef __CLIPPER__
SysRefresh()
if oToolTip != nil
#endif
SetBkMode( oToolTip:GetDC(), 1 )
SetTextColor( oToolTip:hDC, 0 )
hOldFont = SelectObject( oToolTip:hDC, oFont:hFont )
AEval( aToolTip, {| c, n | TextOut( oToolTip:hDC, n * nTxtHeight - (nTxtHeight-1), 2, aToolTip[ n ] ) } )
SelectObject( oToolTip:hDC, hOldFont )
oToolTip:ReleaseDC()
#ifdef __CLIPPER__
endif
#endif
oFont:End()
#endif
if oToolTip != nil
hToolTip = oToolTip:hWnd
endif
endif
lToolTip = .t.
return nil
//... e no final do arquivo window.prg
//... y al final del archivo window.prg
#define LWA_ALPHA 2
*************************
static function settransp( oCtl, nFactor )
*************************
LOCAL NX
//SETWINDOWLONG( oCtl:hWnd, GWL_EXSTYLE, NOR( GETWINDOWLONG( oCtl:hWnd, GWL_EXSTYLE ), WS_EX_LAYERED ) )
//SETLAYEREDWINDOWATTRIBUTES( oCtl:hWnd, , nFactor, LWA_ALPHA )
//->Olá Rossine,
//->Tente isso :
SetWindowLong( oCtl:hWnd, GWL_EXSTYLE, nOR( GetWindowLong( oCtl:hWnd, GWL_EXSTYLE ), WS_EX_LAYERED ) )
For nX := 2 To 18
SetLayeredWindowAttributes( oCtl:hWnd, nRgb(255,255,127), nX*12.75, 3 )
Next
//-> Vagner Wirts
return NIL
DLL32 function SetLayeredWindowAttributes( hWnd As LONG, crKey As LONG, ;
bAlpha As LONG, dwFlags As LONG ) AS LONG PASCAL ;
from "SetLayeredWindowAttributes" lib "user32.DLL"
//----------------------------------------------------------------------------//
//Abs,
//Rossine
// en tu .prgs haga asi:
REDEFINE GET aGetVenda[1] VAR nNumeroTel PICTURE "@K!" ;
ID 20 OF oDlgVendas ;
COLOR nRGB( 000, 000, 000 ), nRGB( 243, 250, 200 ) ;
WHEN( lLigaCliente ) ;
CURSOR oHand FONT oFnt UPDATE BITMAP "BUSCAR" ;
VALID ( PESQUISA_TELEFONE( nNumeroTel, aGetVenda, oLbx, ;
DbClientes, DbEstoque, DbPedidos, DbFornece ) ) ;
ACTION( PESQUISA_TELEFONE( nNumeroTel := [00000000000000000], ;
aGetVenda, oLbx, DbClientes, ;
DbEstoque, DbPedidos, DbFornece ) )
//-> ESTA EM \SAMPLES\TESTGET3.PRG
//aGetVenda[1]:Disable()
aGetVenda[1]:lBtnTransparent := .T. // transparent button get aGetVenda[1]
aGetVenda[1]:lAdjustBtn := .T. // Button Get Adjust Witdh aGetVenda[1]
aGetVenda[1]:lDisColors := .F. // Deactive disable color
aGetVenda[1]:nClrTextDis := CLR_WHITE // Color text disable status
aGetVenda[1]:nClrPaneDis := CLR_BLUE // Color Pane disable status
aGetVenda[1]:bKeyDown := { |nKey| IF( nKey == VK_F7, Eval( aGetVenda[1]:bAction ), Nil ) }
//-> By Rossine The Best Mineiro - Mudancas em WINDOW.PRG 16/01/2008
aGetVenda[1]:cToolTip := OemToAnsi( "Click no BotÆo ao Lado, " + ;
"Para Visualizar o Banco " + ;
"de Dados dos Clientes " + ;
"Veja os Nomes/Telefones " + ;
"<F7>-Visualizar. " + ;
"Se o Telefone NÆo For " + ;
"Localizado, Dispara " + ;
"Para o Cadastro de " + ;
"Clientes. " + ;
"Incluir, Excluir, " + ;
"Alterar, Pesquisar." )
aGetVenda[1]:lToolTipBallon := .T.
aGetVenda[1]:nTooltipWidth := 200
aGetVenda[1]:nTooltipTexColor := nRGB( 000, 000, 000 )
aGetVenda[1]:nTooltipBKColor := nRGB( 250, 250, 250 )
aGetVenda[1]:cTooltipTitle := OemToAnsi( "Telefone do Cliente" )
aGetVenda[1]:nTooltipIcon := 1 && 0=NONE / 1=TTI_INFO / 2=TTI_WARNING / 3=TTI_ERROR
//-> 0=TTDT_AUTOMATIC / 1=TTDT_RESHOW / 2=TTDT_AUTOPOP / 3=TTDT_INITIAL
aGetVenda[1]:nSetDelayType := 2
aGetVenda[1]:nSetDelayTime := 32767 //-> Velocidade do TOOLTIP-> +- 1:30 Secs
