virtualdevice.ctl

简单的操作系统程序

VERSION 5.00
Begin VB.UserControl VirtualDevice 
   ClientHeight    =   855
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1215
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   57
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   81
   ToolboxBitmap   =   "VirtualDevice.ctx":0000
   Begin VB.Timer Timer 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   180
      Top             =   135
   End
End
Attribute VB_Name = "VirtualDevice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'Default Property Values:
Const m_def_DeviceStyle = 0
Const m_def_DeviceState = False
Const m_def_Runtime = 0
'Property Variables:
Dim m_DeviceState As Boolean
Public Enum Styles
    Printer = 0
    Taper = 1
    Faxs = 2
End Enum
Dim m_DeviceStyle As Styles
Dim m_Runtime As Integer
Dim OldTime As Long
'属性变量:
Dim m_IRQ As Byte

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function setHigh Lib "bitChng" (ByVal sources As Byte, ByVal irQ As Byte) As Byte 'A|B
Private Declare Function setLow Lib "bitChng" (ByVal sources As Byte, ByVal irQ As Byte) As Byte 'A&(~B)
Private Declare Function setHigh2 Lib "bitChng" (ByVal sources As Integer, ByVal irQ As Integer) As Integer 'A|B
Private Declare Function setLow2 Lib "bitChng" (ByVal sources As Integer, ByVal irQ As Integer) As Integer 'A&(~B)
Private Declare Function setHigh4 Lib "bitChng" (ByVal sources As Long, ByVal irQ As Long) As Long 'A|B
Private Declare Function setLow4 Lib "bitChng" (ByVal sources As Long, ByVal irQ As Long) As Long 'A&(~B)

'Private WithEvents Bus As BusClass
Private Bus As BusClass
Private WithEvents Timm As clsXTimer
Attribute Timm.VB_VarHelpID = -1

'Event Declarations:
Event Timeover()
'缺省属性值:
Const m_def_IRQ = 1
'
Private timUnLock As Boolean

Private Sub letRuntime(ByVal New_Runtime As Integer)
    If Ambient.UserMode = False Then Err.Raise 387
    If New_Runtime > 0 Then
        m_Runtime = New_Runtime - 1
    Else
        m_Runtime = 0
    End If
    PropertyChanged "Runtime"
End Sub

Private Sub timm_Tick()
    Timm.Enabled = False
    If timUnLock Then
        timUnLock = False
        Dim Ctrl12_8 As Integer
        'Dim Ctrl6_5 As Byte
        Ctrl12_8 = setLow2(Bus.ControlBus, &HE0FF)
        'Ctrl6_5 = setLow2(Bus.ControlBus, 159)
        If Ctrl12_8 = (m_IRQ * 256) And Timer.Enabled = False Then
            'If  Then 'run
                Bus.ControlBus = setLow2(Bus.ControlBus, m_IRQ * 256)
                Call letRuntime(Bus.DataBus) 'setLow2(Bus.ControlBus, &HFF00))
                Call RunDevice
            'End If
            'If Ctrl6_5 = 2 And Timer.Enabled = True Then 'stop
            '    Call StopDevice
            'End If
        End If
        timUnLock = True
    End If
    Timm.Enabled = True
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub RunDevice() 'Optional ByVal Funcname As Long)
    If m_DeviceState = False Then
        m_DeviceState = True
        Timer.Enabled = True
        Select Case m_DeviceStyle
            Case 0
                inPrinter
            Case 1
                inTaper
            Case 2
                inFax
        End Select
        Timm.Enabled = False
    End If
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub StopDevice()
    If m_DeviceState = True Then
        Timer.Enabled = False
        m_DeviceState = False
        Bus.ControlBus = setHigh2(Bus.ControlBus, m_IRQ)
        Select Case m_DeviceStyle
            Case 0
                inPrinter
            Case 1
                inTaper
            Case 2
                inFax
        End Select
        Timm.Enabled = True
    End If
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,2,0
Public Property Get Runtime() As Integer
Attribute Runtime.VB_MemberFlags = "400"
    Runtime = m_Runtime
End Property

Public Property Let Runtime(ByVal New_Runtime As Integer)
    If Ambient.UserMode = False Then Err.Raise 387
    If New_Runtime > 0 Then
        m_Runtime = New_Runtime - 1
    Else
        m_Runtime = 0
    End If
    PropertyChanged "Runtime"
End Property

Private Sub Timer_Timer()
    Dim temp As Long
    temp = CLng(GetTickCount / 100)
    If OldTime = temp Then
        'm_Runtime = m_Runtime - 1
        If m_Runtime Then
            m_Runtime = m_Runtime - 1
        Else
            StopDevice
            RaiseEvent Timeover
        End If
    Else
        OldTime = temp
    End If
End Sub

Private Sub UserControl_Initialize()
    inPrinter
    Set Bus = New BusClass
    Set Timm = New clsXTimer
    Timm.Interval = 1
    Timm.Enabled = True
    timUnLock = True
End Sub

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Runtime = m_def_Runtime
    m_DeviceStyle = m_def_DeviceStyle
    m_DeviceState = m_def_DeviceState
'    m_Timeover = m_def_Timeover
    m_IRQ = m_def_IRQ
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Runtime = PropBag.ReadProperty("Runtime", m_def_Runtime)
    m_DeviceStyle = PropBag.ReadProperty("DeviceStyle", m_def_DeviceStyle)
    m_DeviceState = PropBag.ReadProperty("DeviceState", m_def_DeviceState)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
'    m_Timeover = PropBag.ReadProperty("Timeover", m_def_Timeover)
    m_IRQ = PropBag.ReadProperty("IRQ", m_def_IRQ)
End Sub

Private Sub UserControl_Resize()
    Select Case m_DeviceStyle
        Case 0
            ShowPrinter
        Case 1
            ShowTaper
        Case 2
            ShowFax
    End Select
End Sub

Private Sub UserControl_Terminate()
    Timm.Enabled = False
    Set Bus = Nothing
    Set Timm = Nothing
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Runtime", m_Runtime, m_def_Runtime)
    Call PropBag.WriteProperty("DeviceStyle", m_DeviceStyle, m_def_DeviceStyle)
    Call PropBag.WriteProperty("DeviceState", m_DeviceState, m_def_DeviceState)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
'    Call PropBag.WriteProperty("Timeover", m_Timeover, m_def_Timeover)
    Call PropBag.WriteProperty("IRQ", m_IRQ, m_def_IRQ)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,1,0,0
Public Property Get DeviceStyle() As Styles
    DeviceStyle = m_DeviceStyle
End Property

Public Property Let DeviceStyle(ByVal New_DeviceStyle As Styles)
    If Ambient.UserMode Then Err.Raise 382
    m_DeviceStyle = New_DeviceStyle
    Select Case m_DeviceStyle
        Case 0
            inPrinter
        Case 1
            inTaper
        Case 2
            inFax
    End Select
    PropertyChanged "DeviceStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,1,2,false
Public Property Get DeviceState() As Boolean
Attribute DeviceState.VB_Description = "It is busy?"
Attribute DeviceState.VB_MemberFlags = "400"
    DeviceState = m_DeviceState
End Property

Public Property Let DeviceState(ByVal New_DeviceState As Boolean)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_DeviceState = New_DeviceState
    PropertyChanged "DeviceState"
End Property

Private Sub ShowPrinter()
    UserControl.Width = 64 * 15
    UserControl.Height = 64 * 15
End Sub

Private Sub ShowTaper()
    UserControl.Width = 64 * 15
    UserControl.Height = 64 * 15
End Sub

Private Sub ShowFax()
    UserControl.Width = 64 * 15
    UserControl.Height = 64 * 15
End Sub

Private Sub inPrinter()
    'ShowPrinter
    If m_DeviceState Then
        Set UserControl.Picture = LoadResPicture(104, 0)
    Else
        Set UserControl.Picture = LoadResPicture(103, 0)
    End If
End Sub

Private Sub inTaper()
    'ShowTaper
    If m_DeviceState Then
        Set UserControl.Picture = LoadResPicture(106, 0)
    Else
        Set UserControl.Picture = LoadResPicture(105, 0)
    End If
End Sub

Private Sub inFax()
    'ShowFax
    If m_DeviceState Then
        Set UserControl.Picture = LoadResPicture(102, 0)
    Else
        Set UserControl.Picture = LoadResPicture(101, 0)
    End If
End Sub
'
''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MemberInfo=0,1,2,0
'Public Property Get Timeover() As Boolean
'    Timeover = m_Timeover
'End Property
'
'Public Property Let Timeover(ByVal New_Timeover As Boolean)
'    If Ambient.UserMode = False Then Err.Raise 387
'    If Ambient.UserMode Then Err.Raise 382
'    m_Timeover = New_Timeover
'    PropertyChanged "Timeover"
'End Property
'
'注意！不要删除或修改下列被注释的行！
'MemberInfo=1,0,0,0
Public Property Get irQ() As Byte
    irQ = m_IRQ
End Property

Public Property Let irQ(ByVal New_IRQ As Byte)
    m_IRQ = New_IRQ
    PropertyChanged "IRQ"
End Property