A custom vfp Ansi and Unicode tooltip

Published on by Yousfi Benameur


The drawText APi studied in previous post can draw a formatted text on any window  surface.
It can be ANSI (drawtext or DrawtextA) or Unicode(DrawTextW).
A top level form is used here as tooltip fired  on mouseEnter event on a control and destoyed on MouseLeave event of the same control.
The form have transparency (0-255 better for >120).it resizes automatically with  the drawtext Api as seen in previous post.
see some screenShots with multi languages (unicode and ANSI).
Can make many parameters settings in the right grid as
-form Shape backcolor
-Alpha (transparency 0-255 better for >120 to make some visibility )
-form backcolor (made transparent with ColorKey constant and setLayeredWindow API)
-the tooltip forecolor
-the tooltip fontname, fontsize, font italic,font bold (i limited the fontsize to 20 max in code).
-Form showtips (if true tooltip appears otherwise dont fired).
-the tooltip border (as a shape border) is set to a randomly color.
-can set a randomly color for any color parameter above.
-Can drag the tooltip by the left red shape on desktop.Can close it by click manually on the right icon.
the parameters to draw are :
        -function drawtext or DrawtextA
        -position x,y where the tooltip must appear
        -the text (ansi or unicode)-can be a big one.
        -the tooltip title  to bound the label.
*must choose a fixed width for tooltip (in code) for specific form(right rectangle corner).This tooltip width is done by the form ytooltip width.       

the tooltip here is a class as object created by createObject function.
A procedure (prg) is created for that purpose and called each time needed.

Note:Some fonts slows relatively the code execution !
Of course the class can be improved.
-below 2 codes working together.A main code as a test form with tooltips info stored in a cursor
and a prg as a code class (can insert it in the main first prg).Name this last to ytooltip.prg.
For making the code working download the unicode texts below as
-arabic.txt
.chinese.txt
-hindi.txt
.Greek.txt
-Ciryllic.txt
simply copy each code and paste it into notepad and save as the name above but mandatory as "Unicode" option."


 

Click on code to select [then copy] -click outside to deselect


*save this code  as ytest_tooltip.prg
Publi yform
yform=Newobject("ytest")
yform.Show
Read Events
Return

*
Define Class ytest As Form
    Height = 560
	Width = 810
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Picture = "crab_nebula.jpg"  &&must be in source folder as form background
	Caption = "yTooltips test--MouseMove on controls to see the tooltips."
	WindowState=2
	Name = "ydemo"

	Add Object command1 As CommandButton With ;
		Top = 72, ;
		Left = 24, ;
		Height = 109, ;
		Width = 288, ;
		Caption = "Test here", ;
		BackColor = Rgb(0,255,0), ;
		Name = "Command1"

	Add Object image1 As Image With ;
		Picture = (Home(1)+"graphics\bitmaps\assorted\beany.bmp"), ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 121, ;
		Left = 12, ;
		Top = 192, ;
		Width = 121, ;
		Name = "Image1"

	Add Object command2 As CommandButton With ;
		Top = 72, ;
		Left = 348, ;
		Height = 48, ;
		Width = 120, ;
		Caption = "Test here", ;
		BackColor = Rgb(128,0,64), ;
		Name = "Command2"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 11, ;
		Caption = "Big tooltip to Click only", ;
		Height = 20, ;
		Left = 12, ;
		MousePointer = 15, ;
		Top = 12, ;
		Width = 165, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(192,192,192), ;
		Name = "Label1"

	Add Object grid1 As Grid With ;
		FontBold = .T., ;
		DeleteMark = .F., ;
		GridLines = 0, ;
		Height = 268, ;
		Left = 593, ;
		MousePointer = 15, ;
		RecordMark = .F., ;
		RowHeight = 22, ;
		ScrollBars = 0, ;
		Top = 8, ;
		Width = 210, ;
		Themes = .F., ;
		Name = "Grid1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 18, ;
		Caption = "UNICODE  Arabic", ;
		Height = 32, ;
		Left = 288, ;
		Top = 12, ;
		Width = 199, ;
		ForeColor = Rgb(0,255,255), ;
		BackColor = Rgb(255,128,0), ;
		Name = "Label2"

	Add Object command3 As CommandButton With ;
		Top = 324, ;
		Left = 192, ;
		Height = 37, ;
		Width = 132, ;
		FontBold = .T., ;
		Caption = "Ciryllic Rand colorS", ;
		BackColor = Rgb(0,255,255), ;
		Name = "Command3"

	Add Object command4 As CommandButton With ;
		Top = 167, ;
		Left = 336, ;
		Height = 37, ;
		Width = 132, ;
		FontBold = .T., ;
		Caption = "Chinese Rand  Bcolor", ;
		BackColor = Rgb(255,255,0), ;
		Name = "Command4"


	Add Object command5 As CommandButton With ;
		Top = 216, ;
		Left = 336, ;
		Height = 37, ;
		Width = 132, ;
		FontBold = .T., ;
		Caption = "Hindi Rand Bcolor", ;
		BackColor = Rgb(255,255,0), ;
		Name = "Command5"

	Add Object command6 As CommandButton With ;
		Top = 267, ;
		Left = 337, ;
		Height = 37, ;
		Width = 132, ;
		FontBold = .T., ;
		Caption = "Greek  Rand bcolor", ;
		BackColor = Rgb(255,255,0), ;
		Name = "Command6"

	Add Object yhelp As CommandButton With ;
		AutoSize = .T.,;
		FontBold = .T.,;
		FontSize = 18,;
		Caption = "Help",;
		Height = 26,;
		Left = 188,;
		MousePointer = 15,;
		Top = 12,;
		Width = 62,;
		ForeColor = Rgb(255,255,255),;
		BackColor = Rgb(0,0,128),;
		Name = "yhelp"


	Procedure ysingle
	Try
		With _Screen
			For i=1 To .FormCount
				If Lower(.Forms(i).Name)=="ytooltip"
					.Forms(i).Release
				Endi
			Endfor
		Endwith
	Catch
	Endtry
	Endproc

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
	Sele ycurs
	If !Recno()=11
		Local m.xx
		m.xx=Inputbox("Settings parameters ","",Allt(pval))
		If ! Empty(m.xx)
			Repl pval With xx
		Endi
	Endi

	If Recno()=11
		Local m.x
		m.x=Getfont()
		If ! Empty(m.x)
			Sele ycurs
			If ! Empty(m.x)
				Go 7
				Repl pval With  Getwordnum(m.x,1,',')
				Go 8
				Repl pval With  Getwordnum(m.x,2,',')
			Endi
			Messagebox( m.x +" set on tooltip",0+32+4096,'',600)
		Endi
	Endi
	Locate
	Thisform.grid1.Refresh
	Endproc

	Procedure my1
	If Thisform.WindowState=1
		Try
			ytooltip.Release
		Catch
		Endtry
	Endi
	Endproc

	Procedure Init
	Publi ytooltip
	Sys(2002)  &&set curs off

	With Thisform.grid1
		.RecordSource="ycurs"
		.RecordSourceType=1
		.ForeColor=Rgb(0,255,0)
		.HeaderHeight=28

		With .Column1.header1
			.FontBold=.T.
			.FontSize=16
			.ForeColor=Rgb(0,255,0)
			.BackColor=0
			.Caption="Settings"
		Endwith
		.SetAll("DynamicBackColor", ;
			"IIF(MOD(RECNO( ), 2)=0, RGB(28,28,28) 		   , RGB(68,68,68))", "Column")
		.column2.Visible=.F.

		Bindevent(.Column1.text1,"mousedown",Thisform,"my")
		.Refresh
		Locate
	Endwith

	Bindevent(Thisform,"resize",Thisform,"my1")
	Thisform.SetAll("mousepointer",15,"commandbutton")
	Endproc


	Procedure Load
	_Screen.AddProperty("yshowtips",Thisform.ShowTips)

	Create Cursor ycurs( Prop c(30), pval m)
	Insert Into ycurs Values ("thisform.shape1.backcolor","rgb(128,255,255)" )
	Insert Into ycurs Values ("thisform.alpha","210")
	Insert Into ycurs Values ("thisform.backcolor", "rgb(0,255,0)")
	Insert Into ycurs Values ("thisform.image1.picture","home(1)+'samples\solution\toledo\showcode.bmp'")
	Insert Into ycurs Values ("thisform.forecolor","rgb( 64,0,128)")
	Insert Into ycurs Values ("_screen.yshowtips",".t.")
	Insert Into ycurs Values ("thisform.fontname","Arial")
	Insert Into ycurs Values ("thisform.fontsize","16")
	Insert Into ycurs Values ("thisform.fontbold",".t.")
	Insert Into ycurs Values ("thisform.fontItalic",".f.")
	Insert Into ycurs Values ("Getfont (fontname/fontsize)","")
*brow
	Endproc

	Procedure Destroy
	Try
		ytooltip.Release
	Catch
	Endtry
	Clea Events
	Endproc

	Procedure command1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexp
	TEXT to cexpr noshow
		1.This is a form tooltip
		2.This is a form tooltip 3.This is a form tooltip
		4.This is a form tooltip 5.This is a form tooltip 6.This is a form tooltip
		7.This is a form tooltip 8.This is a form tooltip fin
	ENDTEXT

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+5
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+5
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+5
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+5
	Endi

	Thisform.ysingle()

	lcTitle="The title is centered on a label"
	xtype="A"
*********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
******************
	Endproc

	Procedure command1.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure image1.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure image1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord

	TEXT to cexpr noshow
		The visualization code I'm writing using Processing.js needs a tooltip to display some information depending
		on where your mouse is in the canvas. Although there are many tooltip options for webpage elements, I didn't find
		any that I could easily use with Processing.js to generate  tooltips dependent on the mouse position in the canvas.
		 After a few frustrating attempts with various libraries I  finally just took this rounded corners demo by F1LT3R.
		*
		The DrawText function draws formatted text in the specified rectangle. It formats the text
		according to the specified method (expanding tabs,justifying characters, breaking lines, and so forth).
	ENDTEXT

	If Between(Thisform.ShowWindow,0,1)
		m.a=Thisform.Left+Sysmetric(3)+nXCoord+1
		m.b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		m.a=Thisform.Left+Sysmetric(3)+nXCoord+1
		m.b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi
	Thisform.ysingle()

	lcTitle="This is a title for caption of ytooltip"
	xtype="A"
************************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
***********************
	Endproc

	Procedure image1.Init
	This.Picture= Home(1)+"graphics\bitmaps\assorted\beany.bmp"
	Endproc

	Procedure command2.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure command2.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexp
	TEXT to cexpr noshow
		2.This is a form tooltip 3.This is a form tooltip
	ENDTEXT

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	lcTitle="This is monoline tooltip"
	Thisform.ysingle()
	xtype="A"
************************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
**************************
	Endproc

	Procedure label1.Click
	TEXT to cexpr noshow
		click on icon to close the tooltip

		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
		pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
		lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
		sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
		sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
		velit vel ex aliquam, eget convallis ante mollis.
		Maecenas molestie erat sit amet molestie tempor. Donec nec nunc nunc. Vestibulum quis magna
		vestibulum, vulputate diam ac, varius leo. Duis ac magna eu quam iaculis efficitur. Etiam diam
		lectus, condimentum sit amet felis a, vehicula fringilla turpis. Aenean quis venenatis dui. Praesent
		suscipit consequat nunc, vitae ultrices lacus fermentum vitae. Pellentesque ultricies nisl eget
		maximus elementum. Pellentesque sit amet imperdiet ante. Cras id purus risus.
		fin

	ENDTEXT
	nXCoord=This.Left+This.Width/2
	nYCoord=This.Top+This.Height
	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="this is the title of the big infoBulle"
	xtype="A"
************************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
*************************
	Endproc


	Procedure label2.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexpr
	cexpr=Filetostr("arabic.txt") +Chr(0)  &&arabic.txt saved as unicode txt

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="This is an Arabic unicode text stored in txt file"
	xtype="W"
***********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
*************************
	Endproc

	Procedure label2.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure command3.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure command3.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexpr
	cexpr=Filetostr("Ciryllic.txt") +Chr(0)  &&arabic.txt saved as unicode txt

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="This is a Ciryllic unicode text stored in txt file"
	xtype="W"
***********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.shape1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand()) &&rand tooltip backcolor
		ytooltip.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())  &&rand tooltip forecolor
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
************************
	Endproc

	Procedure command4.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexpr
	cexpr=Filetostr("chinese.txt") +Chr(0)  &&arabic.txt saved as unicode txt

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="This is an Chinese unicode text stored in txt file"
	xtype="W"
**********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.shape1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
************************
	Endproc

	Procedure command4.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc


	Procedure command5.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure command5.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexpr
	cexpr=Filetostr("Hindi.txt") +Chr(0)  &&arabic.txt saved as unicode txt

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="This is a Hindi unicode text stored in txt file"
	xtype="W"
*********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.shape1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
**********************
	Endproc

	Procedure command6.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	Local cexpr
	cexpr=Filetostr("Greek.txt") +Chr(0)  &&arabic.txt saved as unicode txt

	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="This is a greek unicode text stored in txt file"
	xtype="W"
********************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.shape1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
*********************
	Endproc

	Procedure command6.MouseLeave
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		ytooltip.Release
		ytooltip=Null
	Catch
	Endtry
	Endproc

	Procedure yhelp.Click
	TEXT to cexpr noshow
		The drawText APi studied in previous post can draw a formatted text
		on a surface.
		It can be ANSI (drawtext or DrawtextA) or Unicode(DrawTextW).
		A top level form is used here as tooltip fired  on mouseEnter event
		on a control and destoyed on MouseLeave event of the same control.
		The form have transparency (0-255 better for >120).it resizes
		automatically with  the drawtext Api as seen in previous post.
		see some screenShots with multi languages (unicode and ANSI).
		Can make many parameters settings in the right grid as
		-form Shape backcolor
		-Alpha (transpoarency 0-255 better for >120 to make some visibility )
		-form backcolor (made transparent with ColorKey constant and setLayeredWindow API)
		-the tooltip forecolor
		-the tooltip fontname, fontsize, font italic,font bold
		-Form showtips (if true tooltip appears otherwise dont fired).
		-the tooltip border (is a shape border) is set to a randomly color.
		-can set a randomly color for any color parameter above.
		-Can drag the tooltip by the left red shape on desktop.Can close it
		by click manually on the right icon.
		the parameters to draw are :
		                     -function drawtext or DrawtextA
		                     -position x,y where the tooltip must appear
		                     -the text (ansi or unicode)-can be a big one.
		                     -the tooltip title  to bound the label.

		the tooltip here is a class as object created by createObject function.
		A procedure (prg) is created for that purpose and called each time needed.

		Note:Some fonts slows relatively the code execution !
		Of course the class can be improved.

		click on icon to close the tooltip.

	ENDTEXT
	nXCoord=This.Left+This.Width/2
	nYCoord=This.Top+This.Height
	If Between(Thisform.ShowWindow,0,1)
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=70+Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Else
		a=Thisform.Left+Sysmetric(3)+nXCoord+1
		b=Thisform.Top+Sysmetric(9)+Sysmetric(4)+nYCoord+1
	Endi

	Thisform.ysingle()
	lcTitle="this is theSummary help"
	xtype="A"
***************************
	Try
		Set Proc To ytooltip.prg AddI
		ytooltip=Createobject("ytoolTip",xtype,a,b,cexpr,lcTitle)
		ytooltip.shape1.BackColor=0
		ytooltip.ForeColor=Rgb(254,254,254)
		ytooltip.Show
		Release Proc ytooltip
	Catch
	Endtry
***************************
	Endproc



Enddefine
*
*-- EndDefine: ytest
****************************


 

Click on code to select [then copy] -click outside to deselect

 
*save this code class as ytooltip.prg
*can insert this class directly in the main code above

Define Class ytoolTip As Form
    BorderStyle = 0
	Top = 17
	Left = 188
	Height = 290
	Width = 498
	ShowWindow = 2
	ShowTips = .T.
	Caption = ""
	MinHeight = 50
	TitleBar = 1
	ForeColor = Rgb(113,0,56)
	BackColor = Rgb(0,255,0)
	realhwnd = 0
	Expr = ""
	alpha =210
	xtype = "A"
	hfont = 0

	Add Object shape1 As Shape With ;
		Top = 8, ;
		Left = 10, ;
		Height = 273, ;
		Width = 476, ;
		Anchor = 15, ;
		BackStyle = 1, ;
		BorderWidth = 6, ;
		Curvature = 30, ;
		BackColor = Rgb(128,255,255), ;
		BorderColor = Rgb(255,0,0), ;
		Name = "Shape1"

	Add Object timer1 As Timer With ;
		Top = 12, ;
		Left = 24, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 200, ;
		Name = "Timer1"

	Add Object shape2 As Shape With ;
		Top = -1, ;
		Left = 0, ;
		Height = 24, ;
		Width = 24, ;
		Curvature = 99, ;
		MousePointer = 15, ;
		BackColor = Rgb(255,0,0), ;
		Name = "Shape2"

	Add Object image1 As Image With ;
		Picture = Home(1)+"samples\solution\toledo\showcode.bmp", ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 32, ;
		Left = 445, ;
		MousePointer = 15, ;
		Top = 16, ;
		Width = 32, ;
		ToolTipText = "close", ;
		Name = "Image1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 0, ;
		Alignment = 2, ;
		BackStyle = 0, ;
		Caption = "This is the infobulle title", ;
		Height = 22, ;
		Left = 142, ;
		Top = 20, ;
		Width = 181, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Procedure ydraw
	Lparameters lctext,lcTitle
	#Define TRANSPARENT  1
	#Define OPAQUE       2

	#Define DT_LEFT      0
	#Define DT_CENTER    1
	#Define DT_TOP       0
	#Define DT_RIGHT     2
	#Define DT_WORDBREAK 16
	#Define DT_CALCRECT  1024

	#Define FW_NORMAL 400
	#Define FW_BOLD 700
	#Define OUT_DEVICE_PRECIS 5
	#Define OUT_OUTLINE_PRECIS 8
	#Define CLIP_STROKE_PRECIS 2
	#Define ANSI_CHARSET 0
	#Define PROOF_QUALITY 2
	#Define DEFAULT_PITCH 0

	#Define DT_RTLREADING       0x00020000

	If Thisform.hfont <> 0
		= DeleteObject(Thisform.hfont)
		Thisform.hfont=0
	Endif

	xfontName=Thisform.FontName
	xfontsize=Thisform.FontSize
	If Thisform.FontBold=.T.
		bb=FW_BOLD
	Else
		bb=FW_NORMAL
	Endi

	m.italic=0
	If Thisform.FontItalic=.T.
		m.italic=1
	Else
		m.italic=0
	Endi

	Thisform.hfont = CreateFont(xfontsize, 0, 0, 0,;
		m.bb, m.italic,0,0,;
		ANSI_CHARSET, OUT_DEVICE_PRECIS, CLIP_STROKE_PRECIS,;
		PROOF_QUALITY, DEFAULT_PITCH, xfontName)
	Local hWindow, hDC, lcRect, lctext
	hWindow = Thisform.realhwnd
	hDC = GetWindowDC(hWindow)
	= SelectObject(hDC, Thisform.hfont)

	With Thisform
		x=30
		Y=45
		x1=x+.Width-2*30
		y1=Y+.Height-2*30
	Endwith

	lcRect = Thisform.n2dw(x) + Thisform.n2dw(Y) + Thisform.n2dw(x1) + Thisform.n2dw(Y)
	= SetTextColor (hDC, Thisform.ForeColor)        &&rgb(255*rand(),255*rand(),255*rand()) )   &&
	= SetBkMode (hDC, TRANSPARENT)
	sleep(200)

*****

	Do Case
	Case Upper(Thisform.xtype)=="A"
		h= DrawText (hDC, lctext, Len(lctext),@lcRect, DT_WORDBREAK+DT_LEFT+DT_CALCRECT)
		Thisform.Height=h+2*30
		lcRect = Thisform.n2dw(x) + Thisform.n2dw(Y) + Thisform.n2dw(x1) + Thisform.n2dw(Y+h)
		DrawText (hDC, lctext, Len(lctext),@lcRect, DT_WORDBREAK+DT_LEFT)

	Case Upper(Thisform.xtype)=="W"
		h=DrawTextW (hDC, lctext, Len(lctext)/2,@lcRect, DT_WORDBREAK+DT_RIGHT+DT_RTLREADING+DT_CALCRECT)
		Thisform.Height=h+2*30
		lcRect = Thisform.n2dw(x) + Thisform.n2dw(Y) + Thisform.n2dw(x1) + Thisform.n2dw(Y+h)
		DrawTextW (hDC, lctext, Len(lctext)/2,@lcRect, DT_WORDBREAK+DT_RIGHT+DT_RTLREADING)
* i found this len(lcText)/2   solution to cut some indesirable unicode text added to lcText ??

	Otherwise
		h=DrawText (hDC, lctext, Len(lctext),@lcRect, DT_WORDBREAK+DT_LEFT+DT_CALCRECT)
		Thisform.Height=h+2*30
		lcRect = Thisform.n2dw(x) + Thisform.n2dw(Y) + Thisform.n2dw(x1) + Thisform.n2dw(Y+h)
		DrawText (hDC, lctext, Len(lctext),@lcRect, DT_WORDBREAK+DT_LEFT)

	Endcase
	= ReleaseDC(hWindow, hDC)

*HFONT structure
*HFONT CreateFont(
*  int nHeight,               // height of font
*  int nWidth,                // average character width
*  int nEscapement,           // angle of escapement
*  int nOrientation,          // base-line orientation angle
*  int fnWeight,              // font weight
*  DWORD fdwItalic,           // italic attribute option
* DWORD fdwUnderline,        // underline attribute option
*  DWORD fdwStrikeOut,        // strikeout attribute option
* DWORD fdwCharSet,          // character set identifier
*  DWORD fdwOutputPrecision,  // output precision
*  DWORD fdwClipPrecision,    // clipping precision
*  DWORD fdwQuality,          // output quality
*  DWORD fdwPitchAndFamily,   // pitch and family
*  LPCTSTR lpszFace           // typeface name
*);

	Endproc

	Procedure n2dw
	Lparameters lnValue
	#Define m0       256
	#Define m1     65536
	#Define m2  16777216
	Local b0, b1, b2, b3
	b3 = Int(lnValue/m2)
	b2 = Int((lnValue - b3*m2)/m1)
	b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
	b0 = Mod(lnValue, m0)
	Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
	Endproc

	Procedure Init
	Lparameters xtype,x0,y0,cexpr,lcTitle
	Thisform.TitleBar=0
	Thisform.label1.Caption=lcTitle
	Thisform.xtype=xtype
	Sele ycurs
	Locate
	Thisform.shape1.BackColor=Eval(pval)  &&shape backcolor
	Skip
	Thisform.alpha=Eval(pval)
	Skip
	Thisform.BackColor=Eval(pval)  &&form backcolor (to make transpareznt
	Skip
	Thisform.image1.Picture=Eval(pval) &&icon-logo
	Skip
	Thisform.ForeColor=Eval(pval)
	Skip
	_Screen.yshowtips=Eval(pval)  &&&form showTipq

	Skip
	Thisform.FontName=pval  &&fontname

	Skip
	Thisform.FontSize=Eval(pval)
	If Thisform.FontSize>20
		Thisform.FontSize=20  &&limited to 20 maxi
	Endi
	Skip
	Thisform.FontBold=Eval(pval)  &&fontbold
	Skip
	Thisform.FontItalic=Eval(pval)  &&font italic


	With This
		Thisform.Visible=.F.
		.shape1.Anchor=15
		.shape1.BorderColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.realhwnd = Iif(.ShowWindow = 2, Sys(2327, Sys(2325, Sys(2326, .HWnd))), .HWnd)
		.Left=x0
		.Top= y0
*.width0=.width
*.height0=.height
	Endwith

	#Define LWA_COLORKEY 1
	#Define LWA_ALPHA 2
	#Define GWL_EXSTYLE -20
	#Define WS_EX_LAYERED 0x80000

	Local nExStyle, nRgb, nAlpha, nFlags
	nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
	nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
	= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)

	= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor, Thisform.alpha,LWA_COLORKEY+LWA_ALPHA)  &&     LWA_COLORKEY+
	Thisform.Expr=m.cexpr
	If _Screen.yshowtips=.T.
		Thisform.timer1.Enabled=.T.
	Else
		Return .F.
	Endi
	Endproc

	Procedure Load
	Declare Integer GetWindowLong In user32;
		INTEGER HWnd, Integer nIndex
	Declare Integer SetWindowLong In user32;
		INTEGER HWnd, Integer nIndex, Integer dwNewLong
	Declare Integer SetLayeredWindowAttributes In user32;
		INTEGER HWnd, Integer crKey,;
		SHORT bAlpha, Integer dwFlags

	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hDC
	Declare Integer SetBkMode In gdi32 Integer hdc, Integer iBkMode
	Declare Integer SetTextColor In gdi32 Integer hdc, Integer crColor

	Declare Integer DrawText In user32;
		INTEGER hDC, String lpString, Integer nCount,;
		STRING @lpRect, Integer uFormat

	Declare Integer DrawTextW In user32;
		INTEGER hDC, String lpString, Integer nCount,;
		STRING @lpRect, Integer uFormat

	Declare Integer Sleep In kernel32 Integer

	Declare Integer DestroyWindow In user32 Integer hWindow
	Declare Integer DeleteObject In gdi32 Integer hObject
	Declare Integer SelectObject In gdi32 Integer hdc, Integer hObject
	Declare Integer SetTextColor In gdi32 Integer hdc, Integer crColor
	Declare Integer GetDC In user32 Integer hWindow
	Declare Integer ReleaseDC In user32 Integer hWindow, Integer hdc
	Declare Integer GetSystemMetrics In user32 Integer nIndex

	Declare Integer RealGetWindowClass In user32;
		INTEGER hWindow, String @pszType, Integer cchType

	Declare Integer ShowWindow In user32 As ShowWindowA;
		INTEGER hWindow, Integer nCmdShow

	Declare Integer CreateWindowEx In user32;
		INTEGER dwExStyle, String lpClassName, String lpWindowName,;
		INTEGER dwStyle, Integer x, Integer Y,;
		INTEGER nWidth, Integer nHeight, Integer hWndParent,;
		INTEGER hMenu, Integer hInstance, Integer lpParam

	Declare Integer SetLayeredWindowAttributes In user32;
		INTEGER HWnd, Integer crKey,;
		SHORT bAlpha, Integer dwFlags

	Declare Integer CreateFont In gdi32;
		INTEGER nHeight, Integer nWidth, Integer nEscapement,;
		INTEGER nOrientation, Integer fnWeight, Integer fdwItalic,;
		INTEGER fdwUnderline, Integer fdwStrikeOut, Integer fdwCharSet,;
		INTEGER fdwOutputPrec, Integer fdwClipPrec, Integer fdwQuality,;
		INTEGER fdwPitchAndFamily, String lpszFace
	Endproc

	Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	lnHandle = Thisform.HWnd
	param1 = 274
	param2 = 0xF012
	Declare Integer ReleaseCapture In WIN32API
	Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
	Endproc

	Procedure KeyPress
	Lparameters nKeyCode, nShiftAltCtrl
	If nKeyCode=27
		Thisform.Release
	Endi
	Endproc

	Procedure timer1.Timer
	Thisform.ydraw(Thisform.Expr)
	Thisform.Visible=.T.
	This.Enabled=.F.
	Endproc

	Procedure shape2.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	lnHandle = Thisform.HWnd
	param1 = 274
	param2 = 0xF012
	Declare Integer ReleaseCapture In WIN32API
	Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
	bb=ReleaseCapture()
	bb=SendMessage(lnHandle, param1, param2,0)
	Endproc

	Procedure image1.Click
	Thisform.Release
	Endproc


Enddefine
*
*-- EndDefine: ytooltip
*************************


 

Download this image and name it :  "crab_nebula.jpg ".its the main form background.

Download this image and name it : "crab_nebula.jpg ".its the main form background.

A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip
A custom vfp Ansi and Unicode  tooltip

*Arabic.txt

تمكن القطري ناصر الخليفي، بفضل الإمكانات المالية الضخمة التي سخّرها عند تقلده
 منصب الرئيس المدير العام لفريق العاصمة الباريسية، في نوفمبر 2011،
 من فرض الـ”بي.أس.جي”
في الساحة الكروية الفرنسية. والأكثر من هذا، أصبح النادي الفرنسي يزاحم أكبر
 وأعرق النوادي العالمية في انتداب النجوم، بدليل أن تشكيلة قائد الديكة
 سابقا لوران بلان تضم في صفوفها لاعبين من الوزن الثقيل،
لا يمكن للفرنسيين حتى من الحلم في رؤيتهم في الملاعب الفرنسية من أمثال
 السويدي زلاتان إيبراهاموفيتش والبرازيليين
دافيد لويز و تياغو سيلفا ولوكاس والايطالي فيراتي والأوروغواياني كافاني وآخرين ممن لم يقدروا
 على مقاومة العرض المالي الذي قدمه الخليفي صاحب مؤسسة قطر للاستثمارات الرياضية.
ناصر الخليفي صاحب الـ42 عاما (من مواليد 1973 بقطر)، تمكن بفضل تسييره
 الراشد من قيادة باريس سانت جيرمان إلى هرم البطولة الفرنسية، لاسيما خلال
 هذا الموسم الذي انتزع فيه الفريق الرباعية التاريخية (كأس وبطولة فرنسا)
 وكأس الرابطة و كأس السوبر.. وهي كلها ألقاب جعلت من ناصر الخليفي، رئيس المؤسسة
 الإعلامية الكبيرة بيين سبور القطرية، من كسب قلوب الفرنسيين الذين يكنون
 له كل الاحترام والتقدير،
 وهو ما وقفت عليه “الخبر” ميدانيا في ملعب فرنسا، على هامش نهائي كأس فرنسا الذي
 عادت فيه الكلمة الأخيرة لـ”بي.أس.جي” بعد هدف كافاني في مرمى نادي أوكسير.

 

*chinese.txt

虰豖阹 漈禊禓 蜙 臌薠, 櫱瀯 鶭黮齥 匢奾灱 彃 虰豖 涬淠淉 濍燂犝 葎萻萶 蔰, 簎艜薤 艎艑蔉 忕汌卣 駺駹 鳼, 撖撱暲 厊圪妀 嫷 趛踠 耇胇赲 厗垌壴 墏 臷菨, 鴙儤嬯 榶榩榿 蕺薂 滘, 緷 蔏蔍 氉燡磼 廲籗糴 婂崥崣 漀 厏吪吙 牚猳琭 藶藽, 滈 褗褆諓 廘榙榾 轚酁
絼 綧緁緅 鱐鱍鱕 厹屴 褌 礛簼繰 釢髟偛 鸄齴, 蝩覤 氉燡磼 玾珆玸 嶝仉圠 箷 愄揎揇 驐鷑鷩 綧 圢帄, 蒏 駺駹 橀槶澉 鏾鐇闠 綧 掭掝 蔰蝯蝺 惝掭掝
劁 蒏葝葮 豲貕貔 觾韄鷡 塝嫀, 嵷 蚙迻 燲獯璯 婰婜孲 荾莯袎 鳭 饓鶪 腷腯葹 濆澓澋 曋橪橤 跿 漊煻獌 捃挸栚 蕍蕧螛 緅蒮, 錛鍆 硾 蘹蠮躘 鱙鷭黂 蠬襱覾 顤鰩鷎 轗鐔飂 禠 箷箯 緅 嬞嶭 漊煻獌 噾噿嚁 嶕憱撏 儹巏 緦膣膗 蕷薎薍 椸楢楩 筡, 殟 圩芰敔 屼汆冹 姌弣抶 痸碚, 垥娀 鋑鋡髬 婸媥媕 煻
瘑睯碫 疿疶砳 轞騹鼚 獯璯 潧 耏胠 鄜 彃慔慛 蝪蝩覤 椼毸溠, 濈瀄 骱 蘹蠮躘 瞗穇縍 軥軱逴, 潿熥獘 襏襆贂 鸙讟钃 榯 躘鑕 緦膣膗 貵趀跅 焟硱 諙 銈 駽髾 犌犐瑆 沀皯竻, 萆覕貹 寱懤擨 銙 鸕驨 杍肜 綒 箛箙舕 蔝蓶蓨, 獌 郪釸 稨窨箌 鑳鱨鱮 姴怤昢
跾 諨諿 墐墆墏 鮛鮥鴮 萷葋蒎 繖藒 蓪 廦廥彋 橁橖澭 鋧鋓頠 蔏蔍蓪 悊惀桷 璻甔 踙 摓 喥喓 磩磟窱 碄碆碃, 跿 虥諰諨 幨懅憴 礂簅縭 楘溍 趍 寱懤擨 顲鱭鸋 沀皯竻 袚觙, 葝 虥諰諨 覿讄讅 裌覅詵 蛶觢 韣顪飋 毞泂泀 鋱 駽髾, 鑗鱐 鄜 皾籈譧 鏾鐇闠 礯籔羻

  

*Hindi.txt

चिदंश करता अधिकार प्रव्रुति स्वतंत्र कार्यसिधान्तो ढांचामात्रुभाषा गएआप वर्णन होसके लिये स्थिति प्रमान हमेहो। हुआआदी स्वतंत्र सुचनाचलचित्र पुर्व सेऔर प्रमान स्वतंत्रता शीघ्र सुना अपने क्षमता क्षमता। देखने संभव उदेशीत दोषसके विवरण तकरीबन गटकउसि होभर पुर्व विवरन शुरुआत क्षमता भारत होगा ऎसाजीस अविरोधता विवरण अपने समाजो है।अभी विनिमय विकेन्द्रियकरण देकर खरिदे है।अभी गयेगया वातावरण एसेएवं पहोचाना करके(विशेष करते जिसकी हुआआदी सुस्पश्ट प्रतिबध्दता भाषा सहयोग
ढांचा पासपाई अनुवाद देकर आवश्यक पुर्णता गोपनीयता डाले। जाएन विश्व देते माध्यम विश्वव्यापि मुख्य लचकनहि सोफ़्टवेर प्रव्रुति मानव माध्यम सामूहिक मर्यादित हिंदी पसंद प्रव्रुति विचारशिलता जाता संदेश उदेश आवश्यक बेंगलूर प्रतिबध दौरान सदस्य उनको द्वारा समस्याओ भोगोलिक जानते प्रमान पासपाई प्राधिकरन करने
प्रसारन अधिकांश बाधा पहोच। पत्रिका जानकारी बीसबतेबोध सादगि कलइस सहायता अत्यंत ध्येय कलइस तरहथा। विज्ञान उनके सदस्य विभाग अंतर्गत सोफ़्टवेर जिसे बहुत व्याख्यान स्वतंत्रता अमितकुमार विशेष देखने उनके उसीएक् अंतर्गत सामूहिक निर्माण अपने जिसकी चाहे लाभान्वित अर्थपुर्ण तरीके सादगि सुनत एसलिये बीसबतेबोध

 

*Greek.txt

Νο δισο αβχορρεανθ σεα, ατ εως φοσεντ ερροριβυς. Μελ θε κυις σονσλυσιονεμκυε, εξπετενδα ιυδισαβιτ νεγλεγενθυρ εαμ εα, υσυ συμο λαυδεμ ετ. Σαπερεθ ασεντιορ ρεπριμικυε ναμ νε, ευ μει χινς σαεφολα ρεφορμιδανς. Ηας λιβρις περτιναξ ιν.
Λεγερε φιρθυθε ινερμις ιν φελ. Υθ κυι νοσθρυδ δεσερυντ σριβενθυρ, σεθερος ινδοστυμ ιυς ιδ, ευ αγαμ λαβωρε ηωνεσθαθις δυο. Φιθαε δεσερυντ μεδιοσρεμ υθ κυι. Ευ μει φιφενδυμ ρεφερρεντυρ σονσλυσιονεμκυε, ατ δισθας δεφινιτιωνες πρι.

 

*Ciryllic.txt

Дуо йн дэбыт трётанё. Факэр дёзсэнтёаш компльыктётюр но мэя. Эи ыюм мовэт квюандо рыпрэхэндунт, ан съюммо мэльиорэ вим, ут эжт жанктюч пожйдонёюм. Луптатум мэнандря адолэжкэнс мыа ед.
Декам аккюмзан пхаэдрум ты вим, эож нюлльа омнэжквюы мальюизчыт эи. Лобортис пытынтёюм аппэльлььантюр мэль эи, эвэртё пожйдонёюм мэя эю, доктюж эквюедым молыжтйаы прё ты. Ан ыам фэугяат омйттам дяшзынтиыт, ыюм ку квуым витаэ лобортис. Жюмо натюм аэквюы еюж нэ. Ырант дольорэ фабыллас ыт ыюм, ат натюм либриз лыгэндоч ыюм. Ыюм ат пэрчыквюэрёж дытыррюизщэт, ыт хаж конгуы оптёон.

 

To be informed of the latest articles, subscribe:
Comment on this post