A custom vfp Ansi and Unicode tooltip
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
*************************
*Arabic.txt
تمكن القطري ناصر الخليفي، بفضل الإمكانات المالية الضخمة التي سخّرها عند تقلده
منصب الرئيس المدير العام لفريق العاصمة الباريسية، في نوفمبر 2011،
من فرض الـ”بي.أس.جي”
في الساحة الكروية الفرنسية. والأكثر من هذا، أصبح النادي الفرنسي يزاحم أكبر
وأعرق النوادي العالمية في انتداب النجوم، بدليل أن تشكيلة قائد الديكة
سابقا لوران بلان تضم في صفوفها لاعبين من الوزن الثقيل،
لا يمكن للفرنسيين حتى من الحلم في رؤيتهم في الملاعب الفرنسية من أمثال
السويدي زلاتان إيبراهاموفيتش والبرازيليين
دافيد لويز و تياغو سيلفا ولوكاس والايطالي فيراتي والأوروغواياني كافاني وآخرين ممن لم يقدروا
على مقاومة العرض المالي الذي قدمه الخليفي صاحب مؤسسة قطر للاستثمارات الرياضية.
ناصر الخليفي صاحب الـ42 عاما (من مواليد 1973 بقطر)، تمكن بفضل تسييره
الراشد من قيادة باريس سانت جيرمان إلى هرم البطولة الفرنسية، لاسيما خلال
هذا الموسم الذي انتزع فيه الفريق الرباعية التاريخية (كأس وبطولة فرنسا)
وكأس الرابطة و كأس السوبر.. وهي كلها ألقاب جعلت من ناصر الخليفي، رئيس المؤسسة
الإعلامية الكبيرة بيين سبور القطرية، من كسب قلوب الفرنسيين الذين يكنون
له كل الاحترام والتقدير،
وهو ما وقفت عليه “الخبر” ميدانيا في ملعب فرنسا، على هامش نهائي كأس فرنسا الذي
عادت فيه الكلمة الأخيرة لـ”بي.أس.جي” بعد هدف كافاني في مرمى نادي أوكسير.
*chinese.txt
虰豖阹 漈禊禓 蜙 臌薠, 櫱瀯 鶭黮齥 匢奾灱 彃 虰豖 涬淠淉 濍燂犝 葎萻萶 蔰, 簎艜薤 艎艑蔉 忕汌卣 駺駹 鳼, 撖撱暲 厊圪妀 嫷 趛踠 耇胇赲 厗垌壴 墏 臷菨, 鴙儤嬯 榶榩榿 蕺薂 滘, 緷 蔏蔍 氉燡磼 廲籗糴 婂崥崣 漀 厏吪吙 牚猳琭 藶藽, 滈 褗褆諓 廘榙榾 轚酁
絼 綧緁緅 鱐鱍鱕 厹屴 褌 礛簼繰 釢髟偛 鸄齴, 蝩覤 氉燡磼 玾珆玸 嶝仉圠 箷 愄揎揇 驐鷑鷩 綧 圢帄, 蒏 駺駹 橀槶澉 鏾鐇闠 綧 掭掝 蔰蝯蝺 惝掭掝
劁 蒏葝葮 豲貕貔 觾韄鷡 塝嫀, 嵷 蚙迻 燲獯璯 婰婜孲 荾莯袎 鳭 饓鶪 腷腯葹 濆澓澋 曋橪橤 跿 漊煻獌 捃挸栚 蕍蕧螛 緅蒮, 錛鍆 硾 蘹蠮躘 鱙鷭黂 蠬襱覾 顤鰩鷎 轗鐔飂 禠 箷箯 緅 嬞嶭 漊煻獌 噾噿嚁 嶕憱撏 儹巏 緦膣膗 蕷薎薍 椸楢楩 筡, 殟 圩芰敔 屼汆冹 姌弣抶 痸碚, 垥娀 鋑鋡髬 婸媥媕 煻
瘑睯碫 疿疶砳 轞騹鼚 獯璯 潧 耏胠 鄜 彃慔慛 蝪蝩覤 椼毸溠, 濈瀄 骱 蘹蠮躘 瞗穇縍 軥軱逴, 潿熥獘 襏襆贂 鸙讟钃 榯 躘鑕 緦膣膗 貵趀跅 焟硱 諙 銈 駽髾 犌犐瑆 沀皯竻, 萆覕貹 寱懤擨 銙 鸕驨 杍肜 綒 箛箙舕 蔝蓶蓨, 獌 郪釸 稨窨箌 鑳鱨鱮 姴怤昢
跾 諨諿 墐墆墏 鮛鮥鴮 萷葋蒎 繖藒 蓪 廦廥彋 橁橖澭 鋧鋓頠 蔏蔍蓪 悊惀桷 璻甔 踙 摓 喥喓 磩磟窱 碄碆碃, 跿 虥諰諨 幨懅憴 礂簅縭 楘溍 趍 寱懤擨 顲鱭鸋 沀皯竻 袚觙, 葝 虥諰諨 覿讄讅 裌覅詵 蛶觢 韣顪飋 毞泂泀 鋱 駽髾, 鑗鱐 鄜 皾籈譧 鏾鐇闠 礯籔羻
*Hindi.txt
चिदंश करता अधिकार प्रव्रुति स्वतंत्र कार्यसिधान्तो ढांचामात्रुभाषा गएआप वर्णन होसके लिये स्थिति प्रमान हमेहो। हुआआदी स्वतंत्र सुचनाचलचित्र पुर्व सेऔर प्रमान स्वतंत्रता शीघ्र सुना अपने क्षमता क्षमता। देखने संभव उदेशीत दोषसके विवरण तकरीबन गटकउसि होभर पुर्व विवरन शुरुआत क्षमता भारत होगा ऎसाजीस अविरोधता विवरण अपने समाजो है।अभी विनिमय विकेन्द्रियकरण देकर खरिदे है।अभी गयेगया वातावरण एसेएवं पहोचाना करके(विशेष करते जिसकी हुआआदी सुस्पश्ट प्रतिबध्दता भाषा सहयोग
ढांचा पासपाई अनुवाद देकर आवश्यक पुर्णता गोपनीयता डाले। जाएन विश्व देते माध्यम विश्वव्यापि मुख्य लचकनहि सोफ़्टवेर प्रव्रुति मानव माध्यम सामूहिक मर्यादित हिंदी पसंद प्रव्रुति विचारशिलता जाता संदेश उदेश आवश्यक बेंगलूर प्रतिबध दौरान सदस्य उनको द्वारा समस्याओ भोगोलिक जानते प्रमान पासपाई प्राधिकरन करने
प्रसारन अधिकांश बाधा पहोच। पत्रिका जानकारी बीसबतेबोध सादगि कलइस सहायता अत्यंत ध्येय कलइस तरहथा। विज्ञान उनके सदस्य विभाग अंतर्गत सोफ़्टवेर जिसे बहुत व्याख्यान स्वतंत्रता अमितकुमार विशेष देखने उनके उसीएक् अंतर्गत सामूहिक निर्माण अपने जिसकी चाहे लाभान्वित अर्थपुर्ण तरीके सादगि सुनत एसलिये बीसबतेबोध
*Greek.txt
Νο δισο αβχορρεανθ σεα, ατ εως φοσεντ ερροριβυς. Μελ θε κυις σονσλυσιονεμκυε, εξπετενδα ιυδισαβιτ νεγλεγενθυρ εαμ εα, υσυ συμο λαυδεμ ετ. Σαπερεθ ασεντιορ ρεπριμικυε ναμ νε, ευ μει χινς σαεφολα ρεφορμιδανς. Ηας λιβρις περτιναξ ιν.
Λεγερε φιρθυθε ινερμις ιν φελ. Υθ κυι νοσθρυδ δεσερυντ σριβενθυρ, σεθερος ινδοστυμ ιυς ιδ, ευ αγαμ λαβωρε ηωνεσθαθις δυο. Φιθαε δεσερυντ μεδιοσρεμ υθ κυι. Ευ μει φιφενδυμ ρεφερρεντυρ σονσλυσιονεμκυε, ατ δισθας δεφινιτιωνες πρι.
*Ciryllic.txt
Дуо йн дэбыт трётанё. Факэр дёзсэнтёаш компльыктётюр но мэя. Эи ыюм мовэт квюандо рыпрэхэндунт, ан съюммо мэльиорэ вим, ут эжт жанктюч пожйдонёюм. Луптатум мэнандря адолэжкэнс мыа ед.
Декам аккюмзан пхаэдрум ты вим, эож нюлльа омнэжквюы мальюизчыт эи. Лобортис пытынтёюм аппэльлььантюр мэль эи, эвэртё пожйдонёюм мэя эю, доктюж эквюедым молыжтйаы прё ты. Ан ыам фэугяат омйттам дяшзынтиыт, ыюм ку квуым витаэ лобортис. Жюмо натюм аэквюы еюж нэ. Ырант дольорэ фабыллас ыт ыюм, ат натюм либриз лыгэндоч ыюм. Ыюм ат пэрчыквюэрёж дытыррюизщэт, ыт хаж конгуы оптёон.