200分帮忙把这段VB代码转成DELPHI代码,不够再加。谢谢(200分)

  • 主题发起人 主题发起人 nanshan
  • 开始时间 开始时间
N

nanshan

Unregistered / Unconfirmed
GUEST, unregistred user!
Private Sub Command11_Click()
Dim si, wi As Integer
Dim nofound As Boolean
Dim hadd, vadd As Single
Dim bthr As Integer
Dim cthr As Integer
Dim wx, wy, m, n, i, j As Integer
Dim SHAN As Single
Dim sum(9) As Integer
Dim temp As Single
Dim haddadj As Integer
Dim vaddadj As Integer

hadd = Val(Text8.Text)
vadd = Val(Text9.Text)
bthr = Val(Text10.Text)
cthr = Val(Text11.Text)
Totalclass = 0
If Totalsamp > 0 Then
WclassxL(Totalclass) = Samplex(0)
WclassxR(Totalclass) = Samplex(0)
WclassyU(Totalclass) = Sampley(0)
WclassyD(Totalclass) = Sampley(0)
Wclass(Totalclass) = 1
Samplec(0) = 0 '妮材0摸
Totalclass = 1
End If
For si = 1 To Totalsamp - 1
If Block(Samplex(si) / 5, Sampley(si) / 5) > bthr Then ?
nofound = True
For wi = 0 To Totalclass - 1
If highcheck(wi) = 1 Then
'磷?耎眎び?
If (WclassxR(wi) - WclassxL(wi)) > (Val(Text4.Text) * 2) Then
temp = 15 - (15 - 15 / (WclassxR(wi) - WclassxL(wi) - 2 * Val(Text4.Text)))
haddadj = temp
Else
haddadj = hadd
End If
If (WclassyD(wi) - WclassyU(wi)) > (Val(Text4.Text) - 5) Then
temp = 5 - (5 - 5 / (WclassyD(wi) - WclassyU(wi) - Val(Text4.Text) - 5))
vaddadj = temp
Else
vaddadj = vadd
End If

If Samplex(si) > (WclassxL(wi) - haddadj) And Samplex(si) < (WclassxR(wi) + haddadj) And _
Sampley(si) > (WclassyU(wi) - vaddadj) And Sampley(si) < (WclassyD(wi) + vaddadj) Then
nofound = False
Samplec(si) = Totalclass
If Samplex(si) < WclassxL(wi) Then
WclassxL(wi) = Samplex(si)
End If
If Samplex(si) > WclassxR(wi) Then
WclassxR(wi) = Samplex(si) ?
End If
If Sampley(si) < WclassyU(wi) Then
WclassyU(wi) = Sampley(si) ?
End If
If Sampley(si) > WclassyD(wi) Then
WclassyD(wi) = Sampley(si) ?
End If
Wclass(wi) = Wclass(wi) + 1
Exit For
End If
End If
Next
If nofound Then
WclassxL(Totalclass) = Samplex(si)
WclassxR(Totalclass) = Samplex(si)
WclassyU(Totalclass) = Sampley(si)
WclassyD(Totalclass) = Sampley(si)
Wclass(Totalclass) = 1
Samplec(si) = Totalclass
Totalclass = Totalclass + 1
End If
Else
Samplec(si) = -1
End If
Next


For wi = Totalclass - 1 To 1 Step -1
For si = wi - 1 To 0 Step -1
If Wclass(wi) > cthr And Wclass(si) > cthr Then
If Wclass(wi) > Wclass(si) Then
If WclassxR(wi) >= WclassxR(si) And WclassxL(wi) <= WclassxL(si) And _
WclassyD(wi) >= WclassyD(si) And WclassyU(wi) <= WclassyU(si) Then
Wclass(si) = 1
End If
Else
If WclassxR(si) >= WclassxR(wi) And WclassxL(si) <= WclassxL(wi) And _
WclassyD(si) >= WclassyD(wi) And WclassyU(si) <= WclassyU(wi) Then
Wclass(wi) = 1
Exit For
End If
End If
End If
Next
Next

Label4.Caption = 0
STotalclass = 0

For wi = 0 To Totalclass - 1
If Wclass(wi) > cthr Then
Wclass(STotalclass) = Wclass(wi)
WclassxL(STotalclass) = WclassxL(wi)
WclassxR(STotalclass) = WclassxR(wi)
WclassyU(STotalclass) = WclassyU(wi)
WclassyD(STotalclass) = WclassyD(wi)
STotalclass = STotalclass + 1
End If
Next

Totalclass = STotalclass


If Check1.Value = 1 Then
STotalclass = 0
For wi = 0 To Totalclass - 1
temp = Wclass(wi) / (((WclassxR(wi) - WclassxL(wi)) * (WclassyD(wi) - WclassyU(wi))))
If temp >= Val(Text17.Text) Then
Wclass(STotalclass) = Wclass(wi)
WclassxL(STotalclass) = WclassxL(wi)
WclassxR(STotalclass) = WclassxR(wi)
WclassyU(STotalclass) = WclassyU(wi)
WclassyD(STotalclass) = WclassyD(wi)
STotalclass = STotalclass + 1
End If
Next
Totalclass = STotalclass
End If


If Check3.Value = 1 Then
STotalclass = 0
For wi = 0 To Totalclass - 1
m = Int((WclassxR(wi) - WclassxL(wi) + 1) / 3)
n = Int((WclassyD(wi) - WclassyU(wi) + 1) / 3)
For i = 0 To 2
For j = 0 To 2
sum(i * 3 + j) = 0
For wy = WclassyU(wi) + i * n To WclassyU(wi) + (i + 1) * n - 1
For wx = WclassxL(wi) + j * m To WclassxL(wi) + (j + 1) * m - 1
sum(i * 3 + j) = sum(i * 3 + j) + b1(wx, wy)
Next
Next
Next
Next
SHAN = 0
For i = 0 To 8
temp = sum(i) / (m * n)
If temp >= Val(Text13.Text) Then
SHAN = SHAN + 1
End If
Next
If SHAN > 6 Then
Wclass(STotalclass) = Wclass(wi)
WclassxL(STotalclass) = WclassxL(wi)
WclassxR(STotalclass) = WclassxR(wi)
WclassyU(STotalclass) = WclassyU(wi)
WclassyD(STotalclass) = WclassyD(wi)
STotalclass = STotalclass + 1
End If
Next
Totalclass = STotalclass
End If

If Check4.Value = 1 Then
For si = 1 To Totalsamp - 1
For wi = 0 To Totalclass - 1
If highcheck(wi) = 1 Then
If (WclassxR(wi) - WclassxL(wi)) > (Val(Text4.Text) * 2) Then
temp = 15 - (15 - 15 / (WclassxR(wi) - WclassxL(wi) - 2 * Val(Text4.Text)))
haddadj = temp
Else
haddadj = hadd
End If
If (WclassyD(wi) - WclassyU(wi)) > Val(Text4.Text) - 5 Then
temp = 5 - (5 - 5 / (WclassyD(wi) - WclassyU(wi) - Val(Text4.Text) - 5))
vaddadj = temp
Else
vaddadj = vadd
End If

If Samplex(si) > (WclassxL(wi) - haddadj + 10) And Samplex(si) < (WclassxR(wi) + haddadj) And _
Sampley(si) > (WclassyU(wi) - vaddadj) And Sampley(si) < (WclassyD(wi) + vaddadj) Then
If Samplex(si) < WclassxL(wi) Then
WclassxL(wi) = Samplex(si)
End If
If Samplex(si) > WclassxR(wi) Then
WclassxR(wi) = Samplex(si) ?
End If
If Sampley(si) < WclassyU(wi) Then
WclassyU(wi) = Sampley(si) ?
End If
If Sampley(si) > WclassyD(wi) Then
WclassyD(wi) = Sampley(si) ?
End If
Wclass(wi) = Wclass(wi) + 1
Samplec(si) = wi
Exit For
End If
End If
Next
Next
End If

If Check5.Value = 1 Then
STotalclass = 0
For wi = 0 To Totalclass - 1
temp = WclassyD(wi) - WclassyU(wi)
If (temp >= Val(Text3.Text)) And (temp <= Val(Text4.Text)) Then
Wclass(STotalclass) = Wclass(wi)
WclassxL(STotalclass) = WclassxL(wi)
WclassxR(STotalclass) = WclassxR(wi)
WclassyU(STotalclass) = WclassyU(wi)
WclassyD(STotalclass) = WclassyD(wi)
STotalclass = STotalclass + 1
End If
Next
Totalclass = STotalclass
End If


If Check2.Value = 1 Then
STotalclass = 0
For wi = 0 To Totalclass - 1
If ratecheck(wi) = 1 Then
Wclass(STotalclass) = Wclass(wi)
WclassxL(STotalclass) = WclassxL(wi)
WclassxR(STotalclass) = WclassxR(wi)
WclassyU(STotalclass) = WclassyU(wi)
WclassyD(STotalclass) = WclassyD(wi)
STotalclass = STotalclass + 1
End If
Next
Totalclass = STotalclass
End If

For wi = 0 To Totalclass - 1
Label4.Caption = Label4.Caption + 1
Picture1.Line (WclassxL(wi), WclassyU(wi))-(WclassxR(wi), WclassyD(wi)), RGB(255, 0, 0), B
Picture2.Line (WclassxL(wi), WclassyU(wi))-(WclassxR(wi), WclassyD(wi)), RGB(255, 0, 0), B
Next
End Sub

Private Function ratecheck(wc As Integer) As Integer
If (WclassxR(wc) - WclassxL(wc)) / (WclassyD(wc) - WclassyU(wc) + 1) > Val(Text15.Text) And _
(WclassxR(wc) - WclassxL(wc)) / (WclassyD(wc) - WclassyU(wc) + 1) < Val(Text16.Text) Then
ratecheck = 1
Else
ratecheck = 0
End If
End Function
 
发源码到我邮箱,我有空试试。发正现在没有分了。
 
给留个地址呀
 
时间太长了,强制结束吧
 
后退
顶部