Unicode texts and vfp -continuation-
To store data blocks of any kind, such as null values, assembler code, printer drivers, and alphanumeric text of indeterminate length, or a reference to a data block in a field, use the Memo field type. To prevent data in Memo fields from being translated across code pages, use the Memo (Binary) field type.
(In normal memo field Use ''SET NOCPTRANS' to specify that the memo field not be translated.that is not recquired in memo binary fieds).
Assuming have created a table named asup.dbf with this structure:
lib c(25)
com c(25)
data memo(binary) 4
then can insert in each record the txt utf-8 contents by this code:
insert into asup.dbf values ("my title here","", filetostr(getfile('txt')))
or fill the binary memo with this code:
APPEND MEMO data FROM getfile('txt') &&from utf-8 txt file
(Warning:dont copy and paste txt utf-8 contents in memo binary field edited. that causes fill it with "???" chars).
for viewing
-i use in code *1* a browser with mandatory this magic meta tag:
<meta charset="UTF-8">
a cursor (ycurs) is created from this table asup.dbf and populating the grid.
Then each record of the cursor (unicode text ) is viewed as it on the right browser.The advantage of the browser method is that can style text with CSS (set a basic one in code *1*).
-in code *2* i use a vfp editbox control with setting its fontCharset property and direction (RTL).
the magic VFP function strconv() do the rest.
this code is better fast than the code *1*
of course can work with any unicode text (i choose arabic here).
I dont give links to unicode in previous posts (numberous).simply type in right search box "Unicode" and you have collection of all results posted."
before begin copy this text and paste in notepad and save as 1.txt with "UTF-8" option.
use asup.dbf and append memo data from 1.txt and so...until record9 (with another unicode texts ..)
تتوقع مصالح الأرصاد الجوية أن يسود اضطراب جو
ي قوي أغلب المناطق الشمالية، بداية من يوم السبت المقبل، بحيث ستكسو ال
ثلوج القمم الجبلية التي يصل ارتفاعها نحو 800 متر، فيما ستشهد أغلب المناطق ا
لشمالية تساقطا غزيرا للأمطار، وستنخفض درجات الحرارة للتراوح بين 2 و6 درجة
مئوية. يأتي هذا التغير في الوضع الجوي بعد عدة أسابيع من شح ا
لسماء وتخوف الفلاحين من استمرار موجة الجفاف التي تجتاح كل مناطق الو
طن، بحيث بدأت بعض محاصيلهم الزراعية تتعرض للتلف خاصة المحاصيل والحبوب الموسمية.
Click on code to select [then copy] -click outside to deselect
*1* browser method
Publi yform
yform=Newobject("yunicode")
yform.Show
Read Events
Retu
*
Define Class yunicode As Form
Height = 550
Width = 853
ShowWindow = 2
AutoCenter = .T.
Caption = "Converting and viewing UTF-8 unicode text in browser"
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 257, ;
GridLineWidth = 1, ;
Height = 369, ;
Left = 2, ;
Top = 3, ;
Width = 277, ;
Name = "Grid1"
Add Object olecontrol1 As OleControl With ;
Oleclass="shell.explorer.2", ;
Top = 1, ;
Left = 327, ;
Height = 539, ;
Width = 523, ;
Anchor = 15, ;
Name = "Olecontrol1"
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
Sele ycurs
Local m.lcdest,m.myvar As String
m.lcdest=Addbs(Sys(2023))+"ytemp.hml"
TEXT to m.myvar textmerge noshow
<meta charset="UTF-8">
<style>
.yb{
color:maroon;
background-color:bisque;
font-family:tahoma;
font-size:14px;
font-bold:bold;
dir:rtl;
padding:15px;
line-height:200%
}
</style>
<body oncontextmenu="return false;">
<div class="yb">
<<data>>
</div>
</body>
ENDTEXT
Strtofile(m.myvar,m.lcdest)
Thisform.olecontrol1.Navigate(m.lcdest)
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
Local m.myvar
TEXT to m.myvar noshow
Assuming yo have created a table named asup.dbf with this structure:
lib c(25)
com c(25)
data memo(binary) 4
then can insert in each record the txt utf-8 contents by this code:
insert into asup.dbf values ("my title here","", filetostr(getfile('txt')))
or fill yhe binary memo with this code:
APPEND MEMO data FROM 8.txt &&from utf-8 txt file
(Warning:dont copy and paste txt utf-8 contents in memo binary field edited. that cause you fill it with "?" chars).
for viewing i use a browser with mandatory this magic meta tag:
<meta charset="UTF-8">
a cursor (ycurs) is created from this table asup.dbf and populating the grid.
Then each record of the cursor (unicode text ) is viewed as it on the right browser.
ENDTEXT
Messagebox(m.myvar,0+32+4096,"summary help")
Endproc
Procedure Destroy
Use In Select("ycurs")
Close Data All
Clea Events
Endproc
Procedure Load
Set Safe Off
Close Data All
Sele * From Locfile("asup.dbf") Into Cursor ycurs Readwrite
Sele ycurs
SET NOCPTRANS TO data
*brow
Endproc
Procedure Init
With Thisform.grid1
.Width=40
.RecordSource="ycurs"
.RecordSourceType=1
.Themes=.F.
.GridLines=0
.HeaderHeight=33
.RowHeight=24
.DeleteMark=.F.
.RecordMark=.F.
.FontBold=.T.
For i=1 To .ColumnCount
.Columns(i).header1.BackColor=Rgb(255,255,193)
Endfor
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0,RGB(215,206,199),RGB(245,225,252))", "Column")
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
Locate
Rand(-1)
With .column2
.AddObject("command1","commandbutton")
.CurrentControl="command1"
.Sparse=.F.
With .command1
.Caption="..."
.MousePointer=15
.Visible=.T.
Endwith
Endwith
.column3.Visible=.F.
.ScrollBars=0
.column2.header1.Caption=""
.column2.header1.Picture=Home(1)+"graphics\icons\misc\misc15.ico"
.column2.header1.Alignment=2
.column2.header1.ForeColor=Rgb(0,255,0)
.column2.header1.Caption="?"
.column2.header1.MousePointer=15
.Refresh
Endwith
Bindevent(Thisform.grid1.column2.command1,"mousedown",Thisform,"my")
Bindevent(Thisform.grid1.column2.header1 ,"mousedown",Thisform,"my1")
Endproc
Procedure olecontrol1.Init
This.silent=.T.
Endproc
Enddefine
*
*-- EndDefine: yunicode
Click on code to select [then copy] -click outside to deselect
*2*using a vfp editbox control
Publi yform
yform=Newobject("yUnicode_vfp")
yform.Show
Read Events
Retu
*
Define Class yUnicode_vfp As Form
Height = 550
Width = 853
ShowWindow = 2
AutoCenter = .T.
Caption = "Converting and viewing UTF-8 unicode text in vfp editbox"
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 257, ;
GridLineWidth = 1, ;
Height = 369, ;
Left = 3, ;
Top = 3, ;
Width = 277, ;
Name = "Grid1"
Add Object edit1 As EditBox With ;
FontBold = .T., ;
FontSize = 14, ;
FontCharSet = 178, ;
Anchor = 15, ;
Alignment = 1, ;
BackStyle = 1, ;
Height = 529, ;
Left = 312, ;
Margin = 15, ;
ReadOnly = .F., ;
SpecialEffect = 0, ;
Top = 12, ;
Width = 529, ;
ForeColor = Rgb(255,128,64), ;
RightToLeft = .T., ;
Name = "Edit1"
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
Sele ycurs
Thisform.edit1.Value=Strconv(Data,11,178,2)
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
Local m.myvar
TEXT to m.myvar noshow
Assuming yo have created a table named asup.dbf with this structure:
lib c(25)
com c(25)
data memo(binary) 4
then can insert in each record the txt utf-8 contents by this code:
insert into asup.dbf values ("my title here","", filetostr(getfile('txt')))
or fill yhe binary memo with this code:
APPEND MEMO data FROM 8.txt &&from utf-8 txt file
(Warning:dont copy and paste txt utf-8 contents in memo binary field edited. that cause you fill it with "?" chars).
for viewing i use an editbox with vfp strconv() function with :
11 : Converts UTF-8 characters in cExpression to double-byte characters
178: charset arabic
2 : Specifies that nRegionalIdentifier is a FontCharSet value.
a cursor (ycurs) is created from this table asup.dbf and populating the grid.
Then each record of the cursor (unicode text ) is viewed as it on the right editbox.
The editbox is readOnly=.f.(default).use the rightclick to fire context menu.
ENDTEXT
Messagebox(m.myvar,0+32+4096,"summary help")
Endproc
Procedure edit1.RightClick
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
KEY CTRL+r, "Ctrl+R" ;
PICTRES _Med_redo ;
MESSAGE "Rétablit la dernière opération annulée"
Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
KEY CTRL+Z, "Ctrl+Z" ;
PICTRES _Med_undo ;
MESSAGE "Annule la dernière modification"
Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
PICTRES _Med_slcta ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
KEY CTRL+V, "Ctrl+V" ;
PICTRES _Med_paste ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
KEY CTRL+x, "Ctrl+X" ;
PICTRES _Med_cut ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
KEY CTRL+C, "Ctrl+C" ;
PICTRES _Med_copy ;
MESSAGE "Copie la sélection et la place dans le Presse-papiers"
Activate Popup raccourci
Endproc
Procedure Destroy
Use In Select("ycurs")
Close Data All
Clea Events
Endproc
Procedure Load
Set Safe Off
Close Data All
Sele * From Locfile("asup.dbf") Into Cursor ycurs Readwrite
Sele ycurs
*brow
Endproc
Procedure Init
With Thisform.edit1
.FontCharSet=178 &&must be re set in init !!
Endwith
With Thisform.grid1
.Width=40
.RecordSource="ycurs"
.RecordSourceType=1
.Themes=.F.
.GridLines=0
.HeaderHeight=33
.RowHeight=24
.DeleteMark=.F.
.RecordMark=.F.
.FontBold=.T.
For i=1 To .ColumnCount
.Columns(i).header1.BackColor=Rgb(255,255,193) &&Rgb(255*Rand(),255*Rand(),255*Rand())
Endfor
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0,RGB(215,206,199),RGB(245,225,252))", "Column")
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
Locate
Rand(-1)
With .column2
.AddObject("command1","commandbutton")
.CurrentControl="command1"
.Sparse=.F.
With .command1
.Caption="..."
.MousePointer=15
.Visible=.T.
Endwith
Endwith
.column3.Visible=.F.
.ScrollBars=0
.column2.header1.Caption=""
.column2.header1.Picture=Home(1)+"graphics\icons\misc\misc15.ico"
.column2.header1.Alignment=2
.column2.header1.ForeColor=Rgb(0,255,0)
.column2.header1.Caption="?"
.column2.header1.MousePointer=15
.Refresh
Endwith
Bindevent(Thisform.grid1.column2.command1,"mousedown",Thisform,"my")
Bindevent(Thisform.grid1.column2.header1 ,"mousedown",Thisform,"my1")
Endproc
Enddefine
*
*-- EndDefine: yUnicode_vfp
Note for code *2*:can modify the editbox contents but that dont affect the original data fbinay memo field .
Click on code to select [then copy] -click outside to deselect
*3* created on monday 19 of december 2017
*unicode to html entity converter
*convert any unicode text to html entities.each char is encoded to a string as "&#"+number representing the char and can be read in html page.
*The charCodeAt () javascript method returns an integer between 0 and 65535 that corresponds to the UTF-16 code of a character in the string at a given position
*entities are usefull for vfp (non unicode) and can be embed in strings,memo to view directly into html
*this is usefull of course for unicode texts in any language ( i tested a big arabic text and it works perfectly and fast).
*copy text from anywhere and paste into the first area.click translate and your string entities is in second area.
*can test the inverse with the viewer at the form right.
*the button clear reset the 2 areas .
*adapted form *http://woron.de/unicode-to-entities/
publi oform
oform=newObject("yconverter")
oform.show
read events
retu
*
DEFINE CLASS yconverter AS form
BorderStyle = 0
Height = 664
Width = 1300
ShowWindow = 2
AutoCenter = .T.
Caption = "Unicode to HTML numeric entity"
BackColor = RGB(212,210,208)
Name = "Form1"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
oleclass="shell.explorer.2", ;
Top = 0, ;
Left = 0, ;
Height = 612, ;
Width = 600, ;
Anchor = 15, ;
Name = "Olecontrol1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 621, ;
Left = 170, ;
Height = 37, ;
Width = 216, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Read entities on right web page", ;
MousePointer = 15, ;
BackColor = RGB(128,255,0), ;
Name = "Command1"
ADD OBJECT olecontrol2 AS olecontrol WITH ;
oleclass="shell.explorer.2", ;
Top = 24, ;
Left = 712, ;
Height = 589, ;
Width = 579, ;
Anchor = 225, ;
Name = "Olecontrol2"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 626, ;
Left = 908, ;
Height = 25, ;
Width = 109, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Text Direction", ;
MousePointer = 15, ;
BackColor = RGB(255,128,0), ;
Name = "Command2"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 625, ;
Left = 1042, ;
Height = 25, ;
Width = 116, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Style normal/Bold", ;
MousePointer = 15, ;
BackColor = RGB(255,128,0), ;
Name = "Command3"
PROCEDURE Init
this.caption=" unicode characters to HTML entities converter"
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE olecontrol1.Init
this.silent=.t.
*http://woron.de/unicode-to-entities/
local m.myvar
text to m.myvar noshow
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=UTF-8">
<title>Unicode to HTML entity converter</title>
<meta name="Description" content="Converts unicode characters to HTML entities">
<META name="Author" CONTENT="Eugen Woronenko">
<style>
body { background-color:#FFFFFF; color:#000000; }
input.controlButton
{
text-align : center;
font-family : "Arial", sans-serif;
font-size : 10pt;
font-weight : bold;
}
.m
{
font-family : "Courier New", monospace;
font-size : 10pt;
}
</style>
<script type="text/javascript">
function toEntities(fromElement, toElement) {
var aa = fromElement.value;
var bb = '';
for(i=0; i<aa.length; i++)
{
if(aa.charCodeAt(i)>127)
{
bb += '&#' + aa.charCodeAt(i) + ';';
}
else
{
bb += aa.charAt(i);
}
}
toElement.value = bb;
}
</script>
<!--
<form method="post" action="" name="form">
<p>Paste text here:</p>
<textarea name="utf" rows="5"></textarea>
<p>
<input type="button" name="convert" value="Convert" onclick="toEntity()" />
<input type="reset" name="clear" value="Clear" /> <br />
<textarea name="entity" rows="5" cols="50" readonly="readonly" id="output"></textarea>
</form>
-->
</head>
<body onLoad="document.f1.t1.focus();">
<table width="100%" height="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#FFFFFF">
<tr>
<td align="left" valign="middle" nowrap>
<form name="f1">
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td>
<textarea class="m" name="t1" wrap="virtual" cols="70" rows="15"></textarea>
</td>
</tr>
<tr>
<td align="left" nowrap>
<input class="controlButton" type="button" value=" Translate " onClick="toEntities(document.f1.t1, document.f1.t2); document.f1.t1.focus();">
<input class="controlButton" type="button" value=" Clear " onClick="document.f1.t1.value=''; document.f1.t2.value=''; document.f1.t1.focus();">
</td>
</tr>
<tr>
<td nowrap>
<textarea class="m" name="t2" wrap="virtual" cols="70" rows="20" readonly="readonly"></textarea>
</td>
</tr>
</table>
</form>
</td>
</tr>
</table>
</body>
</html>
endtext
with this
.navigate("about:blank")
inke(1)
with .document
.open()
.write(m.myvar)
.close()
endwith
endwith
ENDPROC
PROCEDURE command1.Click
local m.x
m.x=thisform.olecontrol1.document.f1.t2.value
m.x=strtran(m.x,chr(10),"</br>")
local m.myvar
text to m.myvar noshow
<div dir="RTL" id="yb">
<<m.x>>
</div>
endtext
thisform.olecontrol2.document.body.innerhtml=m.x
ENDPROC
PROCEDURE olecontrol2.Init
this.silent=.t.
this.navigate("about:blank")
ENDPROC
PROCEDURE command2.Click
try
with thisform.olecontrol2.document
.body.dir=iif(.body.dir="rtl","ltr","rtl")
endwith
catch
endtry
ENDPROC
PROCEDURE command3.Click
try
with thisform.olecontrol2.document.body
.style.fontWeight=iif(.style.fontWeight="bold","normal","bold")
endwith
catch
endtry
ENDPROC
ENDDEFINE
*
*-- EndDefine:yconverter
Click on code to select [then copy] -click outside to deselect
*4* created on monday 19 of february 2018
*use of FontCharSet in VFP permit to write unicode languages other western (default).
publi oform
oForm = Createobject('yForm')
oForm.Show
Read Events
Retu
*
Define Class yForm As Form
AutoCenter = .T.
Height = 300 +3*150-20
Width = 790
ShowWindow=2
AutoCenter=.T.
MaxButton=.F.
Caption="FontCharSet"
Add Object text1 As TextBox With ;
FontName = "Courier New", ;
FontSize = 14, ;
Left = 10, ;
Top = 10, ;
Height = 130, ;
Width = 740 ,;
readonly=.T.
Add Object lbl1 As Label With;
forecolor=155,;
left=740+15,;
top=10,;
wordwrap=.T.,;
autosize=.T. ,;
caption="T"+Chr(13)+"U"+Chr(13)+"R"+Chr(13)+"K"+Chr(13)+"I"+Chr(13)+"S"+Chr(13)+"H"+Chr(13)
Add Object text2 As TextBox With ;
FontName = "Courier New", ;
FontSize = 14, ;
Left = 10, ;
Top = 150, ;
Height = 130, ;
Width = 740 ,;
readonly=.T.
Add Object lbl2 As Label With;
forecolor=155,;
left=740+15,;
top=150,;
wordwrap=.T.,;
autosize=.T. ,;
caption="C"+Chr(13)+"Y"+Chr(13)+"R"+Chr(13)+"I"+Chr(13)+"L"+Chr(13)+"L"+Chr(13)+"I"+Chr(13)+"C"
Add Object text3 As TextBox With ;
FontName = "Tahoma", ;
FontSize = 14, ;
Left = 10, ;
Top = 150+140, ;
Height = 130, ;
Width = 740 ,;
readonly=.T.
Add Object lbl3 As Label With;
forecolor=155,;
left=740+15,;
top=150+140,;
wordwrap=.T.,;
autosize=.T. ,;
caption="A"+Chr(13)+"R"+Chr(13)+"A"+Chr(13)+"B"+Chr(13)+"I"+Chr(13)+"C"
Add Object text4 As TextBox With ;
FontName = "Tahoma", ;
FontSize = 14, ;
Left = 10, ;
Top = 150+140+140, ;
Height = 130, ;
Width = 740 ,;
readonly=.T.
Add Object lbl4 As Label With;
forecolor=155,;
left=740+15,;
top=150+2*140,;
wordwrap=.T.,;
autosize=.T. ,;
caption="J"+Chr(13)+"A"+Chr(13)+"P"+Chr(13)+"A"+Chr(13)+"N"+Chr(13)+"E"+Chr(13)+"S"+Chr(13)+"E"
Add Object text5 As TextBox With ;
FontName = "Arial", ;
FontSize = 14, ;
Left = 10, ;
Top = 150+3*140 , ;
Height = 130, ;
Width = 740 ,;
readonly=.T.
Add Object lbl5 As Label With;
forecolor=155,;
left=740+15,;
top=150+3*140,;
wordwrap=.T.,;
autosize=.T. ,;
caption="W"+Chr(13)+"E"+Chr(13)+"S"+Chr(13)+"T"+Chr(13)+"E"+Chr(13)+"R"+Chr(13)+"N"
Procedure text1.Init()
With This
For lni=33 To 64
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=65 To 126
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=127 To 255
.Value = .Value + Chr(lni)
If lni=191
.Value = .Value + Chr(13)
Endif
Endfor
.FontCharSet = 162
Endwith
Endproc
Procedure text2.Init()
With This
For lni=33 To 64
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=65 To 126
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=127 To 255
.Value = .Value + Chr(lni)
If lni=191
.Value = .Value + Chr(13)
Endif
Endfor
.FontCharSet = 204 &&cyrillic/russe
Endwith
Endproc
Procedure text3.Init()
With This
For lni=33 To 64
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=65 To 126
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=127 To 255
.Value = .Value + Chr(lni)
If lni=191
.Value = .Value + Chr(13)
Endif
Endfor
.FontCharSet = 178 &&arabic
Endwith
Procedure text4.Init()
With This
For lni=33 To 64
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=65 To 126
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=127 To 255
.Value = .Value + Chr(lni)
If lni=191
.Value = .Value + Chr(13)
Endif
Endfor
.FontCharSet = 128 &&Japanese
Endwith
Endproc
Procedure text5.Init()
With This
For lni=33 To 64
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=65 To 126
.Value = .Value + Chr(lni)
Endfor
.Value = .Value + Chr(13)
For lni=127 To 255
.Value = .Value + Chr(lni)
If lni=191
.Value = .Value + Chr(13)
Endif
Endfor
.FontCharSet = 0
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*EndDefine yform
Important:All Codes above are tested on VFP9SP2 & windows 10 pro & IE11 emulation