frm_main.frm

基于51和VB的广告牌控制系统

nHeight = 3 '小块的高度，即
Stripes = Picture1.Height / nHeight '总共的小块数目n个
P2 = nHeight
P1 = Picture1.Width
For i = 0 To Picture1.Height Step nHeight
p3 = i
r% = BitBlt(Me.pic_Viewport.hdc, 0, p3, P1, P2, Me.Picture1.hdc, 0, p3, &HCC0020)
For j = 1 To 800000   '　注释：‘等待片刻，图片从上到下出现的时间可以由此调节
Next
Next

Case 2:
pic_Viewport.Cls
nWidth = 3 '小块的宽度，即
Stripes = Picture1.Width / nWidth '总共的小块数目n个
P2 = Picture1.Height
P1 = nWidth
For i = Picture1.Width / 2 + nWidth To 0 Step -nWidth
p3 = i
p4 = Picture1.Width - i
r% = BitBlt(Me.pic_Viewport.hdc, p3, 0, P1, P2, Me.Picture1.hdc, p3, 0, &HCC0020)
r% = BitBlt(Me.pic_Viewport.hdc, p4, 0, P1, P2, Me.Picture1.hdc, p4, 0, &HCC0020)
For j = 1 To 800000 '等待片刻，图片开门效果出现的时间可以由此调节
Next
Next
       
Case 3:

pic_Viewport.Cls
nWidth = 3
mWidth = 18
Stripes = Picture1.Width / nWidth
P2 = Picture1.Height
P1 = nWidth
For j = 0 To mWidth Step nWidth
For i = 0 To Picture1.Width + nWidth Step mWidth
p3 = i + j
r% = BitBlt(Me.pic_Viewport.hdc, p3, 0, P1, P2, Me.Picture1.hdc, p3, 0, &HCC0020)
Next
For k = 1 To 8000000
Next
Next
  
Case 4:

Dim a(0 To 1000) As Integer
Dim B(0 To 400) As Integer
Dim S1, S2 As Integer
pic_Viewport.Cls

'注释: 产生随机数组
For i = 0 To 1000
a(i) = 0
Next
For i = 0 To 400
Loop1: k = Int(Rnd() * 1000) + 1
If Not (a(k) = 0) Then GoTo Loop1
a(k) = i
Next
For i = 0 To 1000
If Not (a(i) = 0) Then
B(V1) = a(i)
V1 = V1 + 1
End If
Next
'根据随机数组的值，拷贝小图片
S1 = Picture1.Width / 20
S2 = Picture1.Height / 20
For i = 0 To 400
k2 = B(i) Mod 20
k1 = ((Int(B(i)) - k2) / 20) * S2
k2 = k2 * S1
r% = BitBlt(pic_Viewport.hdc, k2, k1, S1 + 2, S2 + 2, Picture1.hdc, k2, k1, &HCC0020)
For j = 1 To 500000 '注释：wait
Next
Next

End Select

pic_Viewport.Picture = Picture1.Picture             '以上效果变化完后在快速设置一下pic_Viewport的图片

End Function


Private Sub ctrl_btn_Previous_Click()
js = js - 1
If js = 0 Then
js = zs
End If

