romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ee36dfc028d4f24711b90fb88d4e2c54c869d40e
comun/utile/ctl32/ctl32_balloontip.vc2

1434 lines
44 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_balloontip.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS ctl32_balloontip AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="tmrHide" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="tmrShow" UniqueID="" Timestamp="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: ctl32_addproperties
*m: ctl32_bindevents
*m: ctl32_create
*m: ctl32_declaredlls
*m: ctl32_seticonandtitle
*m: ctl32_setlangstrings
*m: ctlactive_assign
*m: ctlcapslockstyle_assign
*m: ctlclosebutton_assign
*m: ctlfadein_assign
*m: ctlfadeout_assign
*m: ctlhide
*m: ctlhidedelay_assign
*m: ctlhwnd_access
*m: ctlhwnd_assign
*m: ctliconlarge_assign
*m: ctlicon_assign
*m: ctllangid_assign
*m: ctllink_access
*m: ctlmargin_assign
*m: ctlmaxwidth_assign
*m: ctlopenlink
*m: ctlstyle_assign
*m: ctltext_assign
*m: ctltitle_assign
*m: ctlvisible_assign
*m: evthandler_form_moved
*m: evthandler_form_resize
*m: evthandler_form_wm_keydown
*m: evthandler_host_wm_lbuttondown
*m: evthandler_host_wm_notify
*m: evthandler_screen_moved
*p: ctlabout
*p: ctlactive
*p: ctlcapslockstyle
*p: ctlclosebutton
*p: ctlcontrol
*p: ctlfadein
*p: ctlfadeout
*p: ctlhidedelay
*p: ctlhwnd && Specifies the Window handle of the Window.
*p: ctlicon
*p: ctliconlarge
*p: ctllangid
*p: ctlleft
*p: ctllink
*p: ctllinklabel
*p: ctllinkurl
*p: ctlmargin && Sets the top, left, bottom, and right margins for a ToolTip window. A margin is the distance, in pixels, between the ToolTip window border and the text contained within the ToolTip window.
*p: ctlmaxwidth && Sets the maximum width for a ToolTip window.
*p: ctlpositionstyle
*p: ctlstyle && 0 = Balloon; 1 = Rectangular; 2 = Rectangular with no borders
*p: ctltext
*p: ctltitle
*p: ctltop
*p: ctlversion
*p: ctlvisible
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
BackColor = 140,200,200
ctlabout = ctl32_scontainer - Carlos Alloatti.
ctlactive = .T.
ctlcapslockstyle = .F.
ctlclosebutton = .F.
ctlcontrol =
ctlfadein = .F.
ctlfadeout = .F.
ctlhidedelay = 5000
ctlhwnd = 0
ctlicon = 0
ctliconlarge = .F.
ctllangid = 0
ctlleft = 0
ctllink =
ctllinklabel =
ctllinkurl =
ctlmargin = 0
ctlmaxwidth = 256
ctlpositionstyle = 1
ctlstyle = 1
ctltext = BalloonTip text
ctltitle = BalloonTip title
ctltop = 0
ctlversion = 20061010
ctlvisible = .F.
ForeColor = 255,0,245
Height = 48
Name = "ctl32_balloontip"
Visible = .F.
Width = 120
*</PropValue>
ADD OBJECT 'lblname' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "ctl32_balloontip", ;
FontName = "Tahoma", ;
FontSize = 8, ;
ForeColor = 0,0,128, ;
Height = 15, ;
Left = 6, ;
Name = "lblname", ;
Top = 3, ;
Width = 77
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'tmrHide' AS timer WITH ;
Enabled = .F., ;
Height = 23, ;
Interval = 0, ;
Left = 120, ;
Name = "tmrHide", ;
Top = 0, ;
Width = 23
*< END OBJECT: BaseClass="timer" />
ADD OBJECT 'tmrShow' AS ctl32_balloontip_show WITH ;
Enabled = .F., ;
Interval = 200, ;
Left = 192, ;
Name = "tmrShow"
*< END OBJECT: ClassLib="ctl32_balloontip.vcx" BaseClass="timer" />
HIDDEN PROCEDURE ctl32_addproperties
*!* Here we add properties to the class that will be used internally
*!* This will hold an object reference to a custom icon to display in balloontip
This.AddProperty([oIcon], Null)
*!* Add oToolInfo property with TOOLINFO structure value
This.AddProperty([oToolInfo], Newobject([_ToolInfo], [ctl32_structs.vcx]))
This.AddProperty([oRect], Newobject([_Rect], [ctl32_structs.vcx]))
*!* Add Macros object
This.AddProperty([oMacros], Newobject([_Macros], [ctl32_structs.vcx]))
*!* Used by evtHandler_WM_NOTIFY
This.Addproperty([loNmhdr],Newobject([_Nmhdr], [ctl32_structs.vcx]))
*!* Stores the hWnd of the host window
This.AddProperty([nHosthWnd], This.oUtil._HostHWnd())
*!* Indicates we are in the creation stage
This.AddProperty([lCreating], FALSE)
*!* Stores the value of VFP window procedure
This.Addproperty([nVFPWndProc], This.oUtil._VFPWndProc())
*!* Stores hWnd of Windows common control created by the class
This.AddProperty([nCtlHwnd], 0)
*!* These 2 properties hold the title and text for the capslock balloontip
This.AddProperty([cLangTitle], [])
This.AddProperty([cLangText], [])
ENDPROC
HIDDEN PROCEDURE ctl32_bindevents
Bindevent(Thisform, [RESIZE], This, [EvtHandler_Form_Resize], 1)
Bindevent(Thisform, [MOVED], This, [EvtHandler_Form_Moved], 1)
Bindevent(_Screen, [MOVED], This, [EvtHandler_Screen_Moved], 1)
Bindevent(Thisform.HWnd, WM_KEYDOWN, This, [EvtHandler_Form_WM_KEYDOWN], 1)
Bindevent(This.nHosthWnd, WM_LBUTTONDOWN, This, [EvtHandler_Host_WM_LBUTTONDOWN], 1)
*!* Catch clicks in links
Bindevent(This.nHosthWnd, WM_NOTIFY, This, [EvtHandler_Host_WM_NOTIFY], 1)
ENDPROC
HIDDEN PROCEDURE ctl32_create
*!* This procedure creates the Window common control and sets its initial properties
With This
*!* Destroy current tooltip window if present
If .nCtlHwnd <> 0 Then
DestroyWindow(.nCtlHwnd)
.nCtlHwnd = 0
Endif
.lCreating = TRUE
*!* Set CreateWindowEx parameters
m.dwExStyle = 0
m.lpClassName = TOOLTIPS_CLASSA
m.lpWindowName = []
m.dwStyle = Bitor(WS_POPUP, TTS_NOANIMATE)
If .ctlStyle = CON_STYLE_BALLOON
m.dwStyle = Bitor(m.dwStyle, TTS_BALLOON)
Endif
If .ctlCloseButton = TRUE Then
m.dwStyle = Bitor(m.dwStyle, TTS_CLOSE)
Endif
If .ctlFadeIn = FALSE Then
m.dwStyle = Bitor(m.dwStyle, TTS_NOFADE)
Endif
m.hWndParent = 0
m.hMenu = 0
m.hInstance = This.oUtil._HInstance()
m.lpParam = 0
.nCtlHwnd = CreateWindowEx( ;
m.dwExStyle, ;
m.lpClassName, ;
m.lpWindowName, ;
m.dwStyle, ;
CW_USEDEFAULT, ;
CW_USEDEFAULT, ;
CW_USEDEFAULT, ;
CW_USEDEFAULT, ;
m.hWndParent, ;
m.hMenu, ;
m.hInstance, ;
m.lpParam)
*!* Add TOOL
.oToolInfo._uFlags = Bitor(TTF_IDISHWND, TTF_TRACK, TTF_TRANSPARENT, TTF_PARSELINKS, TTF_BITMAP)
If .ctlStyle <> CON_STYLE_BALLOON Then && Not balloon style
.oToolInfo._uFlags = Bitor(.oToolInfo._uFlags, TTF_ABSOLUTE)
Endif
.oToolInfo._hWnd = This.nHosthWnd
.oToolInfo._hInst = 0
.oToolInfo._uId = This.nHosthWnd
.oToolInfo._Left = 0
.oToolInfo._Top = 0
.oToolInfo._Right = 0
.oToolInfo._Bottom = 0
.oToolInfo._lpszTextString = 0h00
.oToolInfo._lParam = 0
m.lcToolInfo = .oToolInfo._Struct
SendMessageC(.nCtlHwnd, TTM_ADDTOOLA, 0, @m.lcToolInfo)
This.ctlIcon = This.ctlIcon && also assigns _tiptitle
This.ctlText = This.ctlText
This.ctlHideDelay = This.ctlHideDelay
This.ctlMaxWidth = This.ctlMaxWidth
This.ctlMargin = This.ctlMargin
If .ctlStyle = CON_STYLE_NOBORDER Then
*!* Borders have no effect on Vista
If This.oUtil._OSVersion() < CON_OS_WINVISTA Then
m.dwStyle = GetWindowLong(.ctlHWnd, GWL_EXSTYLE)
m.dwStyle = Bitclear(m.dwStyle, CON_BIT_WS_BORDER)
*!* Have to remove TTS_CLOSE button:
If .ctlCloseButton = FALSE Then
m.dwStyle = Bitclear(m.dwStyle, CON_BIT_TTS_CLOSE)
Endif
SetWindowLong(.ctlHWnd, GWL_STYLE, m.dwStyle)
*!* This makes the window "refresh"
SetWindowPos(.ctlHWnd, ;
0, ;
0, ;
0, ;
0, ;
0, ;
BITOR(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_NOACTIVATE, SWP_FRAMECHANGED))
Endif
Endif
.lCreating = FALSE
Endwith
ENDPROC
HIDDEN PROCEDURE ctl32_declaredlls
*!* This procedure registers the Windows API functions used by the class
*!* An array of existing declared API functions is created and checked to
*!* prevent re-declaration of API functions.
*!* When a function is used with an ALIAS, it is first declared with an ALIAS
*!* equal to the original name, and then declared again with the desired alias.
*!* This is because of a bug in VFP:
*!* If you declare an API function with an alias, and later declare the same api
*!* function without an alias, the first aliased declaration dissapears.
*!* We create an empty array first because if there are no API declarations
*!* adlls will not create the array and ascan will fail
Local Array laDeclaredDlls(1,3)
Local lnLen
m.lnLen = Adlls(m.laDeclaredDlls)
*!* win32api is used instead of the library name, check these:
*!* blogs.msdn.com/calvin_hsia/archive/2006/04/27/585305.aspx
*!* blogs.msdn.com/calvin_hsia/archive/2006/04/24/582479.aspx
*!* "User32.dll, Gdi32.dll, Kernel32.dll , Advapi32.dll and Mpr.dll are searched (in that order)"
If Ascan(m.laDeclaredDlls, [CallWindowProc], 1, m.lnLen , 2, 15) = 0
Declare Integer CallWindowProc In win32api ;
Integer lpPrevWndFunc,;
Integer HWnd,;
Integer msg,;
Integer wParam,;
Integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [ClientToScreen], 1, m.lnLen , 2, 15) = 0
Declare Integer ClientToScreen In win32api ;
Integer HWnd, ;
String @ lpPoint
Endif
If Ascan(m.laDeclaredDlls, [CreateWindowEx], 1, m.lnLen , 2, 15) = 0
Declare Integer CreateWindowEx In win32api As CreateWindowEx ;
Integer dwExStyle,;
String lpClassName,;
String lpWindowName,;
Integer dwStyle,;
Integer x,;
Integer Y,;
Integer nWidth,;
Integer nHeight,;
Integer hWndParent,;
Integer hMenu,;
Integer hInstance,;
Integer lpParam
Endif
If Ascan(m.laDeclaredDlls, [DestroyWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer DestroyWindow In win32api As DestroyWindow ;
Integer HWnd
Endif
If Ascan(m.laDeclaredDlls, [GetCaretPos], 1, m.lnLen , 2, 15) = 0
Declare Integer GetCaretPos In win32api ;
String @ lpPoint
Endif
If Ascan(m.laDeclaredDlls, [GetCursorPos], 1, m.lnLen , 2, 15) = 0
Declare Integer GetCursorPos In win32api ;
String @ lpPoint
Endif
If Ascan(m.laDeclaredDlls, [GetKeyState], 1, m.lnLen , 2, 15) = 0
Declare Integer GetKeyState In win32api ;
Integer nVirtKey
Endif
If Ascan(m.laDeclaredDlls, [GetLocaleInfo], 1, m.lnLen , 2, 15) = 0
Declare Integer GetLocaleInfo In win32api ;
Integer Locale, ;
Integer LCType, ;
String lpLCData, ;
Integer cchData
Endif
If Ascan(m.laDeclaredDlls, "GetSysColor", 1, m.lnLen , 2, 15) = 0
Declare Integer GetSysColor In win32api ;
Integer nIndex
Endif
If Ascan(m.laDeclaredDlls, [GetWindowLong], 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindowLong In win32api As GetWindowLong;
Integer HWnd, ;
Integer nIndex
Endif
If Ascan(m.laDeclaredDlls, [GetWindowRect], 1, m.lnLen , 2, 15) = 0
Declare Integer GetWindowRect In win32api ;
integer HWnd,;
string @ lcRect
Endif
If Ascan(m.laDeclaredDlls, [ScreenToClient], 1, m.lnLen , 2, 15) = 0
Declare Integer ScreenToClient In win32api ;
Integer HWnd,;
string @ lpPoint
Endif
If Ascan(m.laDeclaredDlls, [SendMessage], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessage ;
Integer HWnd,;
Integer Msg,;
Integer wParam,;
Integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [SendMessageC], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageC ;
Integer HWnd,;
Integer Msg,;
Integer wParam,;
String @ Lparam
Endif
If Ascan(m.laDeclaredDlls, [SendMessageN], 1, m.lnLen , 2, 15) = 0
Declare Integer SendMessage In win32api As SendMessageN ;
Integer HWnd,;
Integer Msg,;
Integer wParam,;
Integer Lparam
Endif
If Ascan(m.laDeclaredDlls, [SetWindowLong], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowLong In win32api ;
Integer HWnd,;
Integer nIndex,;
Integer dwNewLong
Endif
If Ascan(m.laDeclaredDlls, [SetWindowPos], 1, m.lnLen , 2, 15) = 0
Declare Integer SetWindowPos In win32api As SetWindowPos;
Integer HWnd,;
Integer hWndInsertAfter,;
Integer x,;
Integer Y,;
Integer cx,;
Integer cy,;
Integer wFlags
Endif
If Ascan(m.laDeclaredDlls, [ShellExecute], 1, m.lnLen , 2, 15) = 0
Declare Integer ShellExecute In shell32 ;
Integer HWnd,;
String @ lpOperation,;
String @ lpFile,;
String @ lpParameters,;
String @ lpDirectory,;
Integer nShowCmd
Endif
*!* We must prevent Beautify from changing the case of "ShowWindow" since its also a VFP keyword
*#beautify keyword_nochange
If Ascan(m.laDeclaredDlls, [ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
If Ascan(m.laDeclaredDlls, [_ShowWindow], 1, m.lnLen , 2, 15) = 0
Declare Integer ShowWindow In win32api As _ShowWindow ;
Integer HWnd,;
Integer nCmdShow
Endif
*#beautify
If Ascan(m.laDeclaredDlls, [WindowFromPoint], 1, m.lnLen , 2, 15) = 0
Declare Integer WindowFromPoint In win32api;
Integer xPoint,;
Integer yPoint
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_seticonandtitle
Local lnIcon, lcText
m.lnIcon = This.ctlIcon
*!* Check if a large icon is desired
If This.oUtil._OSVersion() >= CON_OS_WINVISTA And This.ctlIconLarge = TRUE Then
If Between(m.lnIcon, 1, 3) Then
m.lnIcon = m.lnIcon + 3
Endif
Endif
m.lctitle = Alltrim(Transform(This.ctlTitle, [@T]))
If Empty(m.lctitle) And This.ctlIcon > 0 Then
m.lctitle = [ ]
Endif
m.lctitle = m.lctitle + 0h00
SendMessageC(This.nCtlHwnd, TTM_SETTITLEA, m.lnIcon, @m.lctitle)
ENDPROC
HIDDEN PROCEDURE ctl32_setlangstrings
*!* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/nls_34rz.asp
*!* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/nls_8xo3.asp
*!* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/nls_61df.asp
*!* Sets the value of strings that are language dependant.
Local lcLocaleInfo As Character, ;
lnCharsRet As Number, ;
lcTitle As Character ;
lcText As Character, ;
lnLangID As Number, ;
lnPrimaryLangID As Number, ;
lnSubLangID As Number
If This.ctlLangID = 0x0 Then
m.lcLocaleInfo = Replicate(Chr(0), 5)
m.lnCharsRet = GetLocaleInfo(LOCALE_SYSTEM_DEFAULT , LOCALE_ILANGUAGE, @m.lcLocaleInfo, Len(m.lcLocaleInfo))
m.lcLocaleInfo = Left(m.lcLocaleInfo, m.lnCharsRet -1) && remove ending chr(0)
m.lnLangID = Evaluate([0x] + m.lcLocaleInfo)
Else
*!* If ctlLangID is <> 0 then it overrides the system locale language
m.lnLangID = This.ctlLangID
Endif
m.lnPrimaryLangID = This.oMacros._PRIMARYLANGID(m.lnLangID)
m.lnSubLangID = This.oMacros._SUBLANGID(m.lnLangID)
*!* m.lnLangID = This.oMacros._MAKELANGID(m.lnPrimaryLangID, m.lnSubLangID)
*!* ?Transform(lnPrimaryLangID, [@0]), Transform(m.lnSubLangID, [@0]), Transform(m.lnLangID, [@0])
Do Case
Case m.lnPrimaryLangID = LANG_BASQUE && 0x2d
m.lcTitle = "Blok Maius piztuta dago"
m.lcText = "Blok Maius piztuta edukiz gero, zure pasahitza behar ez den bezala sar dezakezu.\r\n\r\nSakatu Blok Maius piztuta egon ez dadila zure pasahitza sartu baino lehen."
Case m.lnPrimaryLangID = LANG_CATALAN && 0x03
m.lcTitle = "La tecla Bloq Maj est<73> activada"
m.lcText = "Si teniu la tecla Bloq Maj activada, podr<64>eu introduir la contrasenya incorrectament.\r\n\r\nHaur<75>eu de pr<70>mer Bloq Maj per desactivar-la abans d'escriure la vostra contrasenya."
Case m.lnPrimaryLangID = LANG_CROATIAN And m.lnSubLangID = SUBLANG_CROATIAN_CROATIA && 0x1a 0x01
m.lcTitle = "Caps Lock je ukljucen"
m.lcText = "Ako je ukljucen Caps Lock mo<6D>e se dogoditi da upi<70>ete krivu lozinku.\r\n\r\nTrebate pritisnuti Caps Lock kako biste ga iskljucili prije unosa lozinke."
Case m.lnPrimaryLangID = LANG_CZECH && 0x05
m.lcTitle = "Re<52>im Caps Lock je aktivn<76>"
m.lcText = "Zapnut<75> re<72>imu Caps Lock mu<6D>e zpusobit nespr<70>vn<76> zad<61>n<EFBFBD> hesla.\r\n\r\nPred zad<61>n<EFBFBD>m hesla vypnete re<72>im Caps Lock stisknut<75>m kl<6B>vesy Caps Lock."
Case m.lnPrimaryLangID = LANG_DANISH && 0x06
m.lcTitle = "Caps Lock er sl<73>et til"
m.lcText = "Hvis Caps Lock er sl<73>et til, kan det det medf<64>re, at adgangskoden bliver skrevet forkert.\r\n\r\nDu b<>r trykke p<> Caps Lock for at sl<73> den fra, f<>r du skriver adgangskoden."
Case m.lnPrimaryLangID = LANG_DUTCH && 0x13
m.lcTitle = "De toets CapsLock staat aan"
m.lcText = "Als de toets CapsLock is ingeschakeld, wordt het wachtwoord mogelijk onjuist ingevoerd.\r\n\r\nDruk op CapsLock alvorens het wachtwoord in te voeren."
Case m.lnPrimaryLangID = LANG_ENGLISH && 0x09
m.lcTitle = "Caps Lock is On"
m.lcText = "Having Caps Lock on may cause you to enter your password incorrectly.\r\n\r\nYou should press Caps Lock to turn it off before entering your password."
Case m.lnPrimaryLangID = LANG_ESTONIAN && 0x25
m.lcTitle = "Suurt<72>helukk on sisse l<>litatud"
m.lcText = "Sissel<65>litatud suurt<72>helukk v<>ib p<>hjustada teie parooli vale sisestamise.\r\n\r\nEnne parooli sisestamist peaksite suurt<72>heluku klahvi Caps Lock vajutamisega v<>lja l<>litama."
Case m.lnPrimaryLangID = LANG_FINNISH && 0x0b
m.lcTitle = "Caps Lock on p<><70>ll<6C>"
m.lcText = "Jos Caps Lock on p<><70>ll<6C> salasanan isot ja pienet kirjaimet saattavat vaihtua.\r\n\r\nOta Caps Lock pois p<><70>lt<6C> ennen salasanan kirjoittamista."
Case m.lnPrimaryLangID = LANG_FRENCH && 0x0c
m.lcTitle = "La touche Verr. Maj. est active"
m.lcText = "La touche Verr. Maj. est enfonc<6E>e, ce qui peut fausser la saisie de votre mot de passe.\r\n\r\nAppuyez sur Verr. Maj. pour la d<>sactiver, puis entrez votre mot de passe."
Case m.lnPrimaryLangID = LANG_GALICIAN && 0x56
m.lcTitle = "A tecla Bloq Mai<61>s est<73> activada"
m.lcText = "Coa tecla Bloq Mai<61>s activada <20> prob<6F>bel que introduza o seu contrasinal de forma incorrecta.\r\n\r\nPr<50>maa para a desactivar antes de introducir o seu contrasinal."
Case m.lnPrimaryLangID = LANG_GERMAN && 0x07
m.lcTitle = "Feststelltaste ist aktiviert"
m.lcText = "Das Kennwort wird eventuell falsch eingegeben, wenn die Feststelltaste aktiviert ist.\r\n\r\nSie sollten die Feststelltaste deaktivieren, bevor Sie ein Kennwort eingeben."
Case m.lnPrimaryLangID = LANG_HUNGARIAN && 0x0e
m.lcTitle = "A Caps Lock be van kapcsolva"
m.lcText = "Ha be van kapcsolva a Caps Lock, elofordulhat, hogy hib<69>san adja meg a jelsz<73>t.\r\n\r\nA jelsz<73> be<62>r<EFBFBD>sa elott <20>rdemes kikapcsolnia a Caps Lock billentyu megnyom<6F>s<EFBFBD>val."
Case m.lnPrimaryLangID = LANG_ICELANDIC && 0x0f
m.lcTitle = "Stafal<61>s er virkur"
m.lcText = "Ef stafal<61>s er virkur g<>ti a<>gangsor<6F> veri<72> f<>rt inn <20> rangan h<>tt.\r\n\r\nSty<74>ja <20>tti <20> stafal<61>s til a<> gera hann <20>virkan <20><>ur en a<>gangsor<6F>i<EFBFBD> er f<>rt inn."
Case m.lnPrimaryLangID = LANG_INDONESIAN && 0x21
m.lcTitle = "Caps Lock dalam posisi On"
m.lcText = "Bila Caps Lock dalam posisi ON, ada kemungkinan Anda keliru memasukkan sandi.\r\n\r\nAnda harus menekan Caps Lock untuk mematikannya sebelum memasukkan sandi."
Case m.lnPrimaryLangID = LANG_ITALIAN && 0x10
m.lcTitle = "BLOC MAIUSC - Attivato"
m.lcText = "Se il tasto BLOC MAIUSC <20> attivo pu<70> accadere di digitare la password in modo errato.\r\n\r\nPremere il tasto BLOC MAIUSC per disattivarlo prima di digitare la password."
Case m.lnPrimaryLangID = LANG_LATVIAN && 0x26
m.lcTitle = "Ir ieslegts taustin<69> Caps Lock"
m.lcText = "Ja ir ieslegts taustin<69> Caps Lock, parole, iespejams, tiks ievadita nepareizi.\r\n\r\nLai to izslegtu, pirms paroles ievadi<64>anas taustin<69> Caps Lock janospie<69>."
Case m.lnPrimaryLangID = LANG_LITHUANIAN && 0x27
m.lcTitle = "Ijungtas mygtukas Caps Lock"
m.lcText = "Jei mygtukas Caps Lock yra ijungtas, del to galite neteisingai ivesti slapta<74>odi.\r\n\r\nPrie<69> ivesdami slapta<74>odi spustelekite mygtuka Caps Lock, kad ji i<>jungtumete."
Case m.lnPrimaryLangID = LANG_MALAY && 0x3e
m.lcTitle = "Caps Lock Dipasang"
m.lcText = "Penggunaan Caps Lock mungkin akan menyebabkan anda memasukkan kata laluan yang salah.\r\n\r\nAnda sepatutnya menekan Caps Lock untuk mematikannya sebelum memasukkan kata laluan."
Case m.lnPrimaryLangID = LANG_NORWEGIAN && 0x14
m.lcTitle = "Caps Lock er p<>"
m.lcText = "Hvis Caps Lock er p<>, kan det f<>re til at passord skrives inn feil.\r\n\r\nPass p<> at Caps Lock er sl<73>tt av f<>r du skriver inn passordet."
Case m.lnPrimaryLangID = LANG_POLISH && 0x15
m.lcTitle = "Klawisz Caps Lock jest wlaczony"
m.lcText = "Wpisywanie przy wlaczonym klawiszu Caps Lock moze spowodowac niepoprawne wprowadzenie hasla.\r\n\r\nPrzed wprowadzeniem hasla nacisnij klawisz Caps Lock, aby go wylaczyc."
Case m.lnPrimaryLangID = LANG_PORTUGUESE And m.lnSubLangID = SUBLANG_PORTUGUESE_BRAZILIAN && 0x16 0x01
m.lcTitle = "Caps Lock est<73> ativada"
m.lcText = "Se Caps Lock estiver ativado, isso pode fazer com que voc<6F> digite a senha incorretamente.\r\n\r\nVoc<6F> deve pressionar a tecla Caps Lock para desativ<69>-la antes de digitar a senha."
Case m.lnPrimaryLangID = LANG_PORTUGUESE And m.lnSubLangID = SUBLANG_PORTUGUESE_PORTUGAL && 0x16 0x02
m.lcTitle = "Caps Lock est<73> ligado"
m.lcText = "Ter Caps Lock ligado pode fazer com que introduza incorrectamente a palavra-passe.\r\n\r\nDeve premir Caps Lock para desactivar antes de introduzir a sua palavra-passe."
Case m.lnPrimaryLangID = LANG_ROMANIAN && 0x18
m.lcTitle = "Tasta Caps Lock este activata"
m.lcText = "Daca tasta Caps Lock este activata exista posibilitatea sa introduceti parola incorect.\r\n\r\nApasati tasta Caps Lock pentru a o dezactiva <20>nainte de a introduce parola."
Case m.lnPrimaryLangID = LANG_SERBIAN And m.lnSubLangID = SUBLANG_SERBIAN_LATIN && 0x1a 0x02
m.lcTitle = "Taster Caps Lock je ukljucen"
m.lcText = "Ako je ukljucen taster Caps Lock, mo<6D>e se desiti da unesete pogre<72>nu lozinku.\r\n\r\nTrebalo bi da pritisnete taster Caps Lock da biste ga iskljucili pre uno<6E>enja lozinke."
Case m.lnPrimaryLangID = LANG_SLOVAK && 0x1b
m.lcTitle = "Kl<4B>ves Caps Lock je zapnut<75>"
m.lcText = "Ak je zapnut<75> kl<6B>ves Caps Lock, heslo m<><6D>e byt zadan<61> nespr<70>vne.\r\n\r\nPred zadan<61>m hesla vypnite kl<6B>ves Caps Lock."
Case m.lnPrimaryLangID = LANG_SLOVENIAN && 0x24
m.lcTitle = "Tipka Caps Lock je vkljucena"
m.lcText = "Ce je vkljucena tipka Caps Lock, se lahko zgodi, da boste nepravilno vnesli svoje geslo.\r\n\r\nPreden vnesete geslo, pritisnite tipko Caps Lock, da izklopite funkcijo."
Case m.lnPrimaryLangID = LANG_SPANISH && 0x0a
m.lcTitle = "Bloq May<61>s activado"
m.lcText = "Si tiene activada la tecla Bloq May<61>s es posible que escriba incorrectamente su contrase<73>a.\r\n\r\nPresione la tecla Bloq May<61>s para desactivarla antes de escribir su contrase<73>a."
Case m.lnPrimaryLangID = LANG_SWEDISH && 0x1d
m.lcTitle = "Caps Lock <20>r aktiverat"
m.lcText = "Om Caps Lock <20>r aktiverat kanske du skriver in ditt l<>senord felaktigt.\r\n\r\nInaktivera Caps Lock innan du anger ditt l<>senord."
Case m.lnPrimaryLangID = LANG_TURKISH && 0x1f
m.lcTitle = "Caps Lock A<>ik"
m.lcText = "A<>ik Caps Lock parolanizi yanlis girmenize sebep olabilir.\r\n\r\nParolanizi girmeden <20>nce kapatmak i<>in Caps Lock tusuna basmalisiniz."
Otherwise
m.lcTitle = "Caps Lock is On"
m.lcText = "Having Caps Lock on may cause you to enter your password incorrectly.\r\n\r\nYou should press Caps Lock to turn it off before entering your password."
Endcase
This.cLangTitle = m.lcTitle
This.cLangText = Strtran(m.lcText, [\r\n], CRLF)
ENDPROC
HIDDEN PROCEDURE ctlactive_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.ctlActive = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
If This.ctlCapsLockStyle And This.ctlActive And Capslock() Then
This.ctlVisible = TRUE
Endif
*!* Hide if not Active
If This.ctlActive = FALSE Then
This.ctlVisible = FALSE
Else
SendMessage(This.nCtlHwnd, TTM_ACTIVATE, 1, 0)
Endif
ENDPROC
HIDDEN PROCEDURE ctlcapslockstyle_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.ctlCapsLockStyle = m.vNewVal
If This.ctlCapsLockStyle Then
This.ctlVisible = FALSE
*!* Set HideDelay
This.ctlHideDelay = 5000
*!* Set TipPositionStyle to CARET
This.ctlPositionStyle = CON_BTPOS_CARET
*!* Set Icon
This.ctlIcon = TTI_WARNING
*!* Set title and text
This.ctlTitle = This.cLangTitle
This.ctlText = This.cLangText
Else
This.ctlVisible = FALSE
Endif
If This.ctlCapsLockStyle And This.ctlActive And Capslock() Then
This.ctlVisible = TRUE
Endif
ENDPROC
HIDDEN PROCEDURE ctlclosebutton_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
ENDIF
This.ctlCloseButton = m.vNewVal
*!* Recreate BalloonTip
This.ctl32_Create()
ENDPROC
HIDDEN PROCEDURE ctlfadein_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.ctlFadeIn = m.vNewVal
*!* Recreate BalloonTip
This.ctl32_Create()
ENDPROC
HIDDEN PROCEDURE ctlfadeout_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.ctlfadeout = m.vNewVal
ENDPROC
PROCEDURE ctlhide
Lparameters tnHideStyle As Integer
Do Case
Case m.tnHideStyle = -1 && Link CLICKED
This.ctlOpenLink()
Case m.tnHideStyle = 0 && Hide Delay timeout
Case m.tnHideStyle = 1 && Inside BalloonTip
Case m.tnHideStyle = 2 && Outside BalloonTip
Case m.tnHideStyle = 3 && X Close Button
Case m.tnHideStyle = 4 && Key Pressed
Case m.tnHideStyle = 5 && CAPS LOCK key set to off
Case m.tnHideStyle = 6 && Form moved, resized
Endcase
ENDPROC
HIDDEN PROCEDURE ctlhidedelay_assign
Lparameters vNewVal
If m.vNewVal < 0 Then
m.vNewVal = 0
Endif
This.ctlHideDelay = m.vNewVal
This.tmrHide.Interval = m.vNewVal
ENDPROC
HIDDEN PROCEDURE ctlhwnd_access
Return This.nCtlHwnd
ENDPROC
HIDDEN PROCEDURE ctlhwnd_assign
Lparameters vNewVal
Return
ENDPROC
HIDDEN PROCEDURE ctliconlarge_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If This.ctlIconLarge <> m.vNewVal Then
This.ctlIconLarge = m.vNewVal
This.ctl32_SetIconAndTitle()
Endif
ENDPROC
HIDDEN PROCEDURE ctlicon_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal < 0 Then
m.vNewVal = 0
Endif
If m.vNewVal > 3 Then
m.vNewVal = 0
Endif
Endif
This.ctlIcon = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
This.oIcon = Null
If Type([This.ctlIcon]) = T_CHARACTER Then
If This.oUtil._OSVersion() >= CON_OS_WINXPSP2 Then && Custom icons only work in xp sp2 and up
If File(This.ctlIcon) Then
This.oIcon = LoadPicture(This.ctlIcon)
This.ctlIcon = This.oIcon.Handle
Else
This.ctlIcon = 0
Endif
Else
This.ctlIcon = 0
Endif
Endif
This.ctl32_SetIconAndTitle()
ENDPROC
HIDDEN PROCEDURE ctllangid_assign
Lparameters vNewVal
This.ctllangid = m.vNewVal
This.ctl32_SetLangStrings()
ENDPROC
HIDDEN PROCEDURE ctllink_access
*!* Store Link URL in ctlLinkURL
*!* Store Link Label in ctlLinkLabel
*!* Retrieve complete Link form ctlLink
Local lcLink
m.lcLink = []
If This.oUtil._OSVersion() >= CON_OS_WINXP Then
Do Case
Case Not Empty(This.ctlLinkURL) And Not Empty(This.ctlLinkLabel)
m.lcLink =[<A href="] + Alltrim(This.ctlLinkURL) + [">] + Alltrim(This.ctlLinkLabel) + [</A>]
Case Not Empty(This.ctlLinkURL) And Empty(This.ctlLinkLabel)
m.lcLink =[<A>] + Alltrim(This.ctlLinkLabel) + [</A>]
Case Empty(This.ctlLinkURL) And Not Empty(This.ctlLinkLabel)
m.lcLink =Alltrim(This.ctlLinkLabel)
Endcase
Else
m.lcLink = Alltrim(Alltrim(This.ctlLinkLabel) + " " + Alltrim(This.ctlLinkURL))
Endif
Return m.lcLink
ENDPROC
HIDDEN PROCEDURE ctlmargin_assign
*!* Sets the margin between the text and the borders of the balloon tip
Lparameters vNewVal
If m.vNewVal < 0 Then
m.vNewVal = 0
Endif
This.ctlMargin = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
Local lnMargin, lcMargin
m.lnMargin = This.ctlMargin
*!* Here we create a RECT structure with all four values equal
m.lcMargin = replicate(bintoc(m.lnMargin, [4RS]), 4)
SendMessageC(This.nCtlHwnd, TTM_SETMARGIN, 0, @m.lcMargin)
ENDPROC
HIDDEN PROCEDURE ctlmaxwidth_assign
Lparameters vNewVal
If m.vNewVal < 0 Then
m.vNewVal = 0
Endif
This.ctlMaxWidth = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
Local lnMaxWidth
m.lnMaxWidth = This.ctlMaxWidth
SendMessageN(This.nCtlHwnd, TTM_SETMAXTIPWIDTH , 0, m.lnMaxWidth)
ENDPROC
PROCEDURE ctlopenlink
If Not Empty(This.ctlLinkURL) Then
ShellExecute(0, 0, ["] + This.ctlLinkURL + ["] + 0h00, 0, 0, SW_SHOWNORMAL)
Endif
ENDPROC
HIDDEN PROCEDURE ctlstyle_assign
Lparameters vNewVal
If This.ctlStyle <> m.vNewVal Then
This.ctlStyle = m.vNewVal
Else
Return
Endif
This.ctl32_Create()
ENDPROC
HIDDEN PROCEDURE ctltext_assign
Lparameters vNewVal
This.ctlText = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
Local lcToolInfo, lcText
*!* Replace TABS with four spaces:
m.vNewVal = Strtran(m.vNewVal, Chr(9), Space(4))
This.oToolInfo._lpszTextString = m.vNewVal
m.lcToolInfo = This.oToolInfo._Struct
SendMessageC(This.nCtlHwnd, TTM_UPDATETIPTEXTA, 0, @m.lcToolInfo)
ENDPROC
HIDDEN PROCEDURE ctltitle_assign
Lparameters vNewVal
This.ctlTitle = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
This.ctl32_SetIconAndTitle()
ENDPROC
HIDDEN PROCEDURE ctlvisible_assign
Lparameters vNewVal
If Type([m.vNewVal]) = T_NUMERIC Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.ctlVisible = m.vNewVal
If This.nCtlHwnd = 0 Then
Return
Endif
Local lcToolInfo As Character
If This.ctlVisible Then
*!* We have a timer call This.ctl32_Show() to overcome the
*!* bug of setting the balloon Visible in an object getfocus,
*!* the cursor (caret) is still in the previous control.
This.tmrShow.Enabled = TRUE
*!* This timer just calls ctl32_Show()
else
*!* Here we hide balloontip:
If This.ctlFadeOut = FALSE Then
*!* We first hide the tooltip window to prevent fade out effect, TTF_NOFADE seems to
*!* have no effect on fade out, only on fade in
ShowWindow(This.nCtlHwnd, SW_HIDE)
Endif
m.lcToolInfo = This.oToolInfo._Struct
SendMessageC(This.nCtlHwnd, TTM_TRACKACTIVATE, 0, @m.lcToolInfo)
This.tmrHide.Enabled = FALSE
Endif
ENDPROC
PROCEDURE Destroy
DestroyWindow(This.nCtlHwnd)
*!* Control is an object reference to the control to use to locate the balloontip
This.ctlControl = Null
*!* oToolInfo is an instance of the _toolinfo class of ctl32_structs
This.oToolInfo = Null
*!* loIcon is an object reference to an icon file if a custom icon was used
This.oIcon = Null
*!* oMacros is an instance of the _macros class of ctl32_structs
This.oMacros = null
ENDPROC
HIDDEN PROCEDURE evthandler_form_moved
If This.ctlVisible And This.ctlActive Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 6)
Endif
ENDPROC
HIDDEN PROCEDURE evthandler_form_resize
If This.ctlVisible and This.ctlActive Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 6)
Endif
ENDPROC
HIDDEN PROCEDURE evthandler_form_wm_keydown
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
Local lnResult As Number
If This.ctlActive
If This.ctlCapsLockStyle Then
*!* If last key pressed was CAPS LOCK
If m.nWPARAM = VK_CAPITAL
*!* If CAPS LOCK was set to on:
If Bittest(GetKeyState(VK_CAPITAL), 0) = TRUE Then
This.ctlVisible = TRUE
Endif
*!* If CAPS LOCK was set to off and the balloontip is visible:
If Bittest(GetKeyState(VK_CAPITAL), 0) = FALSE And This.ctlVisible Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 5)
Endif
Else
*!* Key pressed was not CAPS LOCK, hide the balloontip is visible
If This.ctlVisible Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 4)
Endif
Endif
Else
*!* Not ctlCapsLockStyle, Hide balloontip with any key
If This.ctlVisible Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 4)
Endif
Endif
Endif
m.lnResult = CallWindowProc(This.nVFPWndProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Return m.lnResult
ENDPROC
HIDDEN PROCEDURE evthandler_host_wm_lbuttondown
*!* Here we detect a mouseclick on the form. The Balloontip transfers its mouse events to the form
*!* HWND. When the user clicks on the form or the balloontip, we hide the balloontip.
*!* IF the user clicked on the form, the form gets the click. If the user clicked on the balloontip
*!* we discard the click to prevent undesired clicks on the underlying form. For example, if underneath
*!* the balloontip there is a button, and the user clicks the balloontip to hide it, the button
*!* will get the click. This method prevents that.
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
Local lnResult As Number, lnX, lnY, lcPoint, lnOption, loRect, lcRect
m.lnOption = -1 && not used
If This.ctlVisible And This.ctlActive Then
m.lnOption = 0 && do not discard click
*!* Get form coordinates of mouse click from lParam
m.lnX = This.oMacros._GET_X_LPARAM(m.nLPARAM)
m.lnY = This.oMacros._GET_Y_LPARAM(m.nLPARAM)
*!* Convert form coordinates to screen coordinates:
m.lcPoint = This.oMacros._MAKEPOINT(m.lnX, m.lnY)
ClientToScreen(Thisform.HWnd, @ m.lcPoint)
m.lnX = This.oMacros._GET_X_POINT(m.lcPoint)
m.lnY = This.oMacros._GET_Y_POINT(m.lcPoint)
*!* WindowFromPoint only works on XP and up, in 98 and 2K returns hwnd of form
If This.oUtil._OSVersion() >= CON_OS_WINXP Then
*!* We will check if the mouse click is in the ballontip or in the form
*!* If the mouse click is on the balloontip, we do not pass the click to the form
If WindowFromPoint(m.lnX, m.lnY) = This.ctlHwnd Then
m.lnOption = 1 && discard
Endif
Else
*!* Not XP, use WindowRect that is not as exact, but close
m.lcRect = This.oRect._Struct
GetWindowRect(This.ctlHwnd, @m.lcRect)
This.oRect._Struct = m.lcRect
If Between(m.lnY, This.oRect._Top, This.oRect._Bottom) And ;
between(m.lnX, This.oRect._Left, This.oRect._Right) Then
m.lnOption = 1 && Discard
Endif
Endif
*!* Hide BalloonTip
This.ctlVisible = FALSE
Endif
Do Case
Case m.lnOption = -1 && BalloonTip not visible and active
m.lnResult = CallWindowProc(This.nVFPWndProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Case m.lnOption = 0 && BalloonTip visible, click was outside balloontip
m.lnResult = CallWindowProc(This.nVFPWndProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Raiseevent(This, [ctlHide], 2)
Case m.lnOption = 1 && BalloonTip visible, click was inside balloontip
m.lnResult = 1
Raiseevent(This, [ctlHide], 1)
Endcase
Return m.lnResult
ENDPROC
HIDDEN PROCEDURE evthandler_host_wm_notify
Lparameters nHWND As Integer, nMSG As Integer, nWPARAM As Integer, nLPARAM As Integer
Local lnResult As Integer, loHmdr, lnCode
This.loNmhdr._Struct = Sys(2600, m.nLPARAM, This.loNmhdr._StructLen)
m.lnCode = This.loNmhdr._code
If m.lnCode = TTN_LINKCLICK Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], -1)
Endif
If m.lnCode = TTN_POP Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 3)
Endif
m.lnResult = CallWindowProc(This.nVFPWndProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Return m.lnResult
ENDPROC
HIDDEN PROCEDURE evthandler_screen_moved
If This.ctlVisible And This.ctlActive Then
This.ctlVisible = FALSE
Raiseevent(This, [ctlHide], 6)
Endif
ENDPROC
PROCEDURE Init
*!* Add Util object
This.NewObject([oUtil], [_Util], [ctl32_common.vcx])
This.ctl32_DeclareDlls()
This.ctl32_AddProperties()
This.ctl32_SetLangStrings()
This.ctl32_Create()
This.ctl32_BindEvents()
ENDPROC
PROCEDURE lblname.Init
return FALSE
ENDPROC
PROCEDURE tmrHide.Timer
If This.Parent.ctlVisible = TRUE Then
This.Parent.ctlVisible = FALSE
Raiseevent(This.Parent, [ctlHide], 0)
Endif
ENDPROC
PROCEDURE tmrShow.ctl32_show
Lparameters tnPositionStyle
Local lcToolInfo, lcPoint, lnDWord, loControl, lnX, lnY, lnPositionStyle
*!* If balloonTip is not active, dont show, just return
If This.Parent.ctlActive = FALSE Then
Return
Endif
If Pcount() = 0 Then
If This.Parent.ctlStyle <> CON_STYLE_BALLOON And This.Parent.ctlPositionStyle = CON_BTPOS_CARET Then
m.lnPositionStyle = CON_BTPOS_ACTIVECTRL
Else
m.lnPositionStyle = This.Parent.ctlPositionStyle
Endif
Else
m.lnPositionStyle = m.tnPositionStyle
Endif
Do Case
Case m.lnPositionStyle = CON_BTPOS_NONE && 1
*!* This.Parent.ctlLeft and This.Parent.ctlTop should have been defined
*!* by user before getting here.
Case m.lnPositionStyle = CON_BTPOS_ACTIVECTRL && 2
If Type([Thisform.ActiveControl]) = T_OBJECT Then
m.loControl = Thisform.ActiveControl
Else
This.ctl32_Show(CON_BTPOS_NONE)
Endif
Case m.lnPositionStyle = CON_BTPOS_CARET && 3
*!* If object has selected text, just call this method again with PositionStyle = 3
If Type([Thisform.ActiveControl]) = T_OBJECT And;
Pemstatus(Thisform.ActiveControl, [SelLength], CON_PEMSTAT_DEFINED) And;
Thisform.ActiveControl.SelLength <> 0 Then
This.ctl32_Show(CON_BTPOS_ACTIVECTRL)
Else
m.lcPoint = Space(8)
*!* Get position of caret
GetCaretPos(@ m.lcPoint)
*!* Save coordinates of caret in control properties
This.Parent.ctlLeft = CToBin(Substr(m.lcPoint, 1, 4), [4RS]) + 5
This.Parent.ctlTop = CToBin(Substr(m.lcPoint, 5, 4), [4RS]) + 10
Endif
Case m.lnPositionStyle = CON_BTPOS_SYS1270 && 4
If Type([SYS(1270)]) = T_OBJECT Then
m.loControl = Sys(1270)
Else
This.ctl32_Show(CON_BTPOS_ACTIVECTRL)
Endif
Case m.lnPositionStyle = CON_BTPOS_CTRLREF && 5
If Type([This.Parent.ctlControl]) = T_OBJECT
m.loControl = This.Parent.ctlControl
Else
This.ctl32_Show(CON_BTPOS_ACTIVECTRL)
Endif
Case m.lnPositionStyle >= CON_BTPOS_MOUSE && 6
m.lcPoint = Space(8)
*!* Get position of mouse cursor
GetCursorPos(@ m.lcPoint)
ScreenToClient(Thisform.HWnd, @ m.lcPoint)
This.Parent.ctlLeft = CToBin(Substr(m.lcPoint, 1, 4), [4RS])
This.Parent.ctlTop = CToBin(Substr(m.lcPoint, 5, 4), [4RS])
Endcase
*!* Get tip coordinates from control coordinates:
If Inlist(m.lnPositionStyle, CON_BTPOS_ACTIVECTRL, CON_BTPOS_SYS1270, CON_BTPOS_CTRLREF)
*!* If balloontip is not a balloon, position it under control and almost
*!* flush with left of it:
If This.Parent.ctlStyle <> CON_STYLE_BALLOON Then
This.Parent.ctlLeft = Objtoclient(m.loControl, CON_OBJTOCLI_LEFT) + 5
This.Parent.ctlTop = Objtoclient(m.loControl, CON_OBJTOCLI_TOP) + m.loControl.Height + 2
Else
*!* If control has SelLength property, its some kind of text edit control,
*!* so we position balloontip near left side, qo pixels to right
*!* 20060930: CHANGED "Thisform.ActiveControl" TO "m.loControl"
If Pemstatus(m.loControl, [SelLength], CON_PEMSTAT_DEFINED) Then
This.Parent.ctlLeft = Objtoclient(m.loControl, CON_OBJTOCLI_LEFT) + 10
Else
This.Parent.ctlLeft = Objtoclient(m.loControl, CON_OBJTOCLI_LEFT) + Int(m.loControl.Width / 3 * 2)
Endif
This.Parent.ctlTop = Objtoclient(m.loControl, CON_OBJTOCLI_TOP) + Int(m.loControl.Height / 3 * 2)
Endif
Endif
m.lcToolInfo = This.Parent.oToolInfo._Struct
*!* Convert form coordinates to screen coordinates:
m.lcPoint = BinToC(This.Parent.ctlLeft, [4RS]) + BinToC(This.Parent.ctlTop, [4RS])
ClientToScreen(Thisform.HWnd, @ m.lcPoint)
m.lnX = CToBin(Substr(m.lcPoint, 1, 4), [4RS])
m.lnY = CToBin(Substr(m.lcPoint, 5, 4), [4RS])
*!* Make DWORD for TTM_TRACKPOSITION message (MAKELPARAM)
m.lnDWord = m.lnX + m.lnY * 0x10000
*!* Set tooltip position
SendMessageN(This.Parent.nCtlHwnd, TTM_TRACKPOSITION, 0, m.lnDWord)
*!* Activate tooltip
SendMessageC(This.Parent.nCtlHwnd, TTM_TRACKACTIVATE, 1, @m.lcToolInfo)
*!* Reset HIDE timer and enable it, so tooltip autohides.
*!* if tmrHide.Interval is 0 the tooltip will not autohide
If This.Parent.ctlHideDelay > 0 Then
This.Parent.tmrHide.Reset()
This.Parent.tmrHide.Enabled = TRUE
Endif
m.lcToolInfo = Null
m.loControl = Null
ENDPROC
PROCEDURE tmrShow.Timer
*!* Disable this timer
This.Enabled = FALSE
This.ctl32_Show()
ENDPROC
ENDDEFINE
DEFINE CLASS ctl32_balloontip_show AS timer
*< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "ctl32.h"
*<DefinedPropArrayMethod>
*m: ctl32_show
*p: ctlabout
*p: ctlversion
*</DefinedPropArrayMethod>
*<PropValue>
ctlabout = ctl32_ballontip_show - Carlos Alloatti
ctlversion = 20061010
Height = 23
Name = "ctl32_balloontip_show"
Width = 23
*</PropValue>
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink