*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*
*m: ctl32_addproperties
*m: ctl32_bindevents
*m: ctl32_create
*m: ctl32_registerfunctions
*m: ctl32_sethosthwnd
*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: ctlos
*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: ctl32_structs
*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
*
HIDDEN ctl32_structs
*
BackColor = 140,200,200
ctl32_structs = ctl32_structs.vcx
ctlabout = ctl32_scontainer class for VFP9 by 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 = 20061001
ctlvisible = .F.
ForeColor = 255,0,245
Height = 48
Name = "ctl32_balloontip"
Visible = .F.
Width = 120
*
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
With This
*!* This will hold an object reference to a custom icon to display in balloontip
.AddProperty([oIcon], Null)
*!* Add oToolInfo property with TOOLINFO structure value
.AddProperty([oToolInfo], Newobject([_ToolInfo], .ctl32_structs))
*!* Add Macros object
.AddProperty([oMacros], Newobject([_Macros], .ctl32_structs))
*!* Stores the hWnd of the host window
.AddProperty([nHosthWnd], 0)
*!* Indicates we are in the creation stage
.AddProperty([lCreating], FALSE)
*!* Stores GetWindowLong(_vfp.hWnd, GWL_WNDPROC) for use by window messages event binding
.AddProperty([nOldWinProc], GetWindowLong(_vfp.HWnd, GWL_WNDPROC))
*!* Stores hWnd of Windows common control created by the class
.AddProperty([nCtlHwnd], 0)
*!* These 2 properties hold the title and text for the capslock balloontip
.AddProperty([cLangTitle], [])
.AddProperty([cLangText], [])
Endwith
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
#Define CTL_BTPOS_NONE 1
#Define CTL_BTPOS_ACTIVECTRL 2
#Define CTL_BTPOS_CARET 3
#Define CTL_BTPOS_SYS1270 4
#Define CTL_BTPOS_CTRLREF 5
#Define CTL_STYLE_BALLOON 1
#Define CTL_STYLE_RECT 2
#Define CTL_STYLE_NOBORDER 3
*!* 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 = CTL_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 = GetWindowLong(_vfp.HWnd, GWL_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 <> CTL_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 = Chr(0)
.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 = CTL_STYLE_NOBORDER Then
*!* Borders have no effect on Vista
If This.ctlOS() < CTL_OS_WINVISTA Then
m.dwStyle = GetWindowLong(.ctlHWnd, GWL_EXSTYLE)
m.dwStyle = Bitclear(m.dwStyle, CTL_BIT_WS_BORDER)
*!* Have to remove TTS_CLOSE button:
If .ctlCloseButton = FALSE Then
m.dwStyle = Bitclear(m.dwStyle, CTL_BIT_TTS_CLOSE)
Endif
SetWindowLong(.ctlHWnd, GWL_STYLE, m.dwStyle)
SetWindowPos(.ctlHWnd, ;
0, ;
0, ;
0, ;
0, ;
0, ;
BITOR(SWP_NOMOVE, SWP_NOSIZE, SWP_NOZORDER, SWP_NOACTIVATE, SWP_FRAMECHANGED))
Endif
Endif
.lCreating = FALSE
Endwith
This.ctl32_BindEvents()
ENDPROC
HIDDEN PROCEDURE ctl32_registerfunctions
*!* 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_sethosthwnd
*!* the control must have a parent window. In the case of a standard form, its the
*!* hWnd of the form. If we have a Top Level Form, or a Form with scrollbars, we have
*!* to find the hWnd of the "inner" window of the Form
If Thisform.ShowWindow = CTL_SHOWWIN_ASTOPLEVELFORM Or Thisform.ScrollBars > 0 Then
*!* Get hWnd of client window of Top Level Form //Craig Boyd//
#If Version(5) >= 900
This.nHosthWnd = Sys(2327, Sys(2325, Sys(2326, Thisform.HWnd)))
#Else
This.nHosthWnd = GetWindow(Thisform.HWnd, GW_CHILD)
#Endif
Else
This.nHosthWnd = Thisform.HWnd
Endif
ENDPROC
HIDDEN PROCEDURE ctl32_seticonandtitle
Local lnIcon, lcText
m.lnIcon = This.ctlIcon
*!* Check if a large icon is desired
If This.ctlOS() >= CTL_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 + Chr(0)
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ŕ activada"
m.lcText = "Si teniu la tecla Bloq Maj activada, podríeu introduir la contrasenya incorrectament.\r\n\r\nHauríeu de pré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 moe se dogoditi da upiete krivu lozinku.\r\n\r\nTrebate pritisnuti Caps Lock kako biste ga iskljucili prije unosa lozinke."
Case m.lnPrimaryLangID = LANG_CZECH && 0x05
m.lcTitle = "Reim Caps Lock je aktivní"
m.lcText = "Zapnutí reimu Caps Lock mue zpusobit nesprávné zadání hesla.\r\n\r\nPred zadáním hesla vypnete reim Caps Lock stisknutím klávesy Caps Lock."
Case m.lnPrimaryLangID = LANG_DANISH && 0x06
m.lcTitle = "Caps Lock er slĺet til"
m.lcText = "Hvis Caps Lock er slĺet til, kan det det medfřre, at adgangskoden bliver skrevet forkert.\r\n\r\nDu břr trykke pĺ Caps Lock for at slĺ 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ähelukk on sisse lülitatud"
m.lcText = "Sisselülitatud suurtähelukk vőib pőhjustada teie parooli vale sisestamise.\r\n\r\nEnne parooli sisestamist peaksite suurtäheluku klahvi Caps Lock vajutamisega välja lülitama."
Case m.lnPrimaryLangID = LANG_FINNISH && 0x0b
m.lcTitle = "Caps Lock on päällä"
m.lcText = "Jos Caps Lock on päällä salasanan isot ja pienet kirjaimet saattavat vaihtua.\r\n\r\nOta Caps Lock pois päältä 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é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ús está activada"
m.lcText = "Coa tecla Bloq Maiús activada é probábel que introduza o seu contrasinal de forma incorrecta.\r\n\r\nPré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ásan adja meg a jelszót.\r\n\r\nA jelszó beírása elott érdemes kikapcsolnia a Caps Lock billentyu megnyomásával."
Case m.lnPrimaryLangID = LANG_ICELANDIC && 0x0f
m.lcTitle = "Stafalás er virkur"
m.lcText = "Ef stafalás er virkur gćti ađgangsorđ veriđ fćrt inn á rangan hátt.\r\n\r\nStyđja ćtti á stafalás til ađ gera hann óvirkan áđur en ađgangsorđiđ 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 č attivo puň 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 Caps Lock"
m.lcText = "Ja ir ieslegts taustin Caps Lock, parole, iespejams, tiks ievadita nepareizi.\r\n\r\nLai to izslegtu, pirms paroles ievadianas taustin Caps Lock janospie."
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 slaptaodi.\r\n\r\nPrie ivesdami slaptaodi spustelekite mygtuka Caps Lock, kad ji ijungtumete."
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ĺ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á ativada"
m.lcText = "Se Caps Lock estiver ativado, isso pode fazer com que vocę digite a senha incorretamente.\r\n\r\nVocę deve pressionar a tecla Caps Lock para desativá-la antes de digitar a senha."
Case m.lnPrimaryLangID = LANG_PORTUGUESE And m.lnSubLangID = SUBLANG_PORTUGUESE_PORTUGAL && 0x16 0x02
m.lcTitle = "Caps Lock está 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 î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, moe se desiti da unesete pogrenu lozinku.\r\n\r\nTrebalo bi da pritisnete taster Caps Lock da biste ga iskljucili pre unoenja lozinke."
Case m.lnPrimaryLangID = LANG_SLOVAK && 0x1b
m.lcTitle = "Kláves Caps Lock je zapnutý"
m.lcText = "Ak je zapnutý kláves Caps Lock, heslo môe byt zadané nesprávne.\r\n\r\nPred zadaním hesla vypnite klá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ús activado"
m.lcText = "Si tiene activada la tecla Bloq Mayús es posible que escriba incorrectamente su contraseńa.\r\n\r\nPresione la tecla Bloq Mayús para desactivarla antes de escribir su contraseńa."
Case m.lnPrimaryLangID = LANG_SWEDISH && 0x1d
m.lcTitle = "Caps Lock är aktiverat"
m.lcText = "Om Caps Lock ä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 ö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 = CTL_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.ctlOS() >= CTL_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.ctlOS() >= CTL_OS_WINXP Then
Do Case
Case Not Empty(This.ctlLinkURL) And Not Empty(This.ctlLinkLabel)
m.lcLink =[] + Alltrim(This.ctlLinkLabel) + []
Case Not Empty(This.ctlLinkURL) And Empty(This.ctlLinkLabel)
m.lcLink =[] + Alltrim(This.ctlLinkLabel) + []
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 + ["] + Chr(0), 0, 0, SW_SHOWNORMAL)
Endif
ENDPROC
PROCEDURE ctlos
*!* Returns a numeric value representing the operating system version
*!* Check ctl32.h for possible values
*!* ie CTL_OS_WINXPSP2 = 5010200
Return Val(Os(3)) * 1000000 + Val(Os(4)) * 10000 + Val(Os(8)) * 100 + Val(Os(9))
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.nOldWinProc, 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.ctlOS() >= CTL_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.loRect = Newobject([_Rect], This.ctl32_structs)
m.lcRect = m.loRect._Struct
GetWindowRect(This.ctlHwnd, @m.lcRect)
m.loRect._Struct = m.lcRect
If Between(m.lnY, m.loRect._Top, m.loRect._Bottom) And ;
between(m.lnX, m.loRect._Left, m.loRect._Right) Then
m.lnOption = 1 && Discard
Endif
m.loRect = Null
Endif
*!* Hide BalloonTip
This.ctlVisible = FALSE
Endif
Do Case
Case m.lnOption = -1 && BalloonTip not visible and active
m.lnResult = CallWindowProc(This.nOldWinProc, m.nHWND, m.nMSG, m.nWPARAM, m.nLPARAM)
Case m.lnOption = 0 && BalloonTip visible, click was outside balloontip
m.lnResult = CallWindowProc(This.nOldWinProc, 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
m.loNmhdr = Newobject([_Nmhdr], This.ctl32_structs)
m.loNmhdr._Struct = Sys(2600, m.nLPARAM, m.loNmhdr._StructLen)
m.lnCode = m.loNmhdr._code
m.loNmhdr = Null
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.nOldWinProc, 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
This.ctl32_RegisterFunctions()
This.ctl32_AddProperties()
This.ctl32_SetHosthWnd()
This.ctl32_SetLangStrings()
This.ctl32_Create()
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 <> CTL_STYLE_BALLOON And This.Parent.ctlPositionStyle = CTL_BTPOS_CARET Then
m.lnPositionStyle = CTL_BTPOS_ACTIVECTRL
Else
m.lnPositionStyle = This.Parent.ctlPositionStyle
Endif
Else
m.lnPositionStyle = m.tnPositionStyle
Endif
Do Case
Case m.lnPositionStyle = CTL_BTPOS_NONE && 1
*!* This.Parent.ctlLeft and This.Parent.ctlTop should have been defined
*!* by user before getting here.
Case m.lnPositionStyle = CTL_BTPOS_ACTIVECTRL && 2
If Type([Thisform.ActiveControl]) = T_OBJECT Then
m.loControl = Thisform.ActiveControl
Else
This.ctl32_Show(CTL_BTPOS_NONE)
Endif
Case m.lnPositionStyle = CTL_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], CTL_PEMSTAT_DEFINED) And;
Thisform.ActiveControl.SelLength <> 0 Then
This.ctl32_Show(CTL_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 = CTL_BTPOS_SYS1270 && 4
If Type([SYS(1270)]) = T_OBJECT Then
m.loControl = Sys(1270)
Else
This.ctl32_Show(CTL_BTPOS_ACTIVECTRL)
Endif
Case m.lnPositionStyle = CTL_BTPOS_CTRLREF && 5
If Type([This.Parent.ctlControl]) = T_OBJECT
m.loControl = This.Parent.ctlControl
Else
This.ctl32_Show(CTL_BTPOS_ACTIVECTRL)
Endif
Case m.lnPositionStyle >= CTL_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]) + 5
This.Parent.ctlTop = CToBin(Substr(m.lcPoint, 5, 4), [4RS]) + 10
Endcase
*!* Get tip coordinates from control coordinates:
If Inlist(m.lnPositionStyle, CTL_BTPOS_ACTIVECTRL, CTL_BTPOS_SYS1270, CTL_BTPOS_CTRLREF)
*!* If balloontip is not a balloon, position it under control and almost
*!* flush with left of it:
If This.Parent.ctlStyle <> CTL_STYLE_BALLOON Then
This.Parent.ctlLeft = Objtoclient(m.loControl, CTL_OBJTOCLI_LEFT) + 5
This.Parent.ctlTop = Objtoclient(m.loControl, CTL_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], CTL_PEMSTAT_DEFINED) Then
This.Parent.ctlLeft = Objtoclient(m.loControl, CTL_OBJTOCLI_LEFT) + 10
Else
This.Parent.ctlLeft = Objtoclient(m.loControl, CTL_OBJTOCLI_LEFT) + Int(m.loControl.Width / 3 * 2)
Endif
This.Parent.ctlTop = Objtoclient(m.loControl, CTL_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"
*
*m: ctl32_setpos
*m: ctl32_show
*
*
Height = 23
Name = "ctl32_balloontip_show"
Width = 23
*
ENDDEFINE