GetGlyphOutline

[E. Cox]

I am having trouble getting the Bezier coordinates from GetGlyphOutline.
GetGlyphOutline executes properly the first time I call it and returns
the number of bytes required for the buffer but when I execute
GetGlyphOutline the 2nd time it shuts down Visual Basic.

I have a TrueType font specifed for the hDC that I am using in the
GetGlyphOutline call. I am using GGO_NATIVE. I am setting the 2 matrix
Values to 1 as I've heard is necessary.

I am using VB6 on Windows XP.

I find it odd that this is not working since my whole reason for doing
this is because an old 3rd Party application is having trouble loading
Fonts on
Windows 2000 and XP. It works on Win95, 98, ME and NT4.0. Is there
something different about Fonts and/or GetGlyphOutline on Win2K and XP?

I would appreciate any help. Thanks.

[alpine]

On Wed, 27 Nov 2002 23:09:32 GMT, "E. Cox" <NoS...@MicroSun.com>
wrote:

You will probably get more answers if you post the relevant code and
API declares that you are using.

HTH,
Bryan
____________________________________________________________
New Vision Software "When the going gets weird,"
Bryan Stafford "the weird turn pro."
alp...@mvps.org Hunter S. Thompson -
Microsoft MVP-Visual Basic Fear and Loathing in LasVegas

[E. Cox]

OK, Here's my code (OK, actually I've pieced it together from code I've
found in the net). I've seen different declarations in different places
(Integers instead of Longs, etc.) and I've tried them all....

Thanks for the help...

'-----------------------------

Type POINTAPI
x As Long 'Integer
y As Long 'Integer
End Type

Type GLYPHMETRICS
gmBlackBoxX As Long 'Integer
gmBlackBoxY As Long 'Integer
gmptGlyphOrigin As POINTAPI
gmCellIncX As Integer
gmCellIncY As Integer
End Type

Type FIXED
fract As Integer
Value As Integer
End Type

Type MAT2
eM11 As FIXED
eM12 As FIXED
eM21 As FIXED
eM22 As FIXED
End Type

Type POINTFX
x As FIXED
y As FIXED
End Type

Type TTPOLYCURVE
wType As Integer
cpfx As Integer
apfx As POINTFX
End Type

Type TTPOLYGONHEADER
cb As Long
dwType As Long
pfxStart As POINTFX
End Type

Global Const GGO_METRICS = 0
Global Const GGO_BITMAP = 1
Global Const GGO_NATIVE = 2

Public Declare Function GetGlyphOutline _
Lib "gdi32" _
Alias "GetGlyphOutlineA" _
(ByVal hdc As Long, _
ByVal uChar As Long, _
ByVal fuFormat As Long, _
lpgm As GLYPHMETRICS, _
ByVal cbBuffer As Long, _
lpBuffer As Any, _
lpmat2 As MAT2) As Long

'-------------------------------

Sub GetGlyphs()
Dim lpgm As GLYPHMETRICS
Dim lpmat2 As MAT2
Dim Nr As Integer, lpBuffer$, cBuff&, i&, r&

Nr = Asc(frmMain.Text1.Text) ' ASCII code, like 'i'=105
frmMain.Label1.Caption = Chr(Nr)

lpgm.gmBlackBoxX = 64
lpgm.gmBlackBoxY = 64
lpgm.gmptGlyphOrigin.x = 10
lpgm.gmptGlyphOrigin.y = 10
lpgm.gmCellIncX = 70
lpgm.gmCellIncY = 70

lpmat2.eM11.Value = 1: lpmat2.eM11.fract = 0
lpmat2.eM12.Value = 0: lpmat2.eM12.fract = 0
lpmat2.eM21.Value = 0: lpmat2.eM21.fract = 0
lpmat2.eM22.Value = 1: lpmat2.eM22.fract = 0

' Get the required buffer size (This works)
r& = GetGlyphOutline(frmMain.Picture1.hdc, Nr, GGO_NATIVE, lpgm, _
0, vbNullString, lpmat2)
MyERROR = Err.LastDllError
If r& = -1 Then Beep: Exit Sub

' This works too.
With lpgm.gmptGlyphOrigin
MsgBox "width = " & .x & " height = " & .y
End With

' Set the buffer size
lpBuffer$ = String$(r&, 0)

'Then retrieve the information
'**** Here's where it fails ****
r& = GetGlyphOutline(frmMain.Picture1.hdc, Nr, GGO_NATIVE, lpgm, _
Len(lpBuffer$), lpBuffer$, lpmat2)
MyERROR = Err.LastDllError
If r& = -1 Then Beep: Exit Sub

lpBuffer$ = Left$(lpBuffer$, r&)

r& = InStr(lpBuffer$, Chr$(0))
If r& = 0 Then r& = Len(lpBuffer$)
If r& > 100 Then r& = 100

For i& = 1 To r&
frmMain.Picture1.Print Asc(Mid$(lpBuffer$, i, 1))
Next i

End Sub

alpine <alp...@mvps.org> wrote in
news:b0mauug8o7hd2o456...@4ax.com:

[alpine]

Have a look at the following code.....

HTH,
Bryan
____________________________________________________________
New Vision Software "When the going gets weird,"
Bryan Stafford "the weird turn pro."
alp...@mvps.org Hunter S. Thompson -
Microsoft MVP-Visual Basic Fear and Loathing in LasVegas

'paste this into a form and select a truetype font as the form's font

Option Explicit

Private Type POINTAPI

x As Long 'Integer
y As Long 'Integer
End Type

Private Type GLYPHMETRICS

gmBlackBoxX As Long 'Integer
gmBlackBoxY As Long 'Integer
gmptGlyphOrigin As POINTAPI
gmCellIncX As Integer
gmCellIncY As Integer
End Type

Private Type FIXED

fract As Integer
Value As Integer
End Type

Private Type MAT2

eM11 As FIXED
eM12 As FIXED
eM21 As FIXED
eM22 As FIXED
End Type

Private Type POINTFX

x As FIXED
y As FIXED
End Type

Private Type TTPOLYCURVE

wType As Integer
cpfx As Integer
apfx As POINTFX
End Type

Private Type TTPOLYGONHEADER

cb As Long
dwType As Long
pfxStart As POINTFX
End Type

Private Const GDI_ERROR As Long = &HFFFF

Private Const GGO_METRICS As Long = 0&
Private Const GGO_BITMAP As Long = 1&
Private Const GGO_NATIVE As Long = 2&

Private Declare Function GetGlyphOutline Lib "gdi32" Alias
"GetGlyphOutlineA" (ByVal hDC&, ByVal uChar&, ByVal fuFormat&, lpgm As
GLYPHMETRICS, ByVal cbBuffer&, lpBuffer As Any, lpmat2 As MAT2) As
Long

Private Sub GetGlyphs(ByVal hDC&)

Dim lpgm As GLYPHMETRICS
Dim lpmat2 As MAT2

Dim i&, Nr&, cBuff&, nBuffLen&, abytBuffer() As Byte

Nr = Asc("i") ' ASCII code, like 'i'=105

lpgm.gmBlackBoxX = 64
lpgm.gmBlackBoxY = 64
lpgm.gmptGlyphOrigin.x = 10
lpgm.gmptGlyphOrigin.y = 10
lpgm.gmCellIncX = 70
lpgm.gmCellIncY = 70

lpmat2.eM11.Value = 1: lpmat2.eM11.fract = 0
lpmat2.eM12.Value = 0: lpmat2.eM12.fract = 0
lpmat2.eM21.Value = 0: lpmat2.eM21.fract = 0
lpmat2.eM22.Value = 1: lpmat2.eM22.fract = 0

' Get the required buffer size (This works)

nBuffLen = GetGlyphOutline(hDC, Nr, GGO_NATIVE, lpgm, 0, ByVal 0&,
lpmat2)
If nBuffLen <> GDI_ERROR Then

' This works too.
With lpgm.gmptGlyphOrigin

Debug.Print "width = " & CStr(.x) & " height = " & CStr(.y)

End With

' Set the buffer size

ReDim abytBuffer(nBuffLen - 1) As Byte

'Then retrieve the information
If GetGlyphOutline(hDC, Nr, GGO_NATIVE, lpgm, nBuffLen,
abytBuffer(0), lpmat2) <> GDI_ERROR Then
For i = 0 To UBound(abytBuffer)
Debug.Print abytBuffer(i)
Next
Else
Debug.Print Err.LastDllError
End If
Else
Debug.Print Err.LastDllError
End If


End Sub

Private Sub Command1_Click()
GetGlyphs Me.hDC
End Sub

On Wed, 27 Nov 2002 23:53:09 GMT, "E. Cox" <NoS...@MicroSun.com>

[E. Cox]

Thanks Bryan. That works. At least that's to say it doesn't crash and
it returns a bunch of numbers (a lot more zeros than I would have
expected). I will now have to use the TTPOLYGONHEADER and TTPOLYCURVE
Types to get the Bezier curve information to make sure I'm getting the
correct data.

So, what exactly would you say was the problem? I need to learn from my
mistake. Was it the DIMing of the variables as Bytes (instead of
Integers) or you use of the "abytBuffer"?

I've single stepped through your code and I don't see the difference that
is allowing it to work.

Thanks a lot for your help. Now I get to continue. I just might be
almost there.

Edward

alpine <alp...@mvps.org> wrote in news:nm7buu8msh20kbo2t723303uvggms7upg7
@4ax.com:

[alpine]

The problem was that you were trying to use a string to contain byte
data. In 32bit VB, if you need a buffer for byte data, use a byte
array.

While it is possible to use a string buffer, there are all kinds of
issues with unicode conversion since VB strings are unicode internally
and are converted to and from ANSI when they are passed, using the 'As
String' data type, in an API call.

HTH,
Bryan
____________________________________________________________
New Vision Software "When the going gets weird,"
Bryan Stafford "the weird turn pro."
alp...@mvps.org Hunter S. Thompson -
Microsoft MVP-Visual Basic Fear and Loathing in LasVegas

On Thu, 28 Nov 2002 18:16:40 GMT, "E. Cox" <NoS...@MicroSun.com>

[E. Cox]

OK, Thanks. Then I've learned something. I was using code I found on
the Internet so I guess it must have worked in a previous version of
Windows. Thanks for the help and thanks for the lesson.

Edward

alpine <alp...@mvps.org> wrote in
news:hqocuu43leq7v1npn...@4ax.com: