信息.frm

我们公司生产线大屏幕的程序．是用visual basic语言编写的．

        char = Chr$(KeyAscii)
        Text1.Text = char
        Text1.SelStart = 1
    End If
        ShowTextBox
        KeyAscii = 0
End Sub
Private Sub MSFlexGrid1_LeaveCell()
    MSFlexGrid1.Text = Text1.Text
    If MSFlexGrid1.Col = 0 And MSFlexGrid1.Row <> 0 And _
     MSFlexGrid1.Row = MSFlexGrid1.Rows - 1 And MSFlexGrid1.Text <> "" Then
         MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
     End If
      
End Sub

Private Sub MSFlexGrid1_RowColChange()
     Text1.Text = MSFlexGrid1.Text
        ShowTextBox
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        MSFlexGrid1.Text = Text1.Text
        Text1.Visible = False
        MSFlexGrid1.SetFocus
        If MSFlexGrid1.Col < (MSFlexGrid1.Cols - 1) Then
            MSFlexGrid1.Col = MSFlexGrid1.Col + 1
        ElseIf MSFlexGrid1.Row < MSFlexGrid1.Rows - 1 Then
            MSFlexGrid1.Row = MSFlexGrid1.Row + 1
            MSFlexGrid1.Col = 0
        End If
        KeyAscii = 0
    End If
End Sub


Private Sub Timer1_Timer()
    Timer1.Interval = myshowmode(show_current \ 2).pausetime * 880
    If (show_current \ 2) * 2 <> show_current Then
 '       OutString = "CHR" + Chr(2)
 '       MSComm1.Output = OutString
        读数据
        OutString = "CHR" + Chr(2) + "          奇瑞生产信息" & Chr(13) & Chr(10)
        OutString = OutString & Format(Date, "yyyy年mm月dd日 星期") & Choose(Weekday(Date), "日", "一", "二", "三", "四", "五", "六") & Format(Time, " hh:mm ") & Chr(13) & Chr(10)
        OutString = OutString & "年目标:" & njh & "辆 " & "年实际:" & nwc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "月计划:" & yjh & "辆 " & "月实际:" & ywc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "日计划:" & rjh & "辆 " & "日实际:" & rwc & " 辆" & Chr(13) & Chr(10)
        OutString = OutString & "节拍产量: " & jp & "辆 " & Chr(13) & Chr(10)
        OutString = OutString & error_inf & Chr(14)
'        Open "c:\led\data1.txt" For Input As #2
'            Dim EndTime As Date
 '   EndTime = DateAdd("s", 2, Now)
 '   Do Until Now > EndTime
 '      DoEvents
 '      Loop
'        OutString = StrConv(InputB$(LOF(2), #2), vbUnicode) & Chr(14)
        Picture1.Visible = False
        Label1.Visible = True
        Label1.Caption = OutString
        MSComm1.Output = OutString
        Close #2
    Else
        OutString = "PIC" + Chr(show_current \ 2 + 1) 'ping 1
        MSComm1.Output = OutString
        Picture1.Picture = LoadPicture(myshowmode(show_current \ 2).fileName)
        Picture1.Visible = True
        Label1.Visible = False
    End If
    If tcpClient.State <> sckClosed Then _
    tcpClient.Close
    tcpClient.Connect IP1, PORT
    If show_current < 2 * show_max - 1 Then
       show_current = show_current + 1
    Else
       show_current = 0
    End If
End Sub

Private Sub timeset_Click()
    Dim mytime
    Timer1.Enabled = False
    Check1.VALUE = 0
    mytime = Now
    'asc(chr(x))=x    x must <=128
    OutString = "TIM" & Chr(Hour(mytime)) & Chr(Minute(mytime)) & Chr(Second(mytime)) _
    & Chr(Month(mytime)) & Chr(Day(mytime)) & Chr(Year(mytime) - 2000) & Chr(Weekday(mytime))
    MSComm1.Output = OutString
End Sub
Private Sub sendbmp(ByVal fileName As String, ByVal pingnumber As Long)
    Const VALUE As Byte = 128
    Dim i, j, k
    Dim mychar As String
    Dim d As Integer
    Dim colorcount As Integer
    Dim bytes As Integer
    Dim linebytes As Long
    Dim width As Integer
    Dim height As Long
    Dim fileoffset As Long
    Dim fileHeader As BITMAPFILEHEADER
    Dim infoHeader As BITMAPINFOHEADER
    Dim pixel(1500, 300) As Byte
       
    On Error GoTo ErrorHandler   ' 打开错误处理程序。
    Open fileName For Binary Access Read As #1
    On Error GoTo 0   ' 关闭错误陷阱。
    Get #1, , fileHeader.bftype
    Get #1, , fileHeader.bfsize
    Get #1, , fileHeader.bfreserved1
    Get #1, , fileHeader.bfreserved2
    Get #1, , fileHeader.bfoffbits
 
    
    Get #1, , infoHeader.bisize
    Get #1, , infoHeader.biwidth
    Get #1, , infoHeader.biheight
    Get #1, , infoHeader.biplanes
    Get #1, , infoHeader.bibitcount
    Get #1, , infoHeader.bicompress
    Get #1, , infoHeader.bisizeimage
    Get #1, , infoHeader.bixpeispermeter
    Get #1, , infoHeader.biypeispermeter
    Get #1, , infoHeader.bicirused
    Get #1, , infoHeader.bicirimprotant
    
        
    If infoHeader.bicompress <> 0 Then
        MsgBox "only supports non_compressed BMP file"
        Close #1
        Exit Sub
    End If
    If infoHeader.bibitcount <> 24 And infoHeader.bibitcount <> 1 Then
        MsgBox "only support 单色 or 24Bit BMP file"
        Close #1
        Exit Sub
    End If
    width = infoHeader.biwidth
    height = infoHeader.biheight
    bytes = (width * infoHeader.bibitcount + 7) \ 8
    linebytes = ((bytes + 3) \ 4) * 4
'    ReDim outbytes(infoHeader.bisizeimage - 1)
    OutString = "BMP" & Chr(pingnumber)
    tcpClient.SendData OutString
'    MSComm1.Output = OutString
    Picture1.Picture = LoadPicture(fileName)
    Picture1.Visible = True
    If infoHeader.bibitcount = 1 Then
        Dim temp As Byte
        ReDim outbytes(linebytes - 1)
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        Get #1, , temp
        For j = height - 1 To 0 Step -1
            For i = 0 To linebytes - 1
                Get #1, , pixel(i, j)
            Next i
        Next j
        For j = 0 To height - 1
            For i = 0 To linebytes - 1
'                outbytes(i + j * linebytes) = pixel(i, j)
                outbytes(i) = pixel(i, j)
            Next i
            Picture1.height = (1 + j) * Screen.TwipsPerPixelX
            Picture1.width = width * Screen.TwipsPerPixelY
            DoEvents
            
            tcpClient.SendData OutString
'            MSComm1.Output = outbytes
        Next j
    Else
'    fileoffset = fileHeader.bfoffbits
        For j = height - 1 To 0 Step -1
            For i = 0 To linebytes - 1
                Get #1, , pixel(i, j)
            Next i
        Next j
    
        infoHeader.bibitcount = 1
        bytes = (width * infoHeader.bibitcount + 7) \ 8
        linebytes = ((bytes + 3) \ 4) * 4
        infoHeader.bisizeimage = linebytes * height
        ReDim outbytes(linebytes - 1)
        
        For j = 0 To height - 1
            For i = 0 To linebytes - 1
'                outbytes(i + j * linebytes) = 0
                outbytes(i) = 0
                For k = 0 To 7
                    If pixel((8 * i + k) * 3, j) > 128 Then
'                        outbytes(i + j * linebytes) = outbytes(i + j * linebytes) Or 2 ^ (7 - k)
                        outbytes(i) = outbytes(i) Or 2 ^ (7 - k)
                    End If
                Next k
            Next i
        
            Picture1.height = (1 + j) * Screen.TwipsPerPixelX
            Picture1.width = width * Screen.TwipsPerPixelY
            DoEvents
            tcpClient.SendData OutString
'            MSComm1.Output = outbytes
        Next j
    
    End If
        

'    Picture1.height = height * Screen.TwipsPerPixelX
'    Picture1.width = width * Screen.TwipsPerPixelY
'    Picture1.Picture = LoadPicture(filename)
'    DoEvents
    
'        MSComm1.Output = outbytes
 
    Close #1

    Picture1.height = 0
    Picture1.width = 0
    Exit Sub      ' 退出程序，以避免进入错误处理程序。
ErrorHandler:           ' 错误处理程序。
   Select Case Err.Number   ' 检查错误代号。
      Case 53   ' 发生“文件打不开”的错误。
      MsgBox "*.bmp open error."
'      Err.Clear   ' 清除 Err 对象字段。
       Case Else
        ' 处理其他错误状态 . . .
   End Select
End Sub

Public Sub 读设置()
    Dim i
    Open "setfile" For Random As #1
    Get #1, , show_max
    MSFlexGrid1.Rows = show_max + 1
    For i = 0 To show_max - 1
        Get #1, , myshowmode(i).fileName
        Get #1, , myshowmode(i).pausetime
        Get #1, , myshowmode(i).dsmode
        Get #1, , myshowmode(i).dsclock
    MSFlexGrid1.TextMatrix(i + 1, 0) = myshowmode(i).fileName
    MSFlexGrid1.TextMatrix(i + 1, 1) = myshowmode(i).pausetime
    MSFlexGrid1.TextMatrix(i + 1, 2) = myshowmode(i).dsmode
    MSFlexGrid1.TextMatrix(i + 1, 3) = myshowmode(i).dsclock
    Next i
   Text1.Text = MSFlexGrid1.Text
    Close #1
End Sub

Public Sub 写设置()
    Dim i
    'MSFlexGrid1.TextArray(1 * MSFlexGrid1.Cols + 1) = "文件名"
    MSFlexGrid1.Text = Text1.Text
    While MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = ""
        MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
    Wend
    show_max = MSFlexGrid1.Rows - 1
    Open "setfile" For Random As #1
    Put #1, , show_max
    For i = 0 To show_max - 1
        myshowmode(i).fileName = MSFlexGrid1.TextMatrix(i + 1, 0)
        If Val(MSFlexGrid1.TextMatrix(i + 1, 1)) > 18 Then
            myshowmode(i).pausetime = 18
        ElseIf Val(MSFlexGrid1.TextMatrix(i + 1, 1)) < 0 Then
            myshowmode(i).pausetime = 0
        Else
            myshowmode(i).pausetime = Val(MSFlexGrid1.TextMatrix(i + 1, 1))
        End If
            MSFlexGrid1.TextMatrix(i + 1, 1) = myshowmode(i).pausetime
        If Val(MSFlexGrid1.TextMatrix(i + 1, 2)) > 8 Then
            myshowmode(i).dsmode = 8
        ElseIf Val(MSFlexGrid1.TextMatrix(i + 1, 2)) < 1 Then
            myshowmode(i).dsmode = 1
        Else
            myshowmode(i).dsmode = Val(MSFlexGrid1.TextMatrix(i + 1, 2))
        End If
            MSFlexGrid1.TextMatrix(i + 1, 2) = myshowmode(i).dsmode
        If Val(MSFlexGrid1.TextMatrix(i + 1, 3)) <> 0 Then
            myshowmode(i).dsclock = 1
          Else
            myshowmode(i).dsclock = 0
        End If
            MSFlexGrid1.TextMatrix(i + 1, 3) = myshowmode(i).dsclock
        Put #1, , myshowmode(i).fileName
        Put #1, , myshowmode(i).pausetime
        Put #1, , myshowmode(i).dsmode
        Put #1, , myshowmode(i).dsclock
    Next i
    Close #1
    Text1.Text = MSFlexGrid1.Text
End Sub
Private Sub 读数据()
    On Error Resume Next
    Open "data.txt" For Input As #1   ' 打开输入文件。
    njh = readone
    nwc = readone
    yjh = readone
    ywc = readone
    rjh = readone
    rwc = readone
    jp = readone
    If Not EOF(1) Then  ' 循环至文件尾。
        Input #1, error_inf ' 数据读入
    End If
    Close #1
    End Sub
Private Function readone()
    Dim Datastring, tmp
    If Not EOF(1) Then  ' 循环至文件尾。
asd:
        Input #1, Datastring  ' 数据读入
        On Error Resume Next
        tmp = CLng(Datastring)
        If Err.Number = 13 Then GoTo asd
        On Error GoTo 0
        If tmp < 100000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 10000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 1000 Then
            Datastring = " " & Datastring
        End If
        If tmp < 100 Then
            Datastring = " " & Datastring
        End If
         If tmp < 10 Then
            Datastring = " " & Datastring
        End If
       readone = Datastring
    End If
End Function
Private Sub tcpClient_Close()
    Print "close"
    tcpClient.Close
End Sub

Private Sub tcpClient_Connect()
    Print "Connect"
End Sub

Private Sub tcpClient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Print Description
End Sub

Private Sub tcpClient_SendComplete()
   ' tcpClient.Close
'Print "SendComplete"
End Sub