Hi. I got a very weird problem I

[mp3nick]

Hi.
I got a very weird problem
I want to have conversion between unicode to symbol character for persian (farsi) language, what I do is finding the value code for each character in unicode and assign my pre-maded Symbol (ttf) font for them , I already find another persian software which does have the ttf font and I check each alphabet code with in font editor,

so what I did was for instance assign a (yaa) last persian alphabet to number 192 but when I try to use CHR (192) Its Bugging me means its showing me the different figure from UNICODE fonts, and what I did is to show all 255 characters for my symbol ttf font and it wasn't even inside , and then I try with CHRW () for all 653500 characters and most of the character have LOST in 653500 characters, how can I set it BACK ?

PS 1: the software using the dll file called "RICHED32.DLL" and when I removed it the software also had crashed like those confusing figures means that I believe there's something that I have to use from RICHED32.DLL file

PS 2: in Visual basic 6. I maded a new form and try CHR from 1 to 255 and it was Correct, means EXCEL is using different character set, and also the same problem with COMBO LISTBox in visual basic.

PLEASE HELP, any suggestion will appreciated

 

[srusti]

Hi mp3nick
Try using APIs getKeyasyncState and read the key pressed , then try to convert them. it is more relaiable then the above method

srusti
Try it for me...

 

[kieutv]

mp3nick,
Why don't u create function convert charcode. For example, map character one by one.
I haven't got source code here, if I find it I will send to U. Please give me your email. But you should try first.
Good luck.
KieuTV

 

[johnwm]

kieutv,

Since this is a public forum rather than a private contact system, why don't you post the code here so others can also learn from your experience and skills
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'People who live in windowed environments shouldn't cast pointers.'

 

[kieutv]

johnwm,
I'm Vietnamese, so I only have function convert VNI_Font to ABC_Font (these two font are common font in my country). I show my function here, so you can follow my method if you want.

-----------------------------------
Code
Const VNI_FONT = "aù aø aû aõ aï aê aé aè aú aü aë aâ aá aà aå aã aä eù eø eû eõ eï eâ eá eà eå eã eä í ì æ ó ò où oø oû oõ oï oâ oá oà oå oã oä ô ôù ôø ôû ôõ ôï uù uø uû uõ uï ö öù öø öû öõ öï yù yø yû yõ î ñ AÙ AØ AÛ AÕ AÏ AÊ AÉ AÈ AÚ AÜ AË AÂ AÁ AÀ AÅ AÃ AÄ EÙ EØ EÛ EÕ EÏ EÂ EÁ EÀ EÅ EÃ EÄ Í Ì Æ Ó Ò OÙ OØ OÛ OÕ OÏ OÂ OÁ OÀ OÅ OÃ OÄ Ô ÔÙ ÔØ ÔÛ ÔÕ ÔÏ UÙ UØ UÛ UÕ UÏ Ö ÖÙ ÖØ ÖÛ ÖÕ ÖÏ YÙ YØ YÛ YÕ Î Ñ "
Const ABC_FONT = "¸ µ ¶ · ¹ ¨ ¾ » ¼ ½ Æ © Ê Ç È É Ë Ð Ì Î Ï Ñ ª Õ Ò Ó Ô Ö Ý × Ø Ü Þ ã ß á â ä « è å æ ç é ¬ í ê ë ì î ó ï ñ ò ô ­ ø õ ö ÷ ù ý ú û ü þ ® ¸ µ ¶ · ¹ ¡ ¾ » ¼ ½ Æ ¢ Ê Ç È É Ë Ð Ì Î Ï Ñ £ Õ Ò Ó Ô Ö Ý × Ø Ü Þ ã ß á â ä ¤ è å æ ç é ¥ í ê ë ì î ó ï ñ ò ô ¦ ø õ ö ÷ ù ý ú û ü þ § "

'Function Convert ABC font to VNI font
Public Function ABC2VNI(strABC As String) As String
Dim strVNI As String
Dim lngPos As Long
Dim s As String * 1
Dim i As Long
strVNI = ""
For i = 1 To Len(strABC)
s = Mid(strABC, i, 1)
If Asc(s) > 128 Then
lngPos = InStr(1, ABC_FONT, s)
If lngPos = 0 Then
strVNI = strVNI + s
Else
strVNI = strVNI + Trim(Mid(VNI_FONT, (lngPos - 1) / 2 * 3 + 1, 2))
End If
Else
strVNI = strVNI + s
End If
Next i
ABC2VNI = strVNI
End Function
'End of code
--------------------------------------------

Good luck and have fun
KieuTV

 

[mp3nick]

HI
thanks for your reply.
first mapping character is good point but the problem is I want to have my own standard on my script or software which can run on any pc with any character setting so I can't mapping characters on any installation pc , I didn't post my code cause I thought it might be confusing for here cause I don't think anyone know persian and rules in writing, its almost same with arabic, anyway here is my code, what I want to know and I want to do is that how to make my Character code back ? i mean how to set 192 for Yaa , and etc , like the standard font


Public Function ConvertFunc(ByVal AllianceString As String, ByVal BeginMiddleEndAlone, ByVal ChrGroup As String, ByVal ChBefore) As Integer

Dim ChBeforeGr, ChAfterGr As String
Dim NewChr, AscwAll As Integer


AscwAll = AscW(AllianceString)

' Finding group for Character before
If BeginMiddleEndAlone <> &quot;First&quot; Then ChBeforeGr = GroupCharacter(ChBefore)

If ChrGroup = &quot;A&quot; Then
Select Case BeginMiddleEndAlone
Case &quot;First&quot;
Alignment = 0
Case &quot;Middle&quot;
If ChBeforeGr = &quot;A&quot; Then Alignment = 0 Else Alignment = 1
Case &quot;End&quot;
If ChBeforeGr = &quot;A&quot; Then Alignment = 0 Else Alignment = 1
Case &quot;Alone&quot;
Alignment = 0
End Select



End If

If ChrGroup = &quot;B&quot; Then

Select Case BeginMiddleEndAlone
Case &quot;Begin&quot;
Alignment = 3
Case &quot;Middle&quot;
If ChBeforeGr = &quot;A&quot; Then alginment = 0 Else Alignment = 2
Case &quot;End&quot;
If ChBeforeGr = &quot;A&quot; Then alginment = 0 Else Alignment = 1
Case &quot;Alone&quot;
Alignment = 0
End Select
End If



Select Case AscwAll
Case 1570
NewChr = 65 ' Aa bakola
NewChr = NewChr + Alignment
Case 1571
NewChr = 67 ' Alef
NewChr = NewChr + Alignment
Case 1575
NewChr = 72 ' Be
NewChr = NewChr + Alignment
Case 1576
NewChr = 74 ' Pe
NewChr = NewChr + Alignment
Case 1662
NewChr = 78 ' Te
NewChr = NewChr + Alignment
Case 1578
NewChr = 82 ' Se
NewChr = NewChr + Alignment
Case 1579
NewChr = 86 ' Jim
NewChr = NewChr + Alignment
Case 1580
NewChr = 90 ' Che
NewChr = NewChr + Alignment
Case 1670
NewChr = 94 ' Khe
NewChr = NewChr + Alignment
Case 1581
NewChr = 98 ' Daal
NewChr = NewChr + Alignment
Case 1582
NewChr = 102 ' Zaal
NewChr = NewChr + Alignment
Case 1583
NewChr = 106 ' Re
NewChr = NewChr + Alignment
Case 1584
NewChr = 108 ' Ze
NewChr = NewChr + Alignment
Case 1585
NewChr = 110 ' Zhe
NewChr = NewChr + Alignment
Case 1586
NewChr = 112 ' Sin
NewChr = NewChr + Alignment
Case 1688
NewChr = 114 ' Shin
Case 1587
NewChr = 116 ' Sad
NewChr = NewChr + Alignment
Case 1588
NewChr = 120 ' Zad
NewChr = NewChr + Alignment
Case 1589
NewChr = 124 ' Taa
NewChr = NewChr + Alignment
Case 1590
NewChr = 131 ' Zaa
NewChr = NewChr + Alignment
Case 1591
NewChr = 135 ' Ein
NewChr = NewChr + Alignment
Case 1592
NewChr = 139 ' Ghein
NewChr = NewChr + Alignment
Case 1593
NewChr = 147 ' Faa
NewChr = NewChr + Alignment
Case 1594
NewChr = 151 ' Ghaaf
NewChr = NewChr + Alignment
Case 1601
NewChr = 155 ' Kaf
NewChr = NewChr + Alignment
Case 1602
NewChr = 161 ' Gaf
NewChr = NewChr + Alignment
Case 1603
NewChr = 165 ' Laam
NewChr = NewChr + Alignment
Case 1711
NewChr = 169 ' Mim
NewChr = NewChr + Alignment
Case 1604
NewChr = 173 ' Vaav
NewChr = NewChr + Alignment
Case 1605
NewChr = 179 ' Mim
NewChr = NewChr + Alignment
Case 1606
NewChr = 183 ' Noon
NewChr = NewChr + Alignment
Case 1607
NewChr = 187
NewChr = NewChr + Alignment
Case 1608
NewChr = 189
NewChr = NewChr + Alignment
Case 1609 'Yaa
NewChr = 193
NewChr = NewChr + Alignment
Case 1740 'Yaa
NewChr = 193

Case Else
NewChr = 0
End Select
If NewChr <> 0 Then ConvertFunc = NewChr Else ConvertFunc = 1

End Function

Public Function CharacterPos(ByVal ChBefore, ByVal ChAfter) As String

If ChBefore = &quot; &quot; And ChAfter <> &quot;&quot; Then CharacterPos = &quot;First&quot;
If ChBefore <> &quot;&quot; And ChAfter <> &quot;&quot; Then CharacterPos = &quot;Middle&quot;
If ChBefore <> &quot;&quot; And ChAfter = &quot; &quot; Then CharacterPos = &quot;End&quot;

End Function

Public Function GroupCharacter(ByVal AorB As String) As String

AscWW = AscW(AorB)
Select Case AscWW
Case 1570, 1571, 1572, 1573, 1575, 1583, 1584, 1585, 1586, 1591, 1592, 1608
GroupCharacter = &quot;A&quot;
Case Else
GroupCharacter = &quot;B&quot;
End Select
End Function

Sub ConvertUnicode()
Dim sValue, FinalResult, CharachterPosition, CharacterValue, CharacterGroup, ChBefore, ChAfter As String
Dim ChPosition As String
Dim I, E As Integer
Dim NewCharacter(1 To 99999) As Integer

sValue = Selection.Value

'find selection value height
E = Len(sValue)


For I = 1 To E

CharacterValue = Mid(sValue, I, 1)
CharacterGroup = GroupCharacter(CharacterValue)

'Find position in word

If I = 1 Then ChPosition = &quot;First&quot;
If I = E Then ChPosition = &quot;End&quot;
If I <> 1 And I <> E Then ChPosition = CharacterPos(Mid(sValue, I - 1, 1), Mid(sValue, I + 1, 1))


If ChPosition <> &quot;First&quot; Then ChBefore = Mid(sValue, I - 1, 1) Else ChBefore = &quot; &quot;

NewCharacter(I) = ConvertFunc(CharacterValue, ChPosition, CharacterGroup, ChBefore)



Select Case NewCharacter(I)
Case Is < 127
FinalResult = ChrW(NewCharacter(I)) & FinalResult
Case Is > 159
FinalResult = ChrW(NewCharacter(I)) & FinalResult
Case Is > 126 And NewCharacter(I) < 160
FinalResult = Chr(NewCharacter(I)) & FinalResult
Case Else
FinalResult = &quot;+&quot; & FinalResult
End Select

Next
'Photoshop.Application.Open (&quot;E:\Dove, The\Frames\001~100\001.psd&quot
'Photoshop.Application.ActiveDocument.Layers(&quot;Text&quot.ArtLayer.TextItem.Contents = FinalResult
Range(&quot;b1&quot.Value = FinalResult

End Sub

Sub chsymbol()
For I = 1 To 1000
Range(&quot;M&quot; & I).Value = I
Range(&quot;N&quot; & I).Value = ChrW(I)
Next
End Sub

Sub chrchr()
Selection.Value = Selection.Value & Asc()
End Sub

Sub chrchrr()
Selection.Value = Chr(154)
'Selection.Value = Application.LanguageSettings
End Sub