Picture1.Picture = LoadPicture(App.Path + "\image\" & js & ".jpg")

Call picload


End Sub

Private Sub ctrl_ListObject_Click(Index As Integer)
Call caozuo(Index)
End Sub

Function caozuo(Index As Integer)
 Select Case Index
        Case 0:
           outbyte(1) = 200         '停止滚动
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
            
        Case 1:
           outbyte(1) = 201           '继续滚动
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
            
        Case 2:
           temp = 0
           temp = Int(Val(InputBox("请输入每张广告显示时间，" & "当前时间为：" & sjjg & "S", "修改时间", sjjg)))
           If temp >= 1 And temp <= 99 Then
           sjjg = temp
           
           outbyte(1) = sjjg           '1-99则为时间
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
           
           ElseIf temp <> 0 Then
           MsgBox "输入的时间必须大于等于1秒，小于等于99秒！", vbInformation, "错误"
           End If
          
        Case 3:
           temp = 0
           temp = Int(Val(InputBox("请输入要显示的广告数量（共有3张广告），" & "现显示" & zs & "张。", "修改广告数量", zs)))
           If temp >= 2 And temp <= 3 Then
           zs = temp
           
           outbyte(1) = zs + 150         '152、153则为广告张数分别表示2、3张
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
           
           MsgBox "广告数量修改成功，将在下一轮生效。", vbInformation, "成功"
           
           ElseIf temp <> 0 Then
           MsgBox "输入的数至少要2张，也不能超过3张！", vbInformation, "错误"
           End If
           
        Case 4:
                      
           outbyte(1) = 203         '上一张
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
           
           Me.ScaleMode = 3
           ctrl_btn_Previous_Click
           
        Case 5:
            
           outbyte(1) = 204         '下一张
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
            
           Me.ScaleMode = 3
           ctrl_btn_Next_Click
        Case 6:
           outbyte(1) = 202         '复位
           MSComm1.Output = outbyte
           MSComm1.OutBufferCount = 0       '清空缓存
           
        Case 7:
            End
    End Select

End Function

Private Sub ctrl_ListObject_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0:
            frm_Main.lbl_Statusbar.Caption = "广告停止滚动。"
        Case 1:
            frm_Main.lbl_Statusbar.Caption = "广告以一定时间间隔滚动。"
        Case 2:
            frm_Main.lbl_Statusbar.Caption = "设置广告显示时间。"
        Case 3:
            frm_Main.lbl_Statusbar.Caption = "设置广告总数量。"
        Case 4:
            frm_Main.lbl_Statusbar.Caption = "显示上一张广告。"
        Case 5:
            frm_Main.lbl_Statusbar.Caption = "显示下一张广告。"
        Case 6:
            frm_Main.lbl_Statusbar.Caption = "硬件电路复位。"
        Case 7:
            frm_Main.lbl_Statusbar.Caption = "退出应用程序。"
    End Select
End Sub

Private Sub ctrl_PullDownMenu_Click(Index As Integer)
Me.ScaleMode = 1
    Select Case Index
        Case 1:
            PopupMenu frm_Menu.ppm_Start, , frm_Main.ctrl_PullDownMenu.Left + frm_Main.ctrl_PullDownMenu.pSelectionLeft, frm_Main.ctrl_PullDownMenu.Top + frm_Main.ctrl_PullDownMenu.pSelectionBottom
        Case 2:
            PopupMenu frm_Menu.ppm_View, , frm_Main.ctrl_PullDownMenu.Left + frm_Main.ctrl_PullDownMenu.pSelectionLeft, frm_Main.ctrl_PullDownMenu.Top + frm_Main.ctrl_PullDownMenu.pSelectionBottom
        Case 3:
            PopupMenu frm_Menu.ppm_Skins, , frm_Main.ctrl_PullDownMenu.Left + frm_Main.ctrl_PullDownMenu.pSelectionLeft, frm_Main.ctrl_PullDownMenu.Top + frm_Main.ctrl_PullDownMenu.pSelectionBottom
        Case 4:
            PopupMenu frm_Menu.ppm_Tutorials, , frm_Main.ctrl_PullDownMenu.Left + frm_Main.ctrl_PullDownMenu.pSelectionLeft, frm_Main.ctrl_PullDownMenu.Top + frm_Main.ctrl_PullDownMenu.pSelectionBottom
        Case 5:
            PopupMenu frm_Menu.ppm_Help, , frm_Main.ctrl_PullDownMenu.Left + frm_Main.ctrl_PullDownMenu.pSelectionLeft, frm_Main.ctrl_PullDownMenu.Top + frm_Main.ctrl_PullDownMenu.pSelectionBottom
    End Select
    
Me.ScaleMode = 3

End Sub


Private Sub MSComm1_OnComm()

Dim aaa As Integer

    Select Case MSComm1.CommEvent
        Case comEvReceive
            inbyte = MSComm1.Input
            aaa = CInt(inbyte(0))
            If aaa >= 1 And aaa <= 99 Then
            sjjg = aaa
            ElseIf aaa >= 101 And aaa <= 103 Then
            js = aaa - 100
            Picture1.Picture = LoadPicture(App.Path + "\image\" & js & ".jpg")
            Call picload
            ElseIf aaa >= 152 And aaa <= 153 Then
            zs = aaa - 150
            End If
            MSComm1.InBufferCount = 0           '清空缓存
    End Select
End Sub


Private Sub Form_Load()
    ctrl_SkinableForm.SkinPath = App.Path + "\Skins\Titanium"
    Call Initialize
    
    '字体闪烁颜色数组
   color = Array(&HC0C0FF, &H8080FF, &HC0&, &HFF&, &HC0&, &H8080FF, &HC0C0FF, &HC0E0FF, &H80C0FF, &H40C0&, &H80FF&, &H40C0&, &H80C0FF, &HC0E0FF, &HC0FFFF, &H80FFFF, &HC0C0&, &HFFFF&, &HC0C0&, &H80FFFF, &HC0FFFF, &HC0FFC0, &H80FF80, &H80FF80, &HFF00&, &H80FF80, &H80FF80, &HC0FFC0)
   ci = 0
   
   js = 1
   zs = 3
   sjjg = 20
   
    MSComm1.PortOpen = True
    
    outbyte(1) = 255                 '向下位机获取当前参数
    MSComm1.Output = outbyte
    MSComm1.OutBufferCount = 0       '清空缓存
    
  
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    frm_Main.ctrl_btn_Previous.Refresh
    frm_Main.ctrl_btn_Next.Refresh
    frm_Main.ctrl_btn_dq.Refresh
End Sub

Private Sub Form_Resize()
    If pLastTransparencyPath <> "" Then
      Call frm_Main.ctrl_TransparetForm.ShapeForm(frm_Main, pLastTransparencyPath, True)
    End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

MSComm1.PortOpen = False

    Dim v_ctControl As Control
    
    For Each v_ctControl In frm_Main
        Set v_ctControl = Nothing
    Next v_ctControl
    End
End Sub

Private Sub Timer1_Timer()

Label1.ForeColor = color(ci)
ci = ci + 1

If ci = UBound(color) + 1 Then
ci = 0
End If
End Sub