?? form1.frm
字號:
TabIndex = 60
Top = 2520
Width = 135
End
Begin VB.Label Label14
Caption = "A S C I I"
Height = 255
Left = -69720
TabIndex = 53
Top = 840
Width = 1335
End
Begin VB.Label Label13
Caption = "H E X A D E C I M A L"
Height = 255
Left = -72900
TabIndex = 52
Top = 840
Width = 1935
End
Begin VB.Label Label12
Caption = "Addr(hex)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -74640
TabIndex = 51
Top = 840
Width = 1095
End
Begin VB.Label Label8
Caption = "IRQ :"
Height = 255
Left = 1440
TabIndex = 14
Top = 1260
Width = 855
End
Begin VB.Label L_IRQ
AutoSize = -1 'True
Caption = "10"
Height = 195
Left = 2400
TabIndex = 12
Top = 1260
Width = 180
End
Begin VB.Label L_Han
AutoSize = -1 'True
Caption = "XX"
Height = 195
Left = 2400
TabIndex = 6
Top = 2340
Width = 210
End
Begin VB.Label L_Gen
AutoSize = -1 'True
Caption = "XX"
Height = 195
Left = 2400
TabIndex = 5
Top = 1860
Width = 210
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Handled:"
Height = 255
Index = 1
Left = 1440
TabIndex = 4
Top = 2340
Width = 735
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Generated:"
Height = 255
Index = 1
Left = 1440
TabIndex = 3
Top = 1860
Width = 855
End
End
Begin VB.Timer Timer1
Interval = 200
Left = 7440
Top = 3660
End
Begin VB.CommandButton Close_Driver
Caption = "Close_Driver"
Height = 495
Left = 7440
TabIndex = 1
Top = 2880
Width = 1935
End
Begin VB.CommandButton Open_Driver
Caption = "Open_Driver"
Height = 495
Left = 7440
TabIndex = 0
Top = 2160
Width = 1935
End
Begin TVICHW32Lib.TVicHW32 HwCtrl
Left = 8160
Top = 3600
_Version = 65536
_ExtentX = 873
_ExtentY = 873
_StockProps = 0
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Rem =======================================================
Rem ===== Test example for TVicHW32.OCX v.3.0 =====
Rem =======================================================
Rem == Copyright(c) 1998 Victor Ishikeev (ivi@ufanet.ru) ==
Rem =======================================================
Dim WChecks(17), NumSymbol As Integer
Dim Flag_Intr As Long
Dim FlagPrint As Boolean
Dim IRQCounter As Long
Dim PhysAddr As Long
Dim MappedAddr As Long
Dim IRQ As Integer
Dim Sum_Ticks As Long
Dim CurrTicker As Long
Dim OldTicker As Long
Dim Flag_Tim As Long
Dim Scan_Code As Byte
Dim Data_Reg As Byte
Dim Status_Reg As Byte
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub ShowButtons()
Dim nPin As Integer
B_SetMemory.Enabled = HwCtrl.ActiveHW And (MappedAddr = 0)
If Not HwCtrl.ActiveHW Then B_Unmask.Value = 0
SpinLPT.Enabled = HwCtrl.ActiveHW
SpinLPT.Max = HwCtrl.LPTNumPorts
L_LPTs.Caption = HwCtrl.LPTNumPorts
L_LPTNumber.Caption = HwCtrl.LPTNumber
L_Base.Caption = Hex(HwCtrl.LPTBasePort) + "h"
If HwCtrl.HardAccess Then
C_Hard.Value = 1
Else: C_Hard.Value = 0
End If
C_Hard.Enabled = HwCtrl.ActiveHW
SpinIRQ.Enabled = HwCtrl.ActiveHW And (B_Unmask.Value = 0)
Open_Driver.Enabled = Not HwCtrl.ActiveHW
Close_Driver.Enabled = HwCtrl.ActiveHW
Write_All.Enabled = HwCtrl.ActiveHW
Read_All.Enabled = HwCtrl.ActiveHW
B_Print.Enabled = HwCtrl.ActiveHW
B_Stop.Enabled = HwCtrl.ActiveHW
If Not HwCtrl.ActiveHW Then FlagPrint = False
B_ReadMemory.Enabled = HwCtrl.ActiveHW And (MappedAddr <> NIL)
B_Unmask.Enabled = HwCtrl.ActiveHW And (HwCtrl.IRQNumber > 0) And (HwCtrl.IRQNumber < 16)
C_LPT_IRQ.Enabled = HwCtrl.ActiveHW And (((HwCtrl.IRQNumber = 7) And (HwCtrl.LPTNumber = 1)) Or ((HwCtrl.IRQNumber = 5) And (HwCtrl.LPTNumber = 2)))
For nPin = 1 To 17
If Not HwCtrl.ActiveHW Then RCheck(nPin).Value = False
If Not HwCtrl.ActiveHW Then WCheck(nPin).Value = False
Rem WCheck(nPin).Value = HwCtrl.ActiveHW
Next nPin
WCheck(10).Enabled = False
WCheck(11).Enabled = False
WCheck(12).Enabled = False
WCheck(13).Enabled = False
WCheck(15).Enabled = False
End Sub
Public Function HexToInt(strMyString As String) As Long
Dim lngMyInteger As Long
lngMyInteger = 0
On Error Resume Next
lngMyInteger = "&h" & strMyString
HexToInt = lngMyInteger
End Function
Public Function IntToHex2(MyVal As Byte) As String
Dim s As String
s = Hex(MyVal)
If Len(s) = 1 Then s = "0" & s
IntToHex2 = s
End Function
Public Function IntToHex8(MyVal As Long) As String
Dim s As String
s = Hex(MyVal)
While Len(s) < 8
s = "0" & s
Wend
IntToHex8 = s
End Function
Public Sub WriteToPort(Addr As TextBox, ValPort As TextBox, CW As CheckBox)
Dim NomW As Integer, DatW As Byte
If CW.Value = Checked Then
NomW = HexToInt(Addr.Text)
DatW = HexToInt(ValPort.Text)
HwCtrl.Port(NomW) = DatW
End If
End Sub
Public Sub ReadFromPort(Addr As TextBox, ValPort As Label, CR As CheckBox)
Dim NomR As Integer, DatR As Byte
If CR.Value = Checked Then
NomR = HexToInt(Addr.Text)
DatR = HwCtrl.Port(NomR)
ValPort.Caption = Hex(DatR)
End If
End Sub
Private Sub B_Init_Click()
HwCtrl.LPTInit
End Sub
Private Sub B_Print_Click()
If Not FlagPrint Then
NumLine = 0
NumSymbol = 1
FlagPrint = True
End If
End Sub
Private Sub B_Stop_Click()
FlagPrint = False
End Sub
Private Sub B_Unmask_Click()
If B_Unmask.Value = 0 Then
Sum_Ticks = Flag_Tim
HwCtrl.IRQMasked = True
HwCtrl.Port(HwCtrl.LPTBasePort + 2) = 0
C_LPT_IRQ.Value = 0
Else
IRQ = SpinIRQ.Value
HwCtrl.IRQNumber = IRQ
Flag_Intr = 0
Sum_Ticks = 0
Flag_Tim = 0
Scan_Code = 0
HwCtrl.IRQMasked = False
End If
ShowButtons
End Sub
Private Sub B_ReadMemory_Click()
Dim CurrAddr As Long
Dim s As String
ListAddr.Clear
ListHex.Clear
ListAscii.Clear
If HwCtrl.ActiveHW Then
CurrAddr = PhysAddr
Ofs% = 0
Ofs0% = 0
For i% = 1 To 16
ListAddr.AddItem IntToHex8(CurrAddr)
s = ""
For j% = 1 To 16
s = s + IntToHex2(HwCtrl.Mem(MappedAddr, Ofs%))
Ofs% = Ofs% + 1
Next j%
ListHex.AddItem (s)
s = ""
For j% = 1 To 16
b% = HwCtrl.Mem(MappedAddr, Ofs0%)
Ofs0% = Ofs0% + 1
If b% >= 32 Then
ch$ = Chr(b%)
Else: ch$ = "."
End If
s = s + ch$
Next j%
ListAscii.AddItem s
CurrAddr = CurrAddr + 16
Next i%
End If
End Sub
Private Sub B_SetMemory_Click()
PhysAddr = HexToInt(E_Base.Text)
E_Base.Text = IntToHex8(PhysAddr)
MappedAddr = HwCtrl.MapPhysToLinear(PhysAddr, 256)
ShowButtons
End Sub
Private Sub C_Hard_Click()
HwCtrl.HardAccess = C_Hard.Value
End Sub
Private Sub C_LPT_IRQ_Click()
If C_LPT_IRQ.Value = 1 Then
HwCtrl.Port(HwCtrl.LPTBasePort + 2) = 16
Else:
HwCtrl.Port(HwCtrl.LPTBasePort + 2) = 0
End If
End Sub
Private Sub Close_Driver_Click()
Timer1.Enabled = False
HwCtrl.Port(HwCtrl.LPTBasePort + 2) = 0
C_LPT_IRQ.Value = 0
HwCtrl.CloseDriver
B_Unmask.Value = 0
PointPhys = 0
B_SetMemory.Enabled = False
Flag_Intr = 0
MappedAddr = 0
ShowButtons
End Sub
Private Sub Command1_Click()
Close_Driver_Click
Unload Form1
End
End Sub
Private Sub E_Base_Change()
MappedAddr = 0
ShowButtons
End Sub
Private Sub Form_Load()
ShowButtons
End Sub
Private Sub HwCtrl_OnHwInterrupt(ByVal HwCounter As Long, ByVal LPT_DataReg As Integer, ByVal LPT_StatusReg As Integer, ByVal ScanCode As Integer)
IRQCounter = HwCounter
Flag_Intr = Flag_Intr + 1
Scan_Code = ScanCode
Status_Reg = LPT_StatusReg
Data_Reg = LPT_DataReg
End Sub
Private Sub Open_Driver_Click()
HwCtrl.OpenDriver
If Not HwCtrl.ActiveHW Then
MsgBox ("The driver VICHWxx not found")
Else:
IRQ = SpinIRQ.Value
HwCtrl.IRQNumber = IRQ
B_SetMemory.Enabled = True
For i = 1 To 17
HwCtrl.Pin(i) = False
Next i
End If
ShowButtons
End Sub
Private Sub Read_All_Click()
Call ReadFromPort(PortR1, ValR1, CR1)
Call ReadFromPort(PortR2, ValR2, CR2)
Call ReadFromPort(PortR3, ValR3, CR3)
Call ReadFromPort(PortR4, ValR4, CR4)
End Sub
Private Sub Timer1_Timer()
Dim s As String
Dim b As Boolean
L_Gen.Caption = IRQCounter
L_Han.Caption = Flag_Intr
L_Data.Caption = IntToHex2(Data_Reg) + "h"
L_Status.Caption = IntToHex2(Status_Reg) + "h"
L_Scan.Caption = IntToHex2(Scan_Code) + "h"
L_Time.Caption = Flag_Tim / 1000
If HwCtrl.ActiveHW And (Not HwCtrl.IRQMasked) Then
CurrTicker = GetTickCount()
Flag_Tim = Sum_Ticks + CurrTicker - OldTicker
Else: OldTicker = GetTickCount()
End If
For nPin = 1 To 17
If HwCtrl.Pin(nPin) Then RCheck(nPin).Value = 1 Else RCheck(nPin).Value = 0
Next nPin
If HwCtrl.LPTAckwl Then C_ACKWL.Value = 1 Else C_ACKWL.Value = 0
If HwCtrl.LPTBusy Then C_BUSY.Value = 1 Else C_BUSY.Value = 0
If HwCtrl.LPTError Then C_ERROR.Value = 1 Else C_ERROR.Value = 0
If HwCtrl.LPTPaperEnd Then C_PE.Value = 1 Else C_PE.Value = 0
If HwCtrl.LPTSlct Then C_SLCT.Value = 1 Else C_SLCT.Value = 0
If FlagPrint Then
s = E_Line.Text
If NumSymbol > Len(s) Then FlagPrint = False
Rem Label22.Caption = NumSymbol
Rem Label23.Caption = Len(s)
Rem Label24.Caption = s
If FlagPrint Then
n% = Val(Mid(s, NumSymbol, 1))
b = HwCtrl.LPTPrintChar(n%)
If b Then
NumSymbol = NumSymbol + 1
End If
End If
End If
B_Stop.Enabled = FlagPrint
B_Print.Enabled = Not FlagPrint
End Sub
Private Sub SpinIRQ_Change()
HwCtrl.IRQNumber = SpinIRQ.Value
L_IRQ.Caption = SpinIRQ.Value
ShowButtons
End Sub
Private Sub WCheck_Click(Index As Integer)
If WCheck(Index).Value <> WChecks(Index) Then
WChecks(Index) = WCheck(Index).Value
HwCtrl.Pin(Index) = CBool(WCheck(Index).Value = 1)
End If
End Sub
Private Sub Write_All_Click()
WriteToPort PortW1, ValW1, CW1
WriteToPort PortW2, ValW2, CW2
WriteToPort PortW3, ValW3, CW3
WriteToPort PortW4, ValW4, CW4
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -