form1.frm

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

            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.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
   Begin CL2005OCXLib.CL2005Ocx CL2005 
      Left            =   240
      Top             =   2400
      _Version        =   65536
      _ExtentX        =   450
      _ExtentY        =   450
      _StockProps     =   0
   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

'
' 图片数据结构,注意 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
Dim w As Integer, h As Integer
    w = (Pict.Width + 14) \ 15
    h = (Pict.Height + 14) \ 15
    Call PictToBuff(Pict, w, h, LedWidth, LedHeight, LedColor)
    bOK = CL2005.ComInitial(comp, ComBaudRate, ComDelay)
    If bOK Then bOK = CL2005.SetLEDProperty(CardType, CInt(ckh) - 1, LedWidth, LedHeight, LedColor, 0)
    If bOK Then bOK = CL2005.SendPicture(0, VarPtr(PictBuf(0, 0)))
    ProgList(0).PictIndex = 0       ' 图片0的播放属性
    ProgList(0).Enter = cpfs      ' 进入方式3
    ProgList(0).Leave = tcfs           ' 退出方式0
    ProgList(0).Speed = cpsd          ' 进入速度
    ProgList(0).StayTime = tlsh        ' 停留时间
    ProgList(0).bFollowFlag = 0     ' 非紧随模式
    ProgList(0).bShowTimer = 0      ' 非整页时钟项
    ProgList(0).TimerMode = 0       ' 不显示日期时间
    ProgList(0).bTimerPlay = 0      ' 非定时播放项
    If bOK Then bOK = CL2005.SendProgList(1, VarPtr(ProgList(0).PictIndex))
    CL2005.CloseCL2005
    If bOK Then
       ' bOK = MsgBox("发送成功", vbOKOnly, "发送图片")
       ts.Caption = "发送成功"
       
    Else
    ts.Caption = "发送失败"
        'bOK = MsgBox("发送失败", vbOKOnly, "发送图片")
    End If
End Sub


Private Sub BtnSendText_Click()
Dim S As String
Dim TxtBuf(0 To 1023) As Byte
Dim bOK As Boolean
    S = "qing 2232323"
    Call StringToByte(S, TxtBuf)
    bOK = CL2005.ComInitial(ComPort, ComBaudRate, ComDelay)
    If bOK Then bOK = CL2005.SetLEDProperty(CardType, LedNum, LedWidth, LedHeight, LedColor, 0)
    If bOK Then bOK = CL2005.ShowString(0, LedWidth - 3 * 16 - 1, 0, 1, VarPtr(TxtBuf(0)))
    If bOK Then bOK = CL2005.SwitchToBank(0)
    CL2005.CloseCL2005
    If bOK Then
        bOK = MsgBox("发送成功", vbOKOnly, "显示文字")
    Else
        bOK = MsgBox("发送失败", vbOKOnly, "显示文字")
    End If
End Sub

Private Sub Image2_Click()

End Sub

Private Sub Image5_Click()

End Sub







Private Sub Form_Load()
Dim ret As Long
Dim buff As String

'Dim buff As String
buff = String(320, 0)
ret = GetPrivateProfileString("HY", "comp", "comp", buff, 320, App.Path & "\config.ini")
comp = CInt(buff)

buff = String(320, 0)
ret = GetPrivateProfileString("HY", "btfont", "btfont", buff, 320, App.Path & "\config.ini")
btfont = buff


'Dim buff As String
buff = String(320, 0)
ret = GetPrivateProfileString("HY", "nrfont", "nrfont", buff, 320, App.Path & "\config.ini")


nrfont = CInt(buff)


'Dim buff As String
buff = String(320, 0)
ret = GetPrivateProfileString("HY", "cn", "cn", buff, 320, App.Path & "\config.ini")


cn = buff

buff = String(320, 0)
ret = GetPrivateProfileString("HY", "cpfs", "cpfs", buff, 320, App.Path & "\config.ini")
cpfs = CInt(buff)

buff = String(320, 0)
ret = GetPrivateProfileString("HY", "cpsd", "cpsd", buff, 320, App.Path & "\config.ini")
cpsd = CInt(buff)

buff = String(320, 0)
ret = GetPrivateProfileString("HY", "tlsj", "tlsj", buff, 320, App.Path & "\config.ini")
tlsj = CInt(buff)

buff = String(320, 0)
ret = GetPrivateProfileString("HY", "tcfs", "tcfs", buff, 320, App.Path & "\config.ini")
tcfs = CInt(buff)

Dim rtn
  rtn = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 3)
  
  Labjh.FontSize = CInt(nrfont)
  labyw.FontSize = CInt(btfont)
  
  

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
End
End If

End Sub

Private Sub I4_Click()

End Sub


Private Sub T_pd_Change(Index As Integer)

gkh = Format(Mid(T_pd.Item(Index).Text, 4, 4), "0000")
ckh = Format(Mid(T_pd.Item(Index).Text, 1, 2), "00")
labyw.Caption = ckh & "号窗口"
Labjh.Caption = "请" & gkh & "号办理业务"
'sleep (100)

Timer2.Enabled = True

'BtnSendPicture_Click

End Sub

Private Sub Timer1_Timer()

Dim sql_a As String
Dim i As Integer
Dim a1, a2 As String

'cn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\Program Files\平安排队管理系统\ChinaQueue.mdb;Persist Security Info=False"


sql_a = "SELECT counterNo AS 柜台号码, countername AS 柜台名称, customerNo AS 顾客号码, CustomerStatus AS 状态, customermemo AS 业务名称 FROM counters AS A, bussiness AS B Where a.currentcustomerID = b.serialcode order by b.starttime" ' desc"

Adodc1.ConnectionString = cn
Adodc1.RecordSource = sql_a
Adodc1.Refresh


Do While Not Adodc1.Recordset.EOF

If Adodc1.Recordset.Fields!柜台号码 < 10 Then
a1 = "0" & CStr(Adodc1.Recordset.Fields!柜台号码)
Else
a1 = CStr(Adodc1.Recordset.Fields!柜台号码)
End If

a2 = Adodc1.Recordset.Fields!顾客号码

T_pd.Item(i).Text = a1 & " " & a2
Adodc1.Recordset.MoveNext

i = i + 1



Loop




End Sub

Private Sub Timer2_Timer()
Static n As Integer
If n = 1 Then
n = 0

BtnSendPicture_Click
Timer2.Enabled = False
End If
n = n + 1

'BtnSendPicture_Click
End Sub