VFP 愛用者社區

[ufochen]

請前輩幫我看看這些VB程式碼,如何修改讓他在VFP上跑
我只會一點點VFP,對VB則完全不懂...
希望前輩幫我看看,下面這些程式是否可以改在VFP6上跑
我異想天開,想要用VFP6去控制印表機埠的IO,再加一些電子元件,然後用來一些控制家庭電器開關,
****form1.frm****程式碼
Dim PtrAddress As Long '印表機埠變數
Dim DataOutValue As Byte '資料埠變數
Dim CtrlOutValue As Byte '控制埠變數
Dim D(0 To 7) As Integer '七段顯示器條狀數值
Dim Digital(0 To 9) As Integer '七段顯示器顯示數值

Private Sub Command1_Click()
Dim i%, BB As Byte
i = HWPORTIO_ReadByte(PtrAddress + 1, BB) '讀取狀態埠資料
If (BB And &H = &H8 Then '檢查傳回值中的第三位元是否為1
PtrStatus(0).FillColor = RGB(255, 0, 0) '改變燈號為紅色
Else
PtrStatus(0).FillColor = RGB(0, 0, 0) '改變燈號為黑色
End If
If (BB And &H10) = &H10 Then '檢查傳回值中的第四位元是否為1
PtrStatus(1).FillColor = RGB(255, 0, 0)
Else
PtrStatus(1).FillColor = RGB(0, 0, 0)
End If
If (BB And &H20) = &H20 Then '檢查傳回值中的第五位元是否為1
PtrStatus(2).FillColor = RGB(255, 0, 0)
Else
PtrStatus(2).FillColor = RGB(0, 0, 0)
End If
If (BB And &H40) = &H40 Then '檢查傳回值中的第六位元是否為1
PtrStatus(3).FillColor = RGB(255, 0, 0)
Else
PtrStatus(3).FillColor = RGB(0, 0, 0)
End If
If (BB And &H80) = &H80 Then '檢查傳回值中的第七位元是否為1
PtrStatus(4).FillColor = RGB(255, 0, 0)
Else
PtrStatus(4).FillColor = RGB(0, 0, 0)
End If

End Sub

Private Sub Command2_Click()
HWPORTIO_WriteByte PtrAddress, 0 '印表機埠資料線清空
HWPORTIO_Close
End
End Sub

Private Sub Command3_Click()
Dim i%
For i = 0 To 9
HWPORTIO_WriteByte PtrAddress, Digital(i)
TimeDelay 200
Next i
End Sub

Private Sub CtrlOut_Click(Index As Integer)
If CtrlOut(Index).Value = 1 Then '該控制核取框是否被核取?
CtrlOutValue = CtrlOutValue Or 2 ^ Index '若核取則將該位置的輸出變數值設定為1
Else
CtrlOutValue = CtrlOutValue And (255 - 2 ^ Index) '否則設定為0
End If
HWPORTIO_WriteByte PtrAddress + 2, CtrlOutValue '再將變數值送到指定的印表機位址上

End Sub

Private Sub DataOut_Click(Index As Integer)
If DataOut(Index).Value = 1 Then '該資料核取框是否被核取?
DataOutValue = DataOutValue Or 2 ^ Index '若核取則將該位置的輸出變數值設定為1
Else
DataOutValue = DataOutValue And (255 - 2 ^ Index) '否則設定為0
End If
HWPORTIO_WriteByte PtrAddress, DataOutValue '再將變數值送到指定的印表機位址上
End Sub

Private Sub Form_Load()
PtrAddress = &H378 '指定印表機埠的位址
DataOutValue = 0 '將資料埠變數值預設為0
CtrlOutValue = 0 '將控制埠變數值預設為0
If HWPORTIO_Init() <> 0 Then
MsgBox "驅動程式初始化失敗!", vbCritical + vbOKOnly, "Init Fail"
End
End If
HWPORTIO_WriteByte PtrAddress, DataOutValue '將此值設定給指定的印表機位址
HWPORTIO_WriteByte PtrAddress + 2, CtrlOutValue '將此值設定給指定的印表機控制位址
D(0) = &H1: D(1) = &H2: D(2) = &H4: D(3) = &H8
D(4) = &H10: D(5) = &H20: D(6) = &H40: D(7) = &H80
Digital(0) = D(0) + D(1) + D(2) + D(4) + D(5) + D(6) + D(7)
Digital(1) = D(0) + D(5)
Digital(2) = D(0) + D(1) + D(3) + D(6) + D(7)
Digital(3) = D(0) + D(1) + D(3) + D(5) + D(6)
Digital(4) = D(0) + D(2) + D(3) + D(5)
Digital(5) = D(1) + D(2) + D(3) + D(5) + D(6)
Digital(6) = D(1) + D(2) + D(3) + D(5) + D(6) + D(7)
Digital(7) = D(0) + D(1) + D(5)
Digital( = D(0) + D(1) + D(2) + D(3) + D(5) + D(6) + D(7)
Digital(9) = D(0) + D(1) + D(2) + D(3) + D(5)

End Sub
*************Module1.bas 程式碼************

Global Const HWPORTIO_OK = 0
Global Const HWPORTIO_DriverOpenError = 1
Global Const HWPORTIO_DriverCloseError = 2
Global Const HWPORTIO_DriverNotOpen = 3
Global Const HWPORTIO_DriverIOFail = 4

' The DIO functions
Declare Sub HWPORTIO_WriteByte Lib "HWPortIO.dll" _
(ByVal address As Integer, ByVal DataOut As Byte)
Declare Sub HWPORTIO_WriteWord Lib "HWPortIO.dll" _
(ByVal address As Integer, ByVal DataOut As Integer)
Declare Function HWPORTIO_ReadByte Lib "HWPortIO.dll" _
(ByVal address As Integer, dataIn As Byte) As Integer
Declare Function HWPORTIO_ReadWord Lib "HWPortIO.dll" _
(ByVal address As Integer, dataIn As Integer) As Integer

' The Driver functions
Declare Function HWPORTIO_Init Lib "HWPortIO.dll" () As Integer
Declare Sub HWPORTIO_Close Lib "HWPortIO.dll" ()
Declare Function HWPORTIO_GetDllVersion Lib "HWPortIO.dll" (wDLLVersion As Integer) As Integer
Declare Function HWPORTIO_GetDriverVersion Lib "HWPortIO.dll" _
(wDriverVersion As Integer) As Integer

Public Declare Function GetTickCount Lib "kernel32" () As Long


Sub TimeDelay(TT As Long)
Dim t As Long
t = GetTickCount()
Do
DoEvents
If GetTickCount - t < 0 Then t = GetTickCount
Loop Until GetTickCount - t >= TT
End Sub