信息.frm

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

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form send 
   Caption         =   "send"
   ClientHeight    =   6990
   ClientLeft      =   3630
   ClientTop       =   1350
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   ScaleHeight     =   6990
   ScaleWidth      =   4980
   Begin MSWinsockLib.Winsock tcpClient 
      Left            =   2880
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Caption         =   "显示屏通信方式"
      Height          =   1095
      Left            =   480
      TabIndex        =   9
      Top             =   3000
      Width           =   3255
      Begin VB.OptionButton Option2 
         Caption         =   "Option2"
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   600
         Width           =   1095
      End
      Begin VB.OptionButton Option1 
         Caption         =   "Option1"
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1920
      TabIndex        =   7
      Text            =   "Text2"
      Top             =   0
      Width           =   495
   End
   Begin VB.CheckBox Check1 
      Caption         =   "联机工作"
      Height          =   375
      Left            =   2520
      TabIndex        =   6
      Top             =   600
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   5000
      Left            =   4800
      Top             =   3000
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      Height          =   270
      Left            =   5040
      TabIndex        =   4
      Top             =   2400
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1815
      Left            =   120
      ScaleHeight     =   1815
      ScaleWidth      =   3855
      TabIndex        =   2
      Top             =   4440
      Width           =   3855
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   1815
      Left            =   0
      TabIndex        =   3
      Top             =   1080
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   3201
      _Version        =   393216
      Cols            =   4
      FormatString    =   """<文件名 |<停留时间|<显示方式|<时间显示"""
   End
   Begin VB.CommandButton sendst 
      Caption         =   "传送保存"
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   600
      Width           =   975
   End
   Begin VB.CommandButton timeset 
      Caption         =   "时间调整"
      Height          =   375
      Left            =   1080
      TabIndex        =   0
      Top             =   600
      Width           =   975
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4800
      Top             =   360
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      OutBufferSize   =   5120
      BaudRate        =   2400
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   375
      Left            =   1320
      TabIndex        =   8
      Top             =   0
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1695
      Left            =   120
      TabIndex        =   5
      Top             =   4560
      Width           =   3975
   End
End
Attribute VB_Name = "send"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type SHOWMODE
    fileName As String
    pausetime As Byte
    dsmode As Byte
    dsclock As Byte
End Type
Dim show_max As Long
Dim show_current As Long
Dim myshowmode(50) As SHOWMODE
Const IP1 = "192.168.0.101"
Const PORT = 1000
Private Type BITMAPFILEHEADER
        bftype As Integer
        bfsize As Long
        bfreserved1 As Integer
        bfreserved2 As Integer
        bfoffbits As Long
    End Type
    
    Private Type BITMAPINFOHEADER
        bisize As Long
        biwidth As Long
        biheight As Long
        biplanes As Integer
        bibitcount As Integer
        bicompress As Long
        bisizeimage As Long
        bixpeispermeter As Long
        biypeispermeter As Long
        bicirused As Long
        bicirimprotant As Long
    End Type
Dim OutString As String
Dim outbytes() As Byte
Dim njh, nwc, yjh, ywc, rjh, rwc, jp, error_inf

'Dim OutString As String *10

Private Sub Check1_Click()
If Check1.VALUE = 1 Then
    Timer1.Enabled = True
Else
    Timer1.Enabled = False
End If
End Sub

Private Sub sendst_Click()
Dim i
    Timer1.Enabled = False
    Check1.VALUE = 0
    On Error Resume Next
    If tcpClient.State <> sckClosed Then _
    tcpClient.Close
    tcpClient.Connect IP1, PORT
    Dim EndTime As Date
    EndTime = DateAdd("s", 4, Now)
    Do Until Now > EndTime Or tcpClient.State = sckConnected
    DoEvents
    Loop
    写设置
    For i = 0 To show_max - 1
        Call sendbmp(myshowmode(i).fileName, i + 1)
    Next i
    OutString = "CTL"
    tcpClient.SendData OutString
'    MSComm1.Output = OutString
    ReDim outbytes(show_max * 4 - 1)
    For i = 0 To show_max - 1
        outbytes(4 * i) = myshowmode(i).dsmode + 99
        outbytes(4 * i + 1) = i + 1
        outbytes(4 * i + 2) = myshowmode(i).dsclock + 100
        outbytes(4 * i + 3) = myshowmode(i).pausetime * 14
      Next i
    tcpClient.SendData outbytes
'    MSComm1.Output = outbytes
    OutString = Chr(255)
    tcpClient.SendData OutString
'    MSComm1.Output = OutString

End Sub

Private Sub fontsend_Click()
    Dim i, j As Long
    Timer1.Enabled = False
    Check1.VALUE = 0
  '  On Error GoTo ErrorHandler   ' 打开错误处理程序。
  '  Open "asc16" For Binary Access Read As #1
  '  On Error GoTo 0   ' 关闭错误陷阱。
  '  If LOF(1) = 0 Then
  '      MsgBox "ASC16 open error."
  '      Exit Sub
  '  End If
  '  Const ASCLINE = 128
  '  ReDim outbytes(ASCLINE - 1)
  '  OutString = "ASC"
  '  MSComm1.Output = OutString
  '  Label1.Visible = True
  '  For j = 0 To LOF(1) \ ASCLINE
  '      For i = 0 To ASCLINE - 1
  '          Get #1, , outbytes(i)
  '      Next i
  '      DoEvents
  '      Label1.Caption = "正在传送英文字库 请稍等" + Chr(13) + "大约需10秒钟 已传送" + CStr(CInt(j * 100 * ASCLINE / LOF(1))) + "%"
  '      MSComm1.Output = outbytes
  '  Next j
  ' Close #1
  
    On Error GoTo ErrorHandler   ' 打开错误处理程序。
    Open "hzk16" For Binary Access Read As #1
    On Error GoTo 0   ' 关闭错误陷阱。
    If LOF(1) = 0 Then
        MsgBox "HZK16 open error."
        Exit Sub
    End If
    Const HZKLINE = 2000
    ReDim outbytes(HZKLINE - 1)
    OutString = "HZK"
    MSComm1.Output = OutString
    For j = 0 To LOF(1) \ HZKLINE
        For i = 0 To HZKLINE - 1
            Get #1, , outbytes(i)
        Next i
        DoEvents
        Label1.Caption = "正在传送汉字库 请稍等" + Chr(13) + "大约需10分钟 已传送" + CStr(CInt(j * 100 * HZKLINE / LOF(1))) + "%"
        MSComm1.Output = outbytes
    Next j
    Close #1
    Label1.Visible = False
    Exit Sub      ' 退出程序，以避免进入错误处理程序。
ErrorHandler:           ' 错误处理程序。
   Select Case Err.Number   ' 检查错误代号。
      Case 53   ' 发生“文件打不开”的错误。
      MsgBox "asc16 open error."
'      Err.Clear   ' 清除 Err 对象字段。
       Case Else
        ' 处理其他错误状态 . . .
   End Select
End Sub

Private Sub Form_Load()
   ' 使用 COM1。
   MSComm1.CommPort = 1
   ' 9600 波特，无奇偶校验，8 位数据，一个停止位。
'   MSComm1.Settings = "9600,N,8,1"
   ' 当输入占用时，
   ' 告诉控件读入整个缓冲区。
'   MSComm1.InputLen = 0
   ' 打开端口。
    Check1.VALUE = 1
    Label1.Visible = False
    MSComm1.PortOpen = True
    Picture1.AutoSize = False
    Picture1.Visible = False
    MSFlexGrid1.FixedCols = 0
    MSFlexGrid1.FormatString = "<文件名 |<停留时间|<显示方式|<时间显示"
    MSFlexGrid1.ColWidth(0) = MSFlexGrid1.width * 0.35
    MSFlexGrid1.ColWidth(1) = MSFlexGrid1.width * 0.2
    MSFlexGrid1.ColWidth(2) = MSFlexGrid1.width * 0.2
    MSFlexGrid1.ColWidth(3) = MSFlexGrid1.width * 0.2
    读设置
'MSFlexGrid1.CellBackColor = QBColor(Rnd * 15)
'MSFlexGrid1.Cols = 5  ' 设置总行数和列数。
'MSFlexGrid1.Row = 0  ' 设置当前行数和列数。
'MSFlexGrid1.Col = 0
'MSFlexGrid1.Text = "文件名"
'MSFlexGrid1.FillStyle = flexFillRepeat
'MSFlexGrid1.AllowUserResizing = flexResizeBoth
' MSFlexGrid1.AddItem ("asd   qwe azx 123")
End Sub
Private Sub Form_Terminate()
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
End If
End Sub

Sub ShowTextBox()
    With MSFlexGrid1

         '隐藏文本框，设置高度和宽度
         Text1.Visible = False
         Text1.height = .RowHeight(.Row) - (Screen.TwipsPerPixelY) * 2
         Text1.width = .ColWidth(.Col) - (Screen.TwipsPerPixelX) * 5
        ' 计算文本框左坐标
         Text1.Left = .CellLeft + .Left + (Screen.TwipsPerPixelX) * 3
         Text1.Top = .CellTop + .Top + (Screen.TwipsPerPixelY) * 1
         Text1.Visible = True
         Text1.SetFocus
    End With
End Sub


Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
    Dim char As String
    If KeyAscii = 13 Then
        Text1.Text = MSFlexGrid1.Text
        Text1.SelStart = Len(Text1.Text)
    Else