Reading RSS Feeds with another presentation.

Published on by Yousfi Benameur

        

this code builds a new method to read the internet feeds.i wrote in previous posts on feeds (see below the link).
Any feed have an url location and can retrieves fields as  title,description,date,author,link.....
the code uses the protocole  XMLHTTP do access to the RSS feeds (in the web sites).
the xml file have the tags < items >< / items >,< description >< /description >,< link >< / link >  extracted and gathered in a cursor.
the vfp functions strExtract and Strtran  does the job for parsing the xml file.Note all feeds dont use standard xml.
feeds are generally in all languages as unicode.VFP dont accepts unicode but tweaking the editbox and labels used here
can be solved.use the fontcharset relative to any unicode language to retrieve it as it on the vfp controls.
for occidental languages there is no problem
i shipped many feeds from arabic ,russian,chinese, japanese,Greek,Korean,Thai...(unicode).must use the fontCharset property to retrieve as it the contents.
see the photo attached for the fontCharset to specify.
Any click on "Read more..." fires the destination web page on the user default navigator (class hyperlink).
Each feeds (container) is removed firstly and re created  from the class.
Can add your favorite feeds in the comboBox.can customize the container background pictures (2 sent as hexa code).

Note: here feeds accepted are those with UTF-8 encoding(in the page see the code source and the first line must contains :
< ?xml version="1.0" encoding="UTF-8"? > (encoding="UTF-8").
this because i used strconv(...11) whose translate the utf-8 chars to double bits chars.
with the method i used can fill editbox,textbox,label with any world language (from utf-8 encoding).
- one problem : when scrolling the form !(trails) ! partly solved by continousScroll=.f. and VscollSmallChange=60...use also mouseWheel to scroll).

[Post 247]


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



*1* created on thursday 30 of november 2017 -updated 02 of december 2017
*another method to present Feeds as Windows10 News App.
*fontcharset can found at :
*https://msdn.microsoft.com/en-us/library/cc194829.aspx	
*https://www.microsoft.com/resources/msdn/goglobal/default.mspx
*internet must be connected.

_screen.windowstate=1
Publi oform
oform=Newobject("yform")
oform.Show
Read Events
Retu
*
Define Class yform As Form
Top = 0
Left = 0
Height = 650
Width = 1060
ShowWindow=2
ShowTips = .T.
AutoCenter=.T.
ScrollBars=2  && vertical scroll
BackColor=0
Caption = "Form1"
ContinuousScroll=.f.  && form scroll occurs only when scrollbox released
VscrollSmallChange=60
Name = "form1"

Add Object combo1 As ComboBox With ;
Height = 24, ;
Left = 12, ;
Top = 12, ;
Width = 210, ;
Name = "Combo1"

Add Object ylab1 As Label With ;
caption="My new VFP RSS Feeds", ;
backstyle=0, ;
left=250  ,;
top=12  ,;
autosize=.T.,;
fontbold=.T.,;
fontsize=36,;
forecolor=Rgb(45,45,45),;
name="ylab1"

Add Object ylab2 As Label With ;
caption="My new VFP RSS Feeds", ;
backstyle=0, ;
left=250+5  ,;
top=12+5  ,;
autosize=.T.,;
fontbold=.T.,;
fontsize=36,;
forecolor=Rgb(128,54,0),;
name="ylab2"

Add Object ylang As Label With ;
caption="", ;
backstyle=0, ;
left=850  ,;
top=12  ,;
autosize=.T.,;
fontbold=.T.,;
fontsize=16,;
forecolor=Rgb(0,255,0),;
name="ylang"


Add Object yhelp As Label With ;
caption="?", ;
backstyle=0, ;
left=1060-60  ,;
top=12+5  ,;
autosize=.T.,;
fontbold=.T.,;
fontsize=36,;
forecolor=Rgb(0,255,0),;
mousepointer=15,;
name="yhelp"

procedure yhelp.click
local m.myvar
text to m.myvar noshow
this code builds a new method to read the internet feeds.i wrote in previous posts on feeds (see below the link).
Any feed have an url location and can retrieves fields as  title,description,date,author,link.....
the code uses the protocole  XMLHTTP do access to the RSS feeds (in the web sites).
the xml file have the tags < items >< / items >,< description >< /description >,< link >< / link >  extracted and gathered in a cursor.
the vfp functions strExtract and Strtran  does the job for parsing the xml file.Note all feeds dont use standard xml.
feeds are generally in all languages as unicode.VFP dont accepts unicode but tweaking the editbox and labels used here
can be solved.use the fontcharset relative to any unicode language to retrieve it as it on the vfp controls.
for occidental languages there is no problem
i shipped many feeds from arabic ,russian,chinese, japanese,Greek,Korean,Thai...(unicode).must use the fontCharset property to retrieve as it the contents.
see the photo attached for the fontCharset to specify.
Any click on "Read more..." fires the destination web page on the user default navigator (class hyperlink).
Each feeds (container) is removed firstly and re created  from the class.
Can add your favorite feeds in the comboBox.can customize the container background pictures (2 sent as hexa code).

Note: here feeds accepted are those with UTF-8 encoding(in the page see the code source and the first line must contains :
< ?xml version="1.0" encoding="UTF-8"? > (encoding="UTF-8").
with the method i used can fill editbox,textbox,label with any world language (from utf-8 encoding).

endtext
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096)
oshell=Null
endproc

Procedure Load
Set Safe Off
Close Data All
Endproc

Procedure Init
Thisform.ShowTips=.F.
Endproc

Procedure Destroy
Clea Resources
Erase  Addbs(Sys(2023)+"ytemp.gif"
Erase  Addbs(Sys(2023)+"ytemp1.gif"
Clea Events
Endproc

Procedure combo1.Click
Local  m.xFontCharSet,m.xlang
do case
case inlist(this.value,1,10)
m.xfontcharset=204   &&russe
m.xlang="Russian"

case inlist(this.value,5,6,7,9,18)
m.xfontcharset=178   && arabic/urdu
m.xlang="Arabic"

case this.value=11
m.xfontcharset=136   && chinese
m.xlang="Chinese"

case this.value=12
m.xfontcharset=0 && hindi  ?fontcharset ?? to find
m.xlang="hindi ??"

case this.value=13
m.xfontcharset=128   && japan
m.xlang="japanese"

case this.value=14
m.xfontcharset=162  && Turkish
m.xlang="Turkish"

case this.value=15
m.xfontCharSet=161  && Greek
m.xlang="Greek"

case this.value=16
m.xfontCharset=129  && Korean
m.xlang="Korean"

case this.value=17
m.xFontCharSet=222   && Thai
m.xlang="Thai"

otherwise
m.xfontcharset=0  && or 238 EE fontCharset
m.xlang="Occidental"
endcase

thisform.ylang.caption=m.xlang

Local m.lcUrl,m.xdate
m.lcUrl=Thisform.combo1.List(Thisform.combo1.Value)
Try
Sele ycurs
Zap
use in select("ycurs")
Catch
Endtry
Create Cursor ycurs  (Fitems m)

Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcUrl,.F.)
m.loRequest.Send()
m.xtext=m.loRequest.ResponseBody
m.loRequest=Null

m.xtext=strtran(m.xtext,"<item >","<item>")  && prevent some syntaxes of item tag ...
m.xtext=strtran(m.xtext,"</item >","</item>")


Local m.u
Thisform.LockScreen=.T.
i=1
Do While .T.
m.u=Strextract(m.xtext,"<item>","</item>",i)
If !Empty(m.u)
	Insert Into ycurs Values ( m.u)
	i=i+1
Else
	Exit
Endi
Enddo

With  Thisform
Sele ycurs
*Brow

*remove all ycnt containers on form (thanks to Martina Jindrova)
with thisform
For i=.ControlCount TO 1 STEP -1   && i=1 to .ControlCount    dont work (??)
m.Obj=.Controls(i)
=IIf(Lower(obj.Class)=="ycnt",.RemoveObject(obj.Name),.T.)
Next
endwith

	Local m.delta
	m.delta=10

	Local m.gn,m.k,m.gn0
	m.k=1
	m.gn0=  Floor(Thisform.Width/336)         &&336 =ycnt width  &&ycnt container per row
	m.gn=1
	m.k=0
	m.i=1
  Sele ycurs
	Scan
		i=Recno()
		Try
			.AddObject("ycnt"+Trans(i),"ycnt")
		Catch
		Endtry

		With  Eval(".ycnt"+Trans(i))
			DoDefault()
			Do Case
				Case i=1
					.Left=10
					.Top=Thisform.ylab2.Top+Thisform.ylab2.Height+m.delta
				Otherwise
					If m.gn<m.gn0
						.Left=Eval("thisform.ycnt"+Trans(i-1)+".left")+Eval("thisform.ycnt"+Trans(i-1)+".width")+m.delta
						.Top=Eval("thisform.ycnt"+Trans(i-1)+".top")
						gn=gn+1
					Else
						k=k+1
						m.gn=1
						.Left=10
						.Top=Thisform.ycnt1.Top+(k)*(.Height+m.delta)
					Endi
			Endcase
			With .label1
				.FontName="Arial Unicode MS"  &&unicode font
				.FontCharSet=m.xFontCharSet
				xCaption= Strextract(Fitems,"<title>","</title>",1)
				xCaption=Strtran(xCaption,"<![CDATA[","")
				xCaption=Strtran(xCaption,"]]>","")
				.Caption= Strconv(m.xCaption,11,m.xfontcharset,2)
			Endwith
			
			m.xdate=Strextract(Fitems,"<pubDate>","</pubDate>")
			m.xdate=strconv(m.xdate,11,m.xfontcharset,2)

			With .edit1
				.FontName="Tahoma"     &&unicode font
				.FontCharSet=m.xfontCharSet
				m.xValue=Strextract(Fitems,"<description>","</description>")+Chr(13)+Chr(10)+m.xdate
				m.xValue=Strtran(m.xValue,"<![CDATA[","")
				m.xValue=Strtran(m.xValue,"]]>","")
				.Value=Strconv(m.xValue,11,m.xfontcharset,2)
			Endwith
sele ycurs

			.label2.Caption="["+Trans(Recno())+"]      Read more...     "
			.Enabled=.F.
			.Refresh
			.Visible=.T.
		Endwith

	Endscan
	.LockScreen=.F.
	.Refresh
Endwith
Endproc

Procedure Scrolled
Lparameters nDirection
Thisform.Refresh
Endproc

Procedure combo1.Init
With This
 .Additem("http://www.mk.ru/rss/index.xml",1)  && russian
.AddItem("http://yousfi.over-blog.com/rss",2)
.AddItem("http://feeds.feedburner.com/GalerieFArtciles",3)
.AddItem("http://dia-algerie.com/feed/",4)
.AddItem("https://www.echoroukonline.com/ara/feed/index.rss",5)
.AddItem("http://www.al-fadjr.com/ar/feed/index.1.rss",6)
.AddItem("http://feeds.feedburner.com/GalerieArtciles",7)
.additem("http://www.sweetpotatosoftware.com/spsblog/SyndicationService.asmx/GetRss",8)
.addItem("http://www.ettelaat.com/etiran/?feed=rss2",9)  && farsi
.additem("http://www.mk.ru/rss/politics/index.xml",10)   && russian
.addItem("http://feeds.bbci.co.uk/zhongwen/simp/rss.xml",11)  && chinese
.additem("http://rss.jagran.com/rss/news/national.xml",12)  && hindi
.additem("https://osdn.net/projects/nhocr/news/rss",13)   && japan
.additem("http://www.turkiyegazetesi.com.tr/rss/rss.xml",14)  && turkish
.addItem("https://www.rizospastis.gr/rssFeed.do?channel=Top",15)  && Greek
.additem("http://www.chosun.com/site/data/rss/rss.xml",16)  && Korean
.addItem("http://www.thairath.co.th/rss/news",17)  && Thai
.additem("http://feeds.bbci.co.uk/urdu/rss.xml",18)  && Urdu
.ListIndex=1
.Style=2
.Value=1
Endwith
Endproc

Procedure Resize
DoDefault()
With This
For Each obj In .Controls
	If Lower(m.obj.Class)=="ycnt"
		obj.Refresh
	Endi
Next
Endwith
thisform.combo1.click()
Endproc

Enddefine
*
*-- EndDefine: yform

*
Define Class ycnt As Container
Top = 96
Left = 60
Width = 336
Height = 216
BorderWidth = 0
SpecialEffect = 2
BorderColor = Rgb(0,0,160)
Name = "ycnt"

Add Object edit1 As EditBox With ;
FontBold = .T., ;
FontItalic = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Enabled = .F., ;
Height = 117, ;
Left = 9, ;
ScrollBars = 0, ;
Top = 63, ;
Width = 315, ;
forecolor=0, ;			
disabledforecolor=0, ;
Name = "Edit1"

Add Object label2 As Label With ;
FontBold = .T., ;
FontSize = 11, ;
WordWrap = .T., ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "", ;
Height = 20, ;
Left = 6, ;
MousePointer = 15, ;
Top = 191, ;
Width = 318, ;
ForeColor = Rgb(0,83,83), ;
Name = "Label2"

Add Object label1 As Label With ;
FontBold = .T., ;
FontSize = 11, ;
WordWrap = .T., ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "", ;
Height = 51, ;
Left = 10, ;
Top = 5, ;
Width = 314, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"

Procedure Init
With This
local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ytemp1.gif"
If !(File(m.lcdest,1))
Local m.myvar,m.myvar1
text to m.myvar  noshow
R0lGODlhKQAmAGAAACwAAAAAKQAmAIcAAAAAADMAAGYAAJkAAMwAAP8AKwAAKzMAK2YAK5kAK8wAK/8AVQAAVTMAVWYAVZkAVcwAVf8AgAAAgDMAgGYAgJkAgMwAgP8AqgAAqjMAqmYAqpkAqswAqv8A1QAA1TMA1WYA1ZkA1cwA1f8A/wAA/zMA/2YA/5kA/8wA//8zAAAzADMzAGYzAJkzAMwzAP8zKwAzKzMzK2YzK5kzK8wzK/8zVQAzVTMzVWYzVZkzVcwzVf8zgAAzgDMzgGYzgJkzgMwzgP8zqgAzqjMzqmYzqpkzqswzqv8z1QAz1TMz1WYz1Zkz1cwz1f8z/wAz/zMz/2Yz/5kz/8wz//9mAABmADNmAGZmAJlmAMxmAP9mKwBmKzNmK2ZmK5lmK8xmK/9mVQBmVTNmVWZmVZlmVcxmVf9mgABmgDNmgGZmgJlmgMxmgP9mqgBmqjNmqmZmqplmqsxmqv9m1QBm1TNm1WZm1Zlm1cxm1f9m/wBm/zNm/2Zm/5lm/8xm//+ZAACZADOZAGaZAJmZAMyZAP+ZKwCZKzOZK2aZK5mZK8yZK/+ZVQCZVTOZVWaZVZmZVcyZVf+ZgACZgDOZgGaZgJmZgMyZgP+ZqgCZqjOZqmaZqpmZqsyZqv+Z1QCZ1TOZ1WaZ1ZmZ1cyZ1f+Z/wCZ/zOZ/2aZ/5mZ/8yZ///MAADMADPMAGbMAJnMAMzMAP/MKwDMKzPMK2bMK5nMK8zMK//MVQDMVTPMVWbMVZnMVczMVf/MgADMgDPMgGbMgJnMgMzMgP/MqgDMqjPMqmbMqpnMqszMqv/M1QDM1TPM1WbM1ZnM1czM1f/M/wDM/zPM/2bM/5nM/8zM////AAD/ADP/AGb/AJn/AMz/AP//KwD/KzP/K2b/K5n/K8z/K///VQD/VTP/VWb/VZn/Vcz/Vf//gAD/gDP/gGb/gJn/gMz/gP//qgD/qjP/qmb/qpn/qsz/qv//1QD/1TP/1Wb/1Zn/1cz/1f///wD//zP//2b//5n//8z///8AAAAAAAAAAAAAAAAI/wD1KdMnUB80etAIKkw2cF8yegYLDjQIMSHBgRMV6mOoDyFEgdCSDdO3L2LHhMlInqTHcaPCgdAcZjI4kqSyhwn37XtGTxlKZcN+aixJEFpDiA81miRYkmGylDcvFtxnlKgyZfMipkwW86SyngU73vTYUaVGiE3DRr2pLN/NlAQ5vkU4z6LUmyEnDuQIl+BHvSP3Br3LNWpSuDeHwe3pE6HAkQ6FWsQaciTDiUQFMkwYsi/MlA57Lo6LuazfrqfpsVRWsi1UuFyZSgQdtqTRiwx5Lh2r1/ZHzbdxq4zqkPjG1kVfulXYtS/jfCRDotWnWCXfy9YFoj3YMZntlAehzf/7Ojm2Zr97NaevbFDvR8cw667GPTHhdNjdJ66OXVjjxKf6JUTecA15NxRPA4H1m0JU/RbVRdCFJVVXJdGVk0vtXTXfRg0p9ZRAY3HXXkutGUgZdYU9eBVbNB0EXl1+yRWXYzUJ9Exa2Uko1VAhLXQVXBdSRpRVEHWY2UVXlaUXg2ItpNJBP5qnmYwb8ZWeQyNSlElNxCgGWoXS/YgQRv6FxRBLYV341IVqMadPVm5iuKJUtJHEkU4QCrRcWZxRl5FDDLm1J2siceiXepvVdOGYhGlEJZW3PYRVU/YtGaOheD4I5j57njcZUyI5hVyWb9VXJYBOVdmdi3EZiKOLHxmSaNqcOyI0KkPDNNQaa9T1KNtUQ0mYJFN72XUiSy52uNZ5JW1pklwfDhfeVl/x1Nx/AE6p0j5YkUYSQorVNd55w4IlUZHZ4kllU/UhlGpbPlkZF0VMJiblTUOSZdZGv7Uk4LZEtZTknTT1VdSwR6ZnqI4Y2rmqSmP+ppNcAwUGm2JJlvYSkBkJ16tLt2WEF516BQQAOw==
Endtext
=Strtofile(Strconv(m.myvar,14),m.lcdest)
endi

local m.lcdest1
m.lcdest1=Addbs(Sys(2023))+"ytemp.gif"
If !(File(m.lcdest1,1))
text to m.myvar1  noshow
R0lGODdhMAAwAHAAACH5BAQEAQAALAAAAAAwADAAhwAAAAAAMwAAZgAAmQAAzAAA/wArAAArMwArZgArmQArzAAr/wBVAABVMwBVZgBVmQBVzABV/wCAAACAMwCAZgCAmQCAzACA/wCqAACqMwCqZgCqmQCqzACq/wDVAADVMwDVZgDVmQDVzADV/wD/AAD/MwD/ZgD/mQD/zAD//zMAADMAMzMAZjMAmTMAzDMA/zMrADMrMzMrZjMrmTMrzDMr/zNVADNVMzNVZjNVmTNVzDNV/zOAADOAMzOAZjOAmTOAzDOA/zOqADOqMzOqZjOqmTOqzDOq/zPVADPVMzPVZjPVmTPVzDPV/zP/ADP/MzP/ZjP/mTP/zDP//2YAAGYAM2YAZmYAmWYAzGYA/2YrAGYrM2YrZmYrmWYrzGYr/2ZVAGZVM2ZVZmZVmWZVzGZV/2aAAGaAM2aAZmaAmWaAzGaA/2aqAGaqM2aqZmaqmWaqzGaq/2bVAGbVM2bVZmbVmWbVzGbV/2b/AGb/M2b/Zmb/mWb/zGb//5kAAJkAM5kAZpkAmZkAzJkA/5krAJkrM5krZpkrmZkrzJkr/5lVAJlVM5lVZplVmZlVzJlV/5mAAJmAM5mAZpmAmZmAzJmA/5mqAJmqM5mqZpmqmZmqzJmq/5nVAJnVM5nVZpnVmZnVzJnV/5n/AJn/M5n/Zpn/mZn/zJn//8wAAMwAM8wAZswAmcwAzMwA/8wrAMwrM8wrZswrmcwrzMwr/8xVAMxVM8xVZsxVmcxVzMxV/8yAAMyAM8yAZsyAmcyAzMyA/8yqAMyqM8yqZsyqmcyqzMyq/8zVAMzVM8zVZszVmczVzMzV/8z/AMz/M8z/Zsz/mcz/zMz///8AAP8AM/8AZv8Amf8AzP8A//8rAP8rM/8rZv8rmf8rzP8r//9VAP9VM/9VZv9Vmf9VzP9V//+AAP+AM/+AZv+Amf+AzP+A//+qAP+qM/+qZv+qmf+qzP+q///VAP/VM//VZv/Vmf/VzP/V////AP//M///Zv//mf//zP///wAAAAAAAAAAAAAAAAj/APXR0yew4ECDAw/SS0hwoUCGDgXmW6hQob52FOnN0+dOI718D/XN8zjSo0aB80aObKdSZcWF+VSiHDiS48yaC0tOLNnS5cd2DwfuzPlRo06aDk9CJLgxYcSkOUtSlOjQXUipVxFmfMlQZE6JOB1ODNqyKNGhXkk2zajV4FqvONM2bUgV6VqacKFOzXiUIda9Zt9OLDpW32CRHPMBVVhTasKUKY26Y2lQ61ascZ9aRLhvHkuuPNXihFzSLVGjFyN7fFgaYeTDSoMOVspS6me7eFn7XG36aWPIUXlyJKmvHmulG0tbnXp3JknABWebLHizYuWozyk2hmn0K3WppZOO/y0b2iXKmWSdnnYJm+Lg0OhPgof6HjHS4zsROwe5un/Djbq5Rlx4ZHkWWUgDLXacetchiFBDSmn22HpIOZXcVvGth1I7MZU22nePUeXYSO11t1E9u32lIUYTHifShXgBt1pZg72XXYQPzSYdjPRgNFdomqUHoIoueciaO/LcNuFcS3HXlldp2XdekR9VB1WOHo2VFIHqTeWOcGxhF5aQlAW20oAfHWWQlgRBWBNQbz3ko3b/HadalKdN1SaFrP2npUnwadWXSl+65xdEGu3j0GuAOXYVcnUStV18d5kH44VDOeUcomtJNVZHcwUloIfZ+ZTXckXZhFpBKELJHYkmLcnKXU6LJfdXnkal9KVq9IGFqIOV6QbRPIWqJlOFgQGaHIKzsikmYLJiiWCovkFYX0UHHlvYSwXFVV1KPioKI0sKXqlpoSiFRRGqe6UlaaeputndUH8RNN6DERLILJDzZRlru0Vtlx+GkhIH6JYzmpcQS1+2Uxthw/YE5qilvefwZ7DZmR2rIuYaW0M+1uSuWd1dd9hiTV7XHV8RreUswtAtFZ6my8pqM4L5oGqjjSqymdeMs5JcXcfgUrlVRbCZKpvBpS40J5oPBQQAOw==
endtext
=Strtofile(Strconv(m.myvar1,14),m.lcdest1)
Endi

.picture=m.lcdest
.BackStyle=1
.BorderWidth=2
.BorderColor=255
.refresh
Endwith

Endproc

Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
  dodefault()
	.Left=.Left-2
	.Top =.Top-2
	.BackStyle=0
	.edit1.FontBold=.T.
	.label1.ForeColor=Rgb(255,255,255)
	.edit1.DisabledForeColor=Rgb(255,255,255)
	.BackStyle=1
   .picture=""
	.BackColor=Rgb(0,0,0)
	.Refresh
Endwith
Endproc

Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
	DoDefault()
	.Left=.Left+2
	.Top =.Top+2
	.edit1.FontBold=.F.
	.label1.ForeColor=255
	.edit1.DisabledForeColor=0
	.edit1.forecolor=0

   rand(-1)
   local m.xx
   m.xx= INT(2 * RAND( ) + 1)
	.picture=iif(m.xx=1,Addbs(Sys(2023))+"ytemp1.gif",Addbs(Sys(2023))+"ytemp.gif")
	.BackStyle=1
	.Refresh
Endwith
Endproc

Procedure edit1.Init
	This.forecolor=0
	This.DisabledForeColor=0
	 This.enabled=.f.
Endproc

Procedure label2.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
	.Left=.Left+2
	.Top=.Top+2
Endwith
Endproc

Procedure label2.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
	.Left=.Left-2
	.Top=.Top-2
Endwith
Endproc

Procedure label2.Click
Local N
N=Int(Val(Substr(This.Parent.Name,5)))

Sele ycurs
Go N
Local m.xlink
m.xlink=Strextract(Fitems,"<link>","</link>",1)
m.xlink=Strtran(m.xlink,"<![CDATA[","")
m.xlink=Strtran(m.xlink,"]]>","")

Local o
o=Newobject("hyperlink")
o.NavigateTo(m.xlink)
o=Null
Endproc

Procedure label1.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
	.Top=.Top-2
	.Left=.Left-2
Endwith
Endproc

Procedure label1.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
	.Top=.Top+2
	.Left=.Left+2
Endwith
Endproc

Enddefine
*
*-- EndDefine: ycnt


windows fontCharSet reference  table.

windows fontCharSet reference table.

Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!
Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!
Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!
Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!
Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!

Remark vfp controls fill with unicode languages as Arabic ,chinese,japanese,russian,turkish....!


                     

Yousfi Benameur


Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1703 ( creator update).