HASH field seem to make any difference between "Wo" and "WO"

[rogercabo]

Hi everyone,

I require a HASH table to create my text editor to display automatically lines breaks and having fast display of lines.

But I need these different HASH elements for Kerning purposes. But it seems GB32 does not make any difference between:

Dim _F_Kern As Hash Int
Hash Add _F_Kern["Wo"], -2
Hash Add _F_Kern["WO"], 0

Is this a Bug or does GB32 does not make any difference between hash "Wo" and "WO"?

Thank you

[webu]

Dim _F_Kern As Hash Int

Hash Add _F_Kern["CaseINsensitiv"], -2

Print _F_Kern["CaseINsensitiv"]
Print _F_Kern["caseINsensitiv"]
Print _F_Kern["caseinsensitiv"]
Print _F_Kern["CASEINSENSITIV"]


Hashs are CaseINsensitiv

[rogercabo]

Here is an example of getting the Kerning of a font.

Type KERNINGPAIR
   wFirst As Card        ' Unicode-Wert des ersten Zeichens im Kerning-Paar
   wSecond As Card       ' Unicode-Wert des zweiten Zeichens im Kerning-Paar
   iKernAmount As Int    ' Menge der Anpassung des Abstands zwischen den beiden Zeichen
 End Type
 
 Dim hDC As Long
 Dim hFont As Long
 Dim hOldFont As Long
 Dim numKerningPairs As Long
 Dim kerningPairs() As KERNINGPAIR
 Dim i As Long
 
 Hash Erase _F_Kern[]
 Dim h1h2$, countFails%

 Dim FName$ = "Segoe UI"
 
 hDC = GetDC(0)
 hFont = CreateFont(0, 0, 0, 0, FW_DONTCARE, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, FName$)
 hOldFont = SelectObject(hDC, hFont)
 
 numKerningPairs = GetKerningPairs(hDC, 0, 0)
 If numKerningPairs > 0

   ReDim kerningPairs(numKerningPairs - 1) As KERNINGPAIR
   ~GetKerningPairs(hDC, numKerningPairs, V:kerningPairs(0))

   For i = 0 To numKerningPairs - 1
     If kerningPairs(i).iKernAmount
       h1h2$ = Chr$(kerningPairs(i).wFirst) & Chr$(kerningPairs(i).wSecond)
     
       Try
         Hash Add _F_Kern[h1h2$], kerningPairs(i).iKernAmount
       Catch
         '      h1h2$ = Chr$(kerningPairs(i).wFirst) & Chr$(kerningPairs(i).wSecond) & Chr$(kerningPairs(i).wSecond)
         '      Hash Add _F_Kern[h1h2$], kerningPairs(i).iKernAmount
         countFails%++
         Debug.Print "Kerning pair: "; Chr$(kerningPairs(i).wFirst); " "; Chr$(kerningPairs(i).wSecond); " adjustment: "; kerningPairs(i).iKernAmount
       EndCatch
     EndIf
   Next i
 End If
 
 ~SelectObject(hDC, hOldFont)
 ~DeleteObject(hFont)
 ~ReleaseDC(0, hDC)
 
 MsgBox countFails%
 
 Debug.Show
 Stop
 
There about ~5000 combinations of signs possible. The only way is to use a HASH table.
I only store the the combination having iKernAmount != 0 but anyway these are ~2000

But unfortunately for any reason sometimes eg: Pairs exist 4 times with the same value in the KERNINGPAIR .. this is strange.

Kerning pair: "Y" "u" adjustment: -1
Kerning pair: "Y" "u" adjustment: -1
Kerning pair: "Y" "u" adjustment: -1
Kerning pair: "Y" "u" adjustment: -1

And "Wo" is the same as "WO" and cause a bug.

any idea?

[webu]

Take another Array-Type


Dim _F_Kern(65536) As Int

_F_Kern(Cv2("Wo")) = -1
_F_Kern(Cv2("wo")) = -2
_F_Kern(Cv2("wO")) = -3
_F_Kern(Cv2("WO")) = -4

Print _F_Kern(Cv2("Wo")), _F_Kern(Cv2("wo")), _F_Kern(Cv2("wO")), _F_Kern(Cv2("WO"))

[rogercabo]

Thanks a lot! That's a great and fast idea! Works nice and reduce the pairs to about 800 for "Segoe UI" font.
Here is the working solution. I'm very excited to test tomorrow.


Type KERNINGPAIR
   wFirst As Card       ' Unicode-Wert des ersten Zeichens im Kerning-Paar
   wSecond As Card     ' Unicode-Wert des zweiten Zeichens im Kerning-Paar
   iKernAmount As Int     ' Menge der Anpassung des Abstands zwischen den beiden Zeichen
 End Type
 
 Dim hDC As Long
 Dim hFont As Long
 Dim hOldFont As Long
 Dim numKerningPairs As Long
 Dim i As Long
 Dim kerningPairs() As KERNINGPAIR
 
 Hash Erase _F_Kern[]
 Dim h1h2$, countFails%
 
 hDC = GetDC(0)
 hFont = CreateFont(0, 0, 0, 0, FW_DONTCARE, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, Z(_F.Nam))
 hOldFont = SelectObject(hDC, hFont)
 
 numKerningPairs = GetKerningPairs(hDC, 0, 0)
 If numKerningPairs > 0

   ReDim kerningPairs(numKerningPairs - 1) As KERNINGPAIR
   ~GetKerningPairs(hDC, numKerningPairs, V:kerningPairs(0))

   For i = 0 To numKerningPairs - 1
     If kerningPairs(i).iKernAmount
       If !_F_Kern[? Cv2(Chr$(kerningPairs(i).wFirst) & Chr$(kerningPairs(i).wSecond))]
         Hash Add _F_Kern[Cv2(Chr$(kerningPairs(i).wFirst) & Chr$(kerningPairs(i).wSecond))], kerningPairs(i).iKernAmount
       EndIf
       ' Debug.Print "Kerning pair: "; Chr$(kerningPairs(i).wFirst); " " ;kerningPairs(i).wFirst ;" "; Chr$(kerningPairs(i).wSecond);" ";kerningPairs(i).wSecond;  " adjustment: "; kerningPairs(i).iKernAmount
       ' Stop
     EndIf
   Next i
 End If

[dragonjim]

Apr 27, 2023 20:52:22 GMT 1 webu said:

Take another Array-Type


Dim _F_Kern(65536) As Int

_F_Kern(Cv2("Wo")) = -1
_F_Kern(Cv2("wo")) = -2
_F_Kern(Cv2("wO")) = -3
_F_Kern(Cv2("WO")) = -4

Print _F_Kern(Cv2("Wo")), _F_Kern(Cv2("wo")), _F_Kern(Cv2("wO")), _F_Kern(Cv2("WO"))

Hi. Great solution. Can I use this in the help file?

[webu]

Hi. Great solution. Can I use this in the help file?

Maybe, but this is a trivial solution. And take better var-name as _F_Kern.

[(X)]

To get a unique string from:"wo", "Wo" etc...

Function StrToHex(s As String) As String
 Dim h As String, i
 h = ""
 For i = 1 To Len(s)
   h = h & Hex(Asc(Mid(s, i, 1)))
 Next i
 StrToHex = h
End Function

// Debug...
StrToHex('wo')="776F"
StrToHex('Wo')="576F"



The hash will gladly accept a hex string

[rogercabo]

It seems the kerning doesn't fit with the Text or TextOut font system.

The result of measuring with TextWidth(SingleChar$) and using the Kerning is completely out of order and fails totally.
There must be any other way to determine the TextWidth of a single char and use the correct kerning.

The first line is generated by me in Segoe UI, 12 and line below is line from a text box with the same font and size.
The Text box kerning and stand of the font is a lot better.




Why all this stuff..
I tried to optimize by draw a complete text line with ~TextOut(Me.hDC2, xpos, ypos + 12, V:c, len(line$)), instead of drawing one by one char.
But I do not get the correct kerning and font char sizes, so it's not possible to place the cursor correctly.

Not sure how the gb32 editor does it with the proportional fonts. I can get it to work with drawing single characters.. but that's not fast and looks ugly.