form11.frm

根据数据库发送条屏数据.根据呼叫发送特定的信息.

         Text            =   "01 2210"
         Top             =   2640
         Width           =   1815
      End
      Begin VB.TextBox T_pd 
         Height          =   375
         Index           =   4
         Left            =   480
         TabIndex        =   11
         Text            =   "01 2210"
         Top             =   2160
         Width           =   1815
      End
      Begin VB.TextBox T_pd 
         Height          =   375
         Index           =   3
         Left            =   480
         TabIndex        =   10
         Text            =   "01 2210"
         Top             =   1680
         Width           =   1815
      End
      Begin VB.TextBox T_pd 
         Height          =   375
         Index           =   2
         Left            =   480
         TabIndex        =   9
         Text            =   "01 2210"
         Top             =   1200
         Width           =   1815
      End
      Begin VB.TextBox T_pd 
         Height          =   375
         Index           =   1
         Left            =   480
         TabIndex        =   8
         Text            =   "01 2210"
         Top             =   720
         Width           =   1815
      End
      Begin VB.TextBox T_pd 
         Height          =   375
         Index           =   0
         Left            =   480
         TabIndex        =   7
         Text            =   "01 2210"
         Top             =   240
         Width           =   1815
      End
   End
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   3120
      Top             =   120
   End
   Begin VB.PictureBox Pict 
      BackColor       =   &H00404040&
      BorderStyle     =   0  'None
      Height          =   1065
      Left            =   0
      ScaleHeight     =   1065
      ScaleWidth      =   2985
      TabIndex        =   3
      Top             =   0
      Width           =   2985
      Begin VB.Label labyw 
         BackColor       =   &H00404040&
         Caption         =   "00 号窗口 "
         ForeColor       =   &H00C0FFFF&
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   120
         Width           =   2655
      End
      Begin VB.Label Labjh 
         BackColor       =   &H00404040&
         Caption         =   "请0000号办理业务"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   18
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H008080FF&
         Height          =   495
         Left            =   0
         TabIndex        =   4
         Top             =   480
         Width           =   2895
      End
   End
   Begin VB.CommandButton BtnReset 
      Caption         =   "复位控制卡"
      Height          =   375
      Left            =   3960
      TabIndex        =   2
      Top             =   1080
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton BtnSendText 
      Caption         =   "发送文字"
      Height          =   375
      Left            =   3960
      TabIndex        =   1
      Top             =   720
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton BtnSendPicture 
      Caption         =   "显示图片"
      Height          =   375
      Left            =   3960
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
   Begin VB.PictureBox CL20051 
      Height          =   480
      Left            =   1320
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   40
      Top             =   1800
      Width           =   1200
   End
   Begin VB.Label Label3 
      Caption         =   "宏扬软件v3.01"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   6.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2640
      TabIndex        =   41
      Top             =   1200
      Width           =   975
   End
   Begin CL2005OCXLib.CL2005Ocx CL2005 
      Left            =   2880
      Top             =   2040
      _Version        =   65536
      _ExtentX        =   1720
      _ExtentY        =   661
      _StockProps     =   0
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   495
      Left            =   5640
      TabIndex        =   39
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Index           =   1
      Left            =   6600
      TabIndex        =   24
      Top             =   1080
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Index           =   0
      Left            =   6600
      TabIndex        =   23
      Top             =   600
      Width           =   1455
   End
   Begin VB.Label ts 
      Height          =   255
      Left            =   0
      TabIndex        =   21
      Top             =   1080
      Width           =   2295
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const CardType = 1          '控制卡类型,1型卡
Const ComPort = 1           '串口1
Const ComBaudRate = 38400   '通讯速率
Const ComDelay = 1500       '延时
Const LedNum = 0            '屏号
Const LedWidth = 192        '屏宽
Const LedHeight = 64       '屏高
Const LedColor = 1         '双色屏
Public ckh As String
Public gkh As String
Public cn As String
Public comp As String
Public btfont As String
Public nrfont As String
Public cpsd As Integer
Public cpfs As Integer
Public tlsj As Integer
Public tcfs As Integer

'窗口号显示内容
Public ck1, ck2, ck3, ck4, ck5, ck6, ck7, ck8, ck9, ck10, ck11, ck12, ck13, ck14, ck15, ck16, ck17, ck18, ck19, ck20, ck21, ck22, ck23, ck24, ck25, ck26, ck27, ck28 As String

'
' 图片数据结构,注意 VB 语言中,数组下标前一个是列,后一个是行。
' CL2005系列控制系统最大控制范围宽度为2048,每个字节表示8个点,需要256个字节,所以第一下标从0到255。
' CL2005系列控制卡最大控制范围高度为512行,第2下标直接写0到511
Dim PictBuf(0 To 255, 0 To 511) As Byte
'
' 节目表数据结构,
Private Type ProgStruct
    PictIndex   As Byte
    Enter       As Byte
    Leave       As Byte
    Speed       As Byte
    StayTime    As Byte
    bFollowFlag As Byte
    bShowTimer  As Byte
    bTimerPlay  As Byte
    TimerMode   As Byte
    WeekFlag    As Byte
    StartHour   As Byte
    StartMinute As Byte
    EndHour     As Byte
    EndMinute   As Byte
    NotUsed0    As Byte
    NotUsed1    As Byte
End Type
'
' 通用图片整理程序截取到图片数据缓冲区
' 用户若需要调用该程序,需要事先定义图片变量 Pict 和数据缓冲区变量 PicBuf
' Pict       : 图片,可以更换成Bmp
' Buff       : 图片缓冲区
' PictWidth  : 图片宽度
' PictHeight : 图片高度
' Width      : 显示屏宽度
' Height     : 显示屏高度
Private Sub PictToBuff(ByRef PictDc As PictureBox, PictWidth As Integer, PictHeight As Integer, xWidth As Integer, xHeight As Integer, Color As Integer)
Dim x As Integer, y As Integer, z As Integer, EndX As Integer, EndY As Integer
Dim vC As Long
Dim v As Byte, xv As Byte
Dim ROLE(0 To 9) As Byte
Dim xx As Integer
    ROLE(0) = &H80: ROLE(1) = &H40: ROLE(2) = &H20: ROLE(3) = &H10
    ROLE(4) = &H8: ROLE(5) = &H4: ROLE(6) = &H2: ROLE(7) = &H1
    '
    ' 清除图片缓冲区
    For y = 0 To 511 Step 1
        For x = 0 To 255 Step 1
            PictBuf(x, y) = 0
        Next x
    Next y
    '
    ' 根据图片和屏体的宽高决定截取图片的宽高,保证数据不越界
    If PictWidth >= xWidth Then EndX = xWidth Else EndX = PictWidth
    If PictHeight >= xHeight Then EndY = xHeight Else EndY = PictHeight
    '
    ' 遍历高度和宽度
    ' 先截取红色
    xx = (EndX + 7) \ 8 - 1
    For y = 0 To EndY - 1 Step 1
        For x = 0 To xx Step 1
            v = 0
            For z = 0 To 7 Step 1
                vC = PictDc.Point((x * 8 + z) * 15, y * 15)
                If (vC Mod 256) > 128 Then v = v + ROLE(z)
            Next z
            PictBuf(x, y) = v
        Next x
    Next y
    ' 双色屏则再截取绿色
    If Color <> 0 Then
        For y = 0 To EndY - 1 Step 1
            For x = 0 To xx Step 1
                v = 0
                For z = 0 To 7 Step 1
                    vC = PictDc.Point((x * 8 + z) * 15, y * 15)
                    If ((vC \ 256) Mod 256) > 128 Then v = v + ROLE(z)
                Next z
               PictBuf(x, y + xHeight) = v
            Next x
        Next y
    End If
End Sub
'
' 通用文本整理程序
' VB 的字符串全是16位代码,控件要求使用8位ASCII码,因此需要用下面的程序
' 将16位字符串整理为8位的ASCII码串,并且整理成 C 语言的以0结束的格式
Private Sub StringToByte(ByRef S As String, ByRef ByteBuf() As Byte)
Dim i As Integer
Dim j As Integer
Dim v As Integer
Dim xv As Integer
Dim Lv As Long
    j = 0
    For i = 0 To Len(S) - 1
        v = Asc(Mid(S, i + 1, 1))           '取一个16位字符
        If v > 0 Then                       '普通字符
            ByteBuf(j) = v
            j = j + 1
        Else                                '小于0则为中文字,实际是大于等于32768
            Lv = 65536 + v
            xv = Lv \ 256
            ByteBuf(j) = xv
            j = j + 1
            xv = Lv Mod 256
            ByteBuf(j) = xv
            j = j + 1
        End If
    Next i
    ByteBuf(j) = 0                          'CL2005Ocx 控件是C语言编写的,字符串必须以0结尾
End Sub

Private Sub BtnReset_Click()
Dim bOK As Boolean
    bOK = CL2005.ComInitial(ComPort, ComBaudRate, ComDelay)
    If bOK Then bOK = CL2005.SetLEDProperty(CardType, LedNum, LedWidth, LedHeight, LedColor, 0)
    If bOK Then bOK = CL2005.Reset
    CL2005.CloseCL2005
    If bOK Then
        bOK = MsgBox("发送成功", vbOKOnly, "复位控制卡")
    Else
        bOK = MsgBox("发送失败", vbOKOnly, "复位控制卡")
    End If
End Sub

Private Sub BtnSendPicture_Click()
Dim bOK As Boolean
Dim ProgList(0 To 9) As ProgStruct