100分没人理，我放发1000分！

http://community.csdn.net/Expert/topic/4376/4376627.xml?temp=.7153131
我要用到fmthex32.dll 的getfonthex()函数。有没人会用啊。能给段原码吗？以下是原代码，不知道为什么一运行就出错，关闭程序。不知道问题出在那？有谁帮我解决这问题，我将另开贴答谢，不失言，一千分！！！！！！
Option ExplicitPrivate Declare Function GETFONTHEX Lib "FNTHEX32.DLL" (ByVal chnstr$, ByVal fontname$, ByVal chnname$, ByVal orient%, ByVal height%, ByVal width%, ByVal bold%, ByVal italic%, ByVal hexbuf$) As Integer
Private Sub Command1_Click()
Dim MAX_BUFFER As Integer, nCount As Integer
Dim cBuf As String * 21000
Dim i As Integer 'nCount = GETFONTHEX("黑体", "黑体", "chnstr01", 0, 24, 0, 1, 0, cBuf)Open "LPT1:" For Output As #1
Print #1, Mid(cBuf, 1, nCount)
Close #1

解决方案 »

  1.   

    Private Declare Function GETFONTHEX Lib "fnthex32.dll" (ByVal chnstr$, ByVal fontname$, ByVal chnname$, ByVal orient%, ByVal height%, ByVal width%, _
                                                            ByVal bold%, ByVal italic%, ByVal hexbuf$) As IntegerDim i As Long
        Dim str1 As String
        Dim str2 As String
        Dim str3 As String * 10000Open "LPT1:" For Output As #1
     i = GetFontHex("测试打印", "黑体", "WWW", 0, 28, 12, 1, 0, str3, 10000)
     str2 = Left(str3, i)
     Print #1, str2
     str1 = Chr(2) + "m" + Chr(13)       '*** 设为厘米 ***
     Print #1, str1
    Close #1
      

  2.   

    i = GetFontHex("测试打印", "黑体", "WWW", 0, 28, 12, 1, 0, str3, 10000)这句出错
    错误提示,无效的参数或付值.
      

  3.   

    i = GetFontHex("测试打印", "黑体", "WWW", 0, 28, 12, 1, 0, str3, 10000)把后冇10000去掉,不会也错,但VB发出错误,自动关闭VB.
      

  4.   

    //i = GetFontHex("测试打印", "黑体", "WWW", 0, 28, 12, 1, 0, str3, 10000)把后冇10000去掉,不会也错,但VB发出错误,自动关闭VB.最后一个参数应该为指向一个缓冲区的指针,这样试试:
    dim buff() as byte
    redim buff(21& * 1024& - 1)i = GetFontHex("测试打印", "黑体", "WWW", 0, 28, 12, 1, 0, str3, varptr(buff(0)))
      

  5.   

    Private Declare Function GETFONTHEX Lib "fnthex32.dll" (ByVal chnstr$, ByVal fontname$, ByVal chnname$, ByVal orient%, ByVal height%, ByVal width%, _
                                                            ByVal bold%, ByVal italic%, ByVal hexbuf$) As Integer
    在这个调用中也没有后冇这个1000的值.
      

  6.   

    上面的问题我已经找到答案了，但还是有点问题，就是chnstr02，chnstr01，这种值在之前用过后，在后面再付值却不变。更奇怪的是，我那段循环，12，45678都可以，就是3打不了。是那里有问题，麻烦大侠看看。
     Set con = New adodb.Connection
     str = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "/code.mdb" & ";"
     con.Open str
     Set rs = New adodb.Recordset
    rs.CursorLocation = adUseClient
    rs.LockType = adLockReadOnly
     rs.Open "barcode", con, 1, 3
     reco = rs.RecordCount
     Do While Not rs.BOF = True
          
         Open App.Path & "\set.inf" For Input As #1
         Line Input #1, label_1
         Close #1rs.Filter = "编号='" & Val(label_1) & "'"
    If rs.AbsolutePosition >= 1 Then
    str5 = rs!字符
         stri = str1 & "-" & str2 & "-" & str3 & "-" & str4 & "-" & str5
         strii = "REV " & str7
         striii = str8
         cstri = str1 & "-" & str2 & "-" & str3 & "-" & str4 & "-" & str5
         cstrii = str1 & "-" & str2 & "-" & str3 & "-" & str4 & "-" & str5
                   
            If Val(label_1) = reco And Val(label_1) Mod 2 = 1 Then
                
        nCount = GETFONTHEX(strii, "verdana", "chnstr02", 0, 34, 15, 1, 0, cbuf1)
        strii = Mid(cbuf1, 1, nCount)
        nCount = GETFONTHEX(striii, "verdana", "chnstr03", 0, 45, 15, 1, 0, cbuf2)
        striii = Mid(cbuf2, 1, nCount)
        nCount = GETFONTHEX(stri, "verdana", "chnstr01", 0, 34, 17, 1, 0, cBuf)
        stri = Mid(cBuf, 1, nCount)
           
        
        str = "^XA^LH20,20^FO" & x_1 & "," & y_1 & "^BCN," & h_1 & ",N,N,N^AX0,20,20^FD>:" & str1 & str2 & str3 & str4 & str5 & "^FS^FO" & Val(x_1) + 5 & "," & Val(y_1) + Val(h_1) - 3 & "^XGchnstr01^FS^FO" & x_2 & "," & y_2 & "^BCN," & h_2 & ",N,N,N^A0N,30,30^FD>:" & str7 & "^FS^FO" & x_2 & "," & Val(y_2) + Val(h_2) - 3 & "^XGchnstr02^FS^FO" & Val(x_3) & "," & Val(y_3) & "^XGchnstr03^FS^XZ"
        Open "LPT1:" For Binary Access Write As #1
         Put #1, , Mid(cBuf, 1, nCount)
         Put #1, , Mid(cbuf1, 1, nCount)
         Put #1, , Mid(cbuf2, 1, nCount)
         Put #1, , Mid(cbuf3, 1, nCount)
         Put #1, , Mid(cbuf3, 1, nCount)
         Put #1, , str
         Close #1
        WaitFor 50
        rs.Filter = "编号='" & Val(label_1) & "'"
           rs.Delete adAffectCurrent
        Exit Sub
        End If
        
         If label_1 Mod 2 = 1 Then
         cbuf1 = ""
         cbuf2 = ""
         cbuf3 = ""
         'cBuf = ""
         
         nCount = GETFONTHEX(strii, "verdana", "chnstr02", 0, 34, 15, 1, 0, cbuf1)
         strii = Mid(cbuf1, 1, nCount)
         nCount = GETFONTHEX(striii, "verdana", "chnstr03", 0, 45, 15, 1, 0, cbuf2)
         striii = Mid(cbuf2, 1, nCount)
         nCount = GETFONTHEX(cstrii, "verdana", "chnstr04", 0, 34, 17, 1, 0, cbuf3)
         cstrii = Mid(cbuf3, 1, nCount)
         strx = "^XA^LH20,20^FO" & x_1 & "," & y_1 & "^BCN," & h_1 & ",N,N,N^AX0,20,20^FD>:" & str1 & str2 & str3 & str4 & str5 & "^FS^FO" & Val(x_1) + 5 & "," & Val(y_1) + Val(h_1) - 3 & "^XGchnstr04^FS^FO" & x_2 & "," & y_2 & "^BCN," & h_2 & ",N,N,N^A0N,30,30^FD>:" & str7 & "^FS^FO" & x_2 & "," & Val(y_2) + Val(h_2) - 3 & "^XGchnstr02^FS^FO" & Val(x_3) & "," & Val(y_3) & "^XGchnstr03^FS"""
         Open App.Path & "\CODE.inf" For Output As #1
         Write #1, strx
         Close #1
                        
                        Else
        nCount = GETFONTHEX(cstri, "verdana", "chnstr05", 0, 34, 17, 1, 0, cbuf4)
        cstri = Mid(cbuf4, 1, nCount)
        str = "^FO" & Val(x_1) + 600 & "," & y_1 & "^BCN," & h_1 & ",N,N,N^AX0,20,20^FD>:" & str1 & str2 & str3 & str4 & str5 & "^FS^FO" & Val(x_1) + 605 & "," & Val(y_1) + Val(h_1) - 3 & "^XGchnstr05^FS^FO" & Val(x_2) + 600 & "," & y_2 & "^BCN," & h_2 & ",N,N,N^A0N,30,30^FD>:" & str7 & "^FS^FO" & Val(x_2) + 600 & "," & Val(y_2) + Val(h_2) - 3 & "^XGchnstr02^FS^FO" & Val(x_3) + 600 & "," & y_3 & "^XGchnstr03^FS^XZ"
        Open App.Path & "\code.inf" For Input As #1
        Line Input #1, strx
        Close #1
        str = Mid(strx, 2, Len(strx) - 2) & str  Open App.Path & "\CODE.inf" For Output As #1
        Write #1, str
        Close #1
        Open App.Path & "\code.inf" For Input As #1
    Line Input #1, strx
    Close #1Open "LPT1:" For Binary Access Write As #1
         Put #1, , Mid(cBuf, 1, nCount)
         Put #1, , Mid(cbuf1, 1, nCount)
         Put #1, , Mid(cbuf2, 1, nCount)
         Put #1, , Mid(cbuf3, 1, nCount)
         Put #1, , Mid(cbuf4, 1, nCount)
         Put #1, , strx
         Close #1
                  WaitFor 50
                  End If
                  If Val(label_1) = reco Then
    MsgBox "全部打印完毕！", 32, "科进科技"
    Open App.Path & "\number.inf" For Input As #1
    Line Input #1, str_number
    Close #1
    Open App.Path & "\set.inf" For Output As #1
    Write #1, 1
    Close #1
    I = Val(str_number) + 1
     con.Execute "insert into barcodew values(" & I & " ,'" & str1 & str2 & str3 & str4 & str5 & "')"
    Open App.Path & "\number.inf" For Output As #1
    Write #1, I
    Close #1
    rs.Filter = "编号='" & Val(label_1) & "'"
     rs.Delete adAffectCurrent
    Unload Me
    Exit Sub
    End If
    rs.Filter = "编号='" & Val(label_1) & "'"
    If rs.AbsolutePosition >= 1 Then
       rs.Delete adAffectCurrent
       End If
       Open App.Path & "\set.inf" For Output As #1
         Write #1, Val(label_1) + 1
         Close #1
       Else
       
      Exit Sub
      End If Loop Exit Sub
    error: