Imports System.Net
Imports System.Drawing
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Web
Imports System.Reflection

Public Structure NJFRect
    Public Left As Int32
    Public Top As Int32
    Public Right As Int32
    Public Bottom As Int32
End Structure

Public Class Vtlib
    Private Const bmp_Width = 800
    Private Const bmp_Height = 480
    Private bmp As Bitmap
    Private TmpPath As String

    Public ErrMessage As String

    Private Sub Class_Initialize()
        bmp = New Bitmap(bmp_Width, bmp_Height, Imaging.PixelFormat.Format24bppRgb)
        Dim g As Graphics = Graphics.FromImage(bmp)
        g.Clear(Color.FromArgb(&HF5, &HF5, &HF5))
        g.Dispose()
        TmpPath = Assembly.GetEntryAssembly().Location
    End Sub

    Private Sub Class_Terminate()
        bmp.Dispose()
    End Sub

    Private Function SendRequest(ByVal url As String, ByRef msg As String) As Int32
        Dim request As HttpWebRequest
        request = WebRequest.Create(url)
        request.Timeout = 15000
        request.Method = "GET"
        msg = ""
        'request.ContentType = "application/x-www-form-urlencoded"
        Try
            Dim response As HttpWebResponse
            response = request.GetResponse()
            Dim myreader As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream(), Encoding.UTF8)
            Dim responseText As String = myreader.ReadToEnd().ToLower()
            myreader.Close()
            If (responseText.IndexOf("result") > 0) And (responseText.IndexOf("true") > 0) Then
                SendRequest = 0
            Else
                SendRequest = 1
            End If
            Dim arr As String() = responseText.Split(":")
            If (arr.Length >= 3) Then
                msg = arr.LastOrDefault
                Dim charsToTrim() As Char = {"}"c, ")"c, " "c}
                msg = msg.TrimEnd(charsToTrim)
                msg = msg.Replace("""", "")
            End If
        Catch ex As Exception
            SendRequest = 1
            msg = ex.Message
        End Try
    End Function

    Public Function VTMCls(ByVal Color As Int32) As Int32  '清屏
        Dim url As String = "http://localhost:5018/setvalue?clearall=true&jsoncallback=?"
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function VTMShowFormatText(ByVal text As String, ByVal boldStyle As Int32, ByVal alignStyle As Int32, ByVal colorStyle As Int32, ByVal hasGrid As Int32) As Int32   '格式化文本显示
        'text = convEncode(text, "gb2312", "utf-8")
        Dim Strings As String = ""
        Dim Fonts As String = ""
        Dim pattern As String = "([^,=]*)=([^,=]*)"
        Dim i As Integer = 1
        Dim mc As MatchCollection = Regex.Matches(text, pattern)

        For Each m As Match In mc
            Dim key As String = m.Groups(1).Value
            Dim value As String = m.Groups(2).Value
            Strings &= String.Format("line{0}={1}&xline{0}={2}", i, HttpUtility.UrlEncode(key, Encoding.GetEncoding(936)), HttpUtility.UrlEncode(value, Encoding.GetEncoding(936))) & "&"
            Fonts += String.Format("font{0}=,*1,&", i)
            i += 1
        Next

        Dim r As Byte = CByte(colorStyle Mod 256)
        Dim g As Byte = CByte((colorStyle >> 8) Mod 256)
        Dim b As Byte = CByte((colorStyle >> 16) Mod 256)
        Dim Styles As String = String.Format("color:{0:x2}{1:x2}{2:x2};", r, g, b)
        If (hasGrid) Then
            Styles += "hasGrid:true;"
        Else
            Styles += "hasGrid:false;"
        End If

        If (boldStyle And 1) <> 0 Then '标题加粗
            Styles += "keyWeight:bold;"
        Else
            Styles += "keyWeight:regular;"
        End If

        If (boldStyle And 2) <> 0 Then '内容加粗
            Styles += "valueWeight:bold;"
        Else
            Styles += "valueWeight:regular;"
        End If

        If (alignStyle And 1) <> 0 Then '纵向不居中
            Styles += "vAlign:top;"
        Else '纵向居中   
            Styles += "vAlign:center;"
        End If

        If (alignStyle And 2) <> 0 Then 'x:= 0  '横向不居中
            Styles += "hAlign:left;"
        Else '横向居中  
            Styles += "hAlign:center;"
        End If

        If (alignStyle And 4) <> 0 Then '标题靠右
            Styles += "keyAlign:right;"
        Else '标题靠左   
            Styles += "keyAlign:left;"
        End If

        If (alignStyle And 8) <> 0 Then '内容靠右
            Styles += "valueAlign:right"
        Else  '内容靠左
            Styles += "valueAlign:left;"
        End If

        Dim url As String = "http://localhost:5018/setvalue?style=" & Styles & "&" & Strings & Fonts & "jsoncallback=?"
        Return SendRequest(url, ErrMessage)
    End Function

    Private Function BitmapDrawText(ByVal X As Int32, ByVal Y As Int32, ByVal text As String, ByVal ftName As String, ByVal ftSize As Int32, ByVal ftColor As Int32, ByVal ftbold As Int32) As String
        '绘图
        'Dim bmp As Bitmap = New Bitmap(bmp_Width, bmp_Height, Imaging.PixelFormat.Format24bppRgb)
        Dim g As Graphics = Graphics.FromImage(bmp)
        g.Clear(Color.FromArgb(&HF5, &HF5, &HF5))
        Dim fs As FontStyle = FontStyle.Regular
        If ftbold Then fs = FontStyle.Bold
        Dim f As Font = New Font(ftName, ftSize * 2, fs, GraphicsUnit.Pixel)
        Dim b As SolidBrush = New SolidBrush(Color.FromArgb(ftColor))
        g.DrawString(text, f, b, X, Y)
        Dim dummy As String = TmpPath & "\dummy.bmp"
        Try
            bmp.Save(dummy)
        Catch
            dummy = TmpPath & "\dummy1.bmp"
            Try
                bmp.Save(dummy)
            Catch ex As Exception
                ErrMessage = ex.Message
                dummy = vbNull
            End Try
        End Try
        g.Dispose()
        Return dummy
    End Function

    Public Function VTMDrawText(ByVal X As Int32, ByVal Y As Int32, ByVal text As String, ByVal ftName As String, ByVal ftSize As Int32, ByVal ftColor As Int32, ByVal ftbold As Int32) As Int32   '按坐标的文本显示
        'ErrMessage = "不支持该函数"
        Dim bmpFile As String
        bmpFile = BitmapDrawText(X, Y, text, ftName, ftSize, ftColor, ftbold)
        If bmpFile <> vbNull Then
            Dim url As String = String.Format("http://localhost:5018/setvalue?img={0}&jsoncallback=?", HttpUtility.UrlEncode(bmpFile, Encoding.GetEncoding(936)))
            url = Replace(url, "\", "/")
            url = Replace(url, " ", "%20")
            Return SendRequest(url, ErrMessage)
        Else
            Return 1
        End If
    End Function

    Public Function VTMPrintText(ByVal Col As Byte, ByVal Row As Byte, ByVal Size As Byte, ByVal Color As Int32, ByVal text As String) As Int32 '按行列的文本显示
        Dim styleStr As String = "hAlign:left;vAlign:top;"
        'Dim carr As Char()
        'ReDim carr((Col - 1) * 2)
        Dim lineStr As String = String.Format("{0}{1}", Space((Col - 1) * 2), HttpUtility.UrlEncode(text, Encoding.GetEncoding(936)))
        'Dim lineStr As String = HttpUtility.UrlEncode(text, Encoding.GetEncoding(936))
        Dim r As Byte = CByte(Color Mod 256)
        Dim g As Byte = CByte((Color >> 8) Mod 256)
        Dim b As Byte = CByte((Color >> 16) Mod 256)
        Dim fontStr As String = String.Format(",*{0},,{1:x2}{2:x2}{3:x2}", Size, r, g, b)
        Dim reqStr As String = String.Format("setvalue?xline{0}=&line{0}={1}&font{0}={2}&style={3}", Row, lineStr, fontStr, styleStr)
        Dim url As String = "http://localhost:5018/" & reqStr & "&jsoncallback=?"
        Return SendRequest(url, ErrMessage)
    End Function


    Public Function VTMShowPicture(ByVal X As Int32, ByVal Y As Int32, ByVal imgfile As String, ByRef region As NJFRect) As Int32    '图像显示
        '绘图
        Dim bmp1 As Bitmap = New Bitmap(imgfile)
        Dim g As Graphics = Graphics.FromImage(bmp)
        g.DrawImage(bmp1, New Rectangle(region.Left, region.Top, region.Right - region.Left, region.Bottom - region.Top))
        Dim dummy As String = TmpPath & "\dummy.bmp"
        Try
            bmp.Save(dummy)
        Catch
            dummy = TmpPath & "\dummy1.bmp"
            Try
                bmp.Save(dummy)
            Catch ex As Exception
                ErrMessage = ex.Message
                dummy = vbNull
            End Try
        End Try
        g.Dispose()
        bmp1.Dispose()
        If (dummy <> vbNull) Then
            Dim url As String = String.Format("http://localhost:5018/setvalue?img={0}&jsoncallback=?", HttpUtility.UrlEncode(dummy, Encoding.GetEncoding(936)))
            url = Replace(url, "\", "/")
            url = Replace(url, " ", "%20")
            Return SendRequest(url, ErrMessage)
        Else
            Return 1
        End If
    End Function

    Public Function VTMDrawLine(ByVal Width As Byte, ByVal Color As Int32, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Int32     '画直线
        '绘图
        Dim g As Graphics = Graphics.FromImage(bmp)
        g.DrawLine(New Pen(System.Drawing.Color.FromArgb(Color)), X1, Y1, X2, Y2)

        Dim dummy As String = TmpPath & "\dummy.bmp"
        Try
            bmp.Save(dummy)
        Catch
            dummy = TmpPath & "\dummy1.bmp"
            Try
                bmp.Save(dummy)
            Catch ex As Exception
                ErrMessage = ex.Message
                dummy = vbNull
            End Try
        End Try
        g.Dispose()
        If (dummy <> vbNull) Then
            Dim url As String = String.Format("http://localhost:5018/setvalue?img={0}&jsoncallback=?", HttpUtility.UrlEncode(dummy, Encoding.GetEncoding(936)))
            url = Replace(url, "\", "/")
            url = Replace(url, " ", "%20")
            Return SendRequest(url, ErrMessage)
        Else
            Return 1
        End If
    End Function

    Public Function VTMReset() As Int32    '复位
        Return VTMCls(0)
    End Function

    Public Function NJFSoundOut(ByVal cmd As String) As Int32  '播放语音指令
        Dim url As String = String.Format("http://localhost:5018/playsound?code={0}&jsoncallback=?", cmd)
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function NJFSpeak(ByVal sentence As String) As Int32        '软件语音合成
        Dim url As String = String.Format("http://localhost:5018/playsound?text={0}&jsoncallback=?", HttpUtility.UrlEncode(sentence, Encoding.GetEncoding(936)))
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function NJFSoundStop() As Int32    '停止语音播放
        Dim url As String = "http://localhost:5018/playsound?clearall=true&jsoncallback=?"
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function VTMShowPhoto(ByVal photo As String) As Int32 '显示操作员图片
        Dim url As String = String.Format("http://localhost:5018/setvalue?photo={0}&jsoncallback=?", HttpUtility.UrlEncode(photo, Encoding.GetEncoding(936)))
        url = Replace(url, "\", "/")
        url = Replace(url, " ", "%20")
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function VTMAskforComment(ByVal EmpId As String, ByVal photo As String, ByVal prompt As String, ByVal delay As Integer) As Int32  '请求评价
        Dim url As String = String.Format("http://localhost:5018/askcomment?empid={0}&photo={1}&prompt={2}&delay={3}&jsoncallback=?", EmpId, HttpUtility.UrlEncode(photo, Encoding.GetEncoding(936)), HttpUtility.UrlEncode(prompt, Encoding.GetEncoding(936)), delay)
        url = Replace(url, "\", "/")
        url = Replace(url, " ", "%20")
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function VTMAskforCommentEx(ByVal EmpId As String, ByVal photo As String, ByVal prompt As String, ByVal title As String, ByVal buttons As Integer, ByVal delay As Integer) As Int32  '请求评价
        Dim url As String = String.Format("http://localhost:5018/askcomment?empid={0}&photo={1}&prompt={2}&title={3}&style={4}&delay={5}&jsoncallback=?", EmpId, HttpUtility.UrlEncode(photo, Encoding.GetEncoding(936)), HttpUtility.UrlEncode(prompt, Encoding.GetEncoding(936)), HttpUtility.UrlEncode(title, Encoding.GetEncoding(936)), buttons, delay)
        url = Replace(url, "\", "/")
        url = Replace(url, " ", "%20")
        Return SendRequest(url, ErrMessage)
    End Function

    Public Function VTMGetComment(ByVal EmpId As String) As Int32  '取回评价结果
        Const ERROR_WAITING = -1
        Const ERROR_ID = -2
        Const ERROR_NO_ID = -3
        Const ERROR_UNKNOWN = -4

        Dim url As String = String.Format("http://localhost:5018/getcomment?empid={0}&jsoncallback=?", EmpId)
        Dim msg As String = ""
        If (SendRequest(url, msg) = 0) Then
            Return CInt(msg) + 2
        Else
            msg = msg.ToUpper()
            If (msg = "ERROR_NO_ID") Then
                Return ERROR_NO_ID
            ElseIf (msg = "ERROR_ID") Then
                Return ERROR_ID
            ElseIf (msg = "ERROR_WAITING") Then
                Return ERROR_WAITING
            Else
                Return ERROR_UNKNOWN
            End If
        End If
    End Function

End Class
