VB源代码转Delph源程序 ( 积分: 50 )

Private Type PAGE '?
CH(32) As Byte
End Type
Private Type LISTFILE '?
FileNam(300) As String * 12
End Type

Private Declare Function InitializeWinIo Lib "WinIo.dll&quot
() As Boolean
Private Declare Function Inp Lib "inpout32.dll&quot
Alias "Inp32&quot
(ByVal PortAddress As Integer) As Byte
Private Declare Sub Out Lib "inpout32.dll&quot
Alias "Out32&quot
(ByVal PortAddress As Integer, ByVal Value As Byte)
Private Declare Sub Sleep Lib "kernel32&quot
(ByVal dwMilliseconds As Long)

Private Sub InitLtpPort(Base_Addr As Integer) '初始化端口
On Error Resume Next
If InitializeWinIo = False Then MsgBox "初始化并口失败!"
m_AndArray(0) = 1
m_AndArray(1) = 2
m_AndArray(2) = 4
m_AndArray(3) = 8
m_AndArray(4) = 16
m_AndArray(5) = 32
m_AndArray(6) = 64
m_AndArray(7) = 128
m_LtpDataAddr = Base_Addr
m_LtpStatusAddr = Base_Addr + 1
m_LtpCtlAddr = Base_Addr + 2
Out m_LtpCtlAddr, INIT_CONTROL_VALUE '?
End Sub

Public Function CheckStatus() As Boolean '检查状态
m_LtpStatusValue = Inp(m_LtpStatusAddr)
If (m_LtpStatusValue And m_AndArray(3)) Then '?
m_IsError = False
Else
m_IsError = True
End If

If (m_LtpStatusValue And m_AndArray(4)) Then
m_IsOnline = False
Else
m_IsOnline = True
End If

If (m_LtpStatusValue And m_AndArray(7)) Then
m_IsBusy = False
Else
m_IsBusy = True
End If
End Function

Private Function SendSingleBuffer(DataArray() As Byte) As Boolean '发送数据
Dim time_count As Long
m_BusyCount = 0
m_ErrorCount = 0
SendSingleBuffer = False
Do
CheckStatus
If (m_IsOnline = False Or m_IsBusy = True) Then
Delay 2
m_BusyCount = m_BusyCount + 1
If m_BusyCount > MAX_BUSY_COUNT Then
Exit Function
End If
Else
Exit Do
End If
Loop
RetryAgain:
Out m_LtpCtlAddr, PRESET_LOW '?
Out m_LtpDataAddr, DataArray(0)
Delay 1 '2
Out m_LtpCtlAddr, STROBE_HIGH_BYTE_ONE
Delay 5 '10
Out m_LtpCtlAddr, STROBE_LOW_BYTE_ONE
Out m_LtpCtlAddr, PRESET_HIGH
For m_ByteCount = 1 To UBound(DataArray)
Out m_LtpDataAddr, DataArray(m_ByteCount)
Delay 1
Out m_LtpCtlAddr, STROBE_HIGH_OTHER
Delay 5 '10
Out m_LtpCtlAddr, STROBE_LOW_OTHER
Delay 5 '10
Next m_ByteCount
CheckStatus
If (m_IsError = True) Then
m_ErrorCount = m_ErrorCount + 1
If m_ErrorCount > MAX_ERROR_COUNT Then
Exit Function
End If
GoTo RetryAgain '?
End If
SendSingleBuffer = True
Delay 5 '50
End Function

Private Sub Form_Load() '表单初始化?
Dim CheckFile As String
Dim FilList As LISTFILE
Dim dwI As Integer

IntEnter = False
RunTimeEnter = False
SelCheEnter = False
FrameRunTimer.Enabled = False
ReadCurr.Enabled = False
CheckWantToStop = False
DPos = Combo1.Text - 1
CHArrayVal(0) = 255
OppCHArray(0) = 0
TempArray(0) = 255
StartArray(0) = 255
EndArray(0) = 255
DifferSEVal = 0
CurrScene = ""

g_AppPath = Trim(App.Path)
If Right(g_AppPath, 1) <> &quot;/&quot
Then
g_AppPath = g_AppPath + &quot;/&quot;
End If

For dwI = 1 To 512
CHArrayVal(dwI) = 0
OppCHArray(dwI) = 255
TempArray(dwI) = 0
StartArray(dwI) = 0
EndArray(dwI) = 0
Next dwI

For dwI = 0 To 31
Slider1(dwI).Value = 255 - CHArrayVal(DPos * 32 + dwI + 1)
Text1(dwI).Text = 255 - Slider1(dwI).Value
Label2(dwI).Caption = &quot;CH&quot
&amp
DPos * 32 + dwI + 1
Next dwI

ComboStartScene.Clear
ComboEndScene.Clear
CheckFile = g_AppPath + &quot;framedata/ExistFile.txt&quot;
Open CheckFile For Random As #5 Len = 3612
Get #5, 1, FilList
For dwI = 1 To 300
If Mid(FilList.FileNam(dwI), 1, 5) = &quot;Frame&quot
Then
ComboStartScene.AddItem FilList.FileNam(dwI)
ComboEndScene.AddItem FilList.FileNam(dwI)
End If
Next dwI
Close #5

InitLtpPort &amp;H378 '?
End Sub

Private Sub FrameRunTimer_Timer() '定时器
Dim dwI As Integer
FrameRunTimer.Enabled = False
If RunText.Text > 1 Then
RunTimes = RunTimes + 1
If RunTimes >= RunText.Text Then
RunTimes = 0
PrevSceneIndex = PrevSceneIndex + CountDiff
If (CountDiff = 1 And PrevSceneIndex > ComboEndScene.ListIndex) Or (CountDiff = -1 And PrevSceneIndex < ComboEndScene.ListIndex) Then
PrevSceneIndex = ComboStartScene.ListIndex
End If
End If
Else
RunTimes = 0
PrevSceneIndex = PrevSceneIndex + CountDiff
If (CountDiff = 1 And PrevSceneIndex > ComboEndScene.ListIndex) Or (CountDiff = -1 And PrevSceneIndex < ComboEndScene.ListIndex) Then
PrevSceneIndex = ComboStartScene.ListIndex
End If
End If
ActionScene '?
FrameRunTimer.Enabled = True
End Sub

Private Sub SendCommand_Click() '发送
Dim dwI As Integer
CheckWantToStop = False
RunTimes = 0
If CurrCheck.Value = 1 Then
CurrCheck.Enabled = False
SendCommand.Enabled = False
ExitComm.Enabled = False
Do
If OppoCheck.Value = 1 Then
SendSingleBuffer OppCHArray()
Else
SendSingleBuffer CHArrayVal()
End If
Sleep 2
If m_WantToStop = True Then Exit Do
Loop
Else
If FadeCheck.Value = 1 Then
If Trim(ComboStartScene.Text) = &quot;&quot
Or Trim(ComboEndScene.Text) = &quot;&quot
Then
MsgBox &quot;请选择起始或终止场景名。&quot;
FadeCheck.Value = 0
FadeCheck.Enabled = True
SendCommand.Enabled = True
ExitComm.Enabled = True
Else
PrevScene = ComboStartScene.Text
PrevSceneIndex = ComboStartScene.ListIndex
NextScene = ComboStartScene.Text
NextSceneIndex = ComboStartScene.ListIndex
CountDiff = 0
DifferSEVal = ComboEndScene.ListIndex - ComboStartScene.ListIndex
For dwI = 0 To 512
PrevArray(dwI) = StartArray(dwI)
CurrArray(dwI) = StartArray(dwI)
NextArray(dwI) = StartArray(dwI)
Next dwI
If DifferSEVal <> 0 Then
CountDiff = IIf(DifferSEVal > 0, 1, -1)
ActionScene '?
FrameRunTimer.Enabled = True
End If
FadeCheck.Enabled = False
SendCommand.Enabled = False
ExitComm.Enabled = False
Do
If OppoCheck.Value = 1 Then
SendSingleBuffer OppCHArray()
Else
SendSingleBuffer CurrArray()
End If
Label12.Visible = True
Label12.Caption = CurrScene
If m_WantToStop = True Then Exit Do
Loop
End If
End If
End If
End Sub

Private Sub ActionScene() '加载文件场景数据
Dim szFile As String, ItemFile As String
Dim dwI As Integer, dwJ As Integer
Dim dwA As Long
Dim VarName(16) As PAGE
If RunText.Text > 1 Then
If IntText.Text / RunText.Text < 10 Then
IntText.Text = RunText.Text * 10
Else
IntText.Text = Int(IntText.Text / RunText.Text) * RunText.Text
End If
IntSlider.Value = IntText.Text
FrameRunTimer.Interval = IntText.Text / RunText.Text
Else
FrameRunTimer.Interval = IntText.Text
End If
If RunTimes = 0 Then
If PrevSceneIndex = ComboEndScene.ListIndex Then
NextScene = ComboStartScene.Text
NextSceneIndex = ComboStartScene.ListIndex
Else
NextSceneIndex = PrevSceneIndex + CountDiff
NextScene = ComboStartScene.List(NextSceneIndex)
End If
szFile = g_AppPath + &quot;framedata/&quot
+ PrevScene
Open szFile For Random As #1
For dwJ = 1 To 16
Get #1, dwJ, VarName(dwJ)
For dwI = 1 To 32
PrevArray((dwJ - 1) * 32 + dwI) = VarName(dwJ).CH(dwI)
Next dwI
Next dwJ
Close #1
szFile = g_AppPath + &quot;framedata/&quot
+ NextScene
Open szFile For Random As #1
For dwJ = 1 To 16
Get #1, dwJ, VarName(dwJ)
For dwI = 1 To 32
NextArray((dwJ - 1) * 32 + dwI) = VarName(dwJ).CH(dwI)
Next dwI
Next dwJ
Close #1
End If
For dwI = 1 To 512
dwA = NextArray(dwI) * RunTimes / RunText.Text
dwA = dwA - PrevArray(dwI) * RunTimes / RunText.Text
dwA = PrevArray(dwI) + dwA
CurrArray(dwI) = dwA
OppCHArray(dwI) = 255 - CurrArray(dwI)
Next dwI
CurrSceneIndex = PrevSceneIndex
CurrScene = ComboStartScene.List(CurrSceneIndex)
End Sub

哥们，这也太长的了吧

要是1000分以上还可以考虑翻译,这么长,看都不容易还要翻译

已经更改了长度,只保留64行.