DIM BLACK(10000)AS BOOLEAN
1.BLACK(2)=TRUE,BLACK(3)=TRUE,BLACK(4)=TRUE
2......
3......
再对black(i)[i=0 to 10000]进行"OR"运算
1.BLACK(2)=TRUE,BLACK(3)=TRUE,BLACK(4)=TRUE
2......
3......
再对black(i)[i=0 to 10000]进行"OR"运算
解决方案 »
- vb 复制文件到剪贴版!高手快来吧
- 高手帮忙,有关PictureBox里面的图像保存问题
- 我的DataReport中只有一个字段不可能很长。。但每次运行就说report is wider than datareport~
- 如何在VB中实现像Word一样的文本编辑
- listview 的行距可以调整吗?listview每列的颜色可以设定吗? listview 如何做分页,每页显示30条记录。
- 如何让webbrowser控件自动按网页弹出来的VB对话框
- 如何打印picturebox控件内的内容?
- 【求实例】VB中如何模拟键盘组合键
- 好急人的问题,请高手帮忙。
- Select 查询你能解决吗?
- 高分求助,怎样知道一个字段是否为非空(必须输入)?
- WINSOCK控件问题
SegOn As Long
SegEnd As long
End Type2、如果SegOn小于或者等于集合当中任何一个Seg的SegEnd,则两个Seg可以前后合并成一个Seg。删除原来的被合并的Seg。3、如果SegEnd大于或者等于集合当中任何一个Seg的SegOn,则两个Seg可以前后结合成一个Seg。删除原来的被合并的Seg。4、如果SegOn小于或者等于集合当中任何一个Seg,同时SegEnd大于或者等于集合当中任何一个Seg。则三个Seg可以结合成一个Seg。删除原来的被合并的Seg。5、统计所有的存活下来的Seg的程度,就是总共的长度。这个算法的速度取决于Seg的总数量,并且间接和木头的长度有关,与刷木头的次数成反比关系。刷得越多,存活下来的Seg越少,而Seg的程度越长。但是这个算法不稳定,没有稳定的执行时间。这是一个很有趣的程序,稍后我会做个简单的样子出来。不过其中要用到添加和删除,恐怕用纯VB实现有点困难。如果用在数据库会很方便的。
……
'.srSegEnd = Int(Rnd * (pLong + 1)) + pMisreg
.srSegEnd = .srSegOn + Int(Rnd * 20)
……
End Function.srSegEnd = Int(Rnd * (pLong + 1)) + pMisreg是标准的写法,而.srSegEnd = .srSegOn + Int(Rnd * 20)是为了使每个Seg的长度更短,使程序在很高的负荷下面工作,为了检测代码而修改的。你可以沿用这个语句,但是它并不标准,它生成的随机“段”最长不会超过20,也就是说刷子最长不会刷过超过20个长度的单位。20这个常量可以修改。不过同时将前面的.srSegOn = Int(Rnd * (pLong + 1)) + pMisreg修改成.srSegOn = Int(Rnd * (pLong + 1-20))+ pMisreg或许更标准一些,但是这样一来pLong就不能小于20了。Module1的代码:Public tSegs() As tpSegRecType tpSegRec
srDisabled As Boolean
srSegOn As Long
srSegEnd As Long
End Type'[Level 0]Function SegsViewToPictureBox(pPicture As PictureBox, pSegs() As tpSegRec)
Dim tSegsOn As Long
Dim tSegsEnd As Long
Dim tIndex As Long
tSegsOn = LBound(pSegs)
tSegsEnd = UBound(pSegs)
For tIndex = tSegsOn To tSegsEnd
If Not pSegs(tIndex).srDisabled Then
pPicture.Line (pSegs(tIndex).srSegOn, 5)-(pSegs(tIndex).srSegEnd, 5), RGB(0, 0, 0)
End If
Next
End FunctionFunction SegsViewToListBox(pListBox As ListBox, pSegs() As tpSegRec)
Dim tSegsOn As Long
Dim tSegsEnd As Long
Dim tIndex As Long
tSegsOn = LBound(pSegs)
tSegsEnd = UBound(pSegs)
pListBox.Clear
For tIndex = tSegsOn To tSegsEnd
If Not pSegs(tIndex).srDisabled Then
pListBox.AddItem pSegs(tIndex).srSegOn & " " & pSegs(tIndex).srSegEnd
End If
Next
End FunctionFunction SegAddToLine(pSeg As tpSegRec, pSegs() As tpSegRec)
'覆盖一个Seg。如果遇到重合的Seg则合并。
Dim tSegsOn As Long
Dim tSegsEnd As Long
Dim tOverBck As Boolean
Dim tOverPri As Boolean
Dim tOverIns As Boolean
Dim tOverOut As Boolean Dim tSeg As tpSegRec
Dim tIndex As Long
tSeg = pSeg
tSegsOn = LBound(pSegs)
tSegsEnd = UBound(pSegs)
For tIndex = tSegsOn To tSegsEnd
tOverPri = (tSeg.srSegOn <= pSegs(tIndex).srSegEnd And tSeg.srSegOn >= pSegs(tIndex).srSegOn)
tOverBck = (tSeg.srSegEnd >= pSegs(tIndex).srSegOn And tSeg.srSegEnd <= pSegs(tIndex).srSegEnd)
tOverIns = (tSeg.srSegOn >= pSegs(tIndex).srSegOn And tSeg.srSegEnd <= pSegs(tIndex).srSegEnd)
tOverOut = (tSeg.srSegOn <= pSegs(tIndex).srSegOn And tSeg.srSegEnd >= pSegs(tIndex).srSegEnd)
If Not pSegs(tIndex).srDisabled Then
If tOverIns Then Exit Function
If tOverOut Then
SegsDelItem tIndex, pSegs()
End If
If tOverPri Then
tSeg.srSegOn = pSegs(tIndex).srSegOn
SegsDelItem tIndex, pSegs()
End If
If tOverBck Then
tSeg.srSegEnd = pSegs(tIndex).srSegEnd
SegsDelItem tIndex, pSegs()
End If
End If
Next
SegsAddItem tSeg, pSegs()
End FunctionFunction SegsDelItem(ByVal pIndex As Long, ByRef pSegs() As tpSegRec)
pSegs(pIndex).srDisabled = True
End FunctionFunction SegsAddItem(ByRef pSeg As tpSegRec, ByRef pSegs() As tpSegRec)
'添加一个Seg到Segs数组,如果搜索到第一个有删除标记的Seg则添加到对应位置。否则将在数组结尾添加。
Dim tSegsOn As Long
Dim tSegsEnd As Long
Dim tIndex As Long
Dim tInsertOver As Boolean
tSegsOn = LBound(pSegs)
tSegsEnd = UBound(pSegs)
For tIndex = tSegsOn To tSegsEnd
tInsertOver = tInsertOver Or pSegs(tIndex).srDisabled
If tInsertOver Then
pSegs(tIndex) = pSeg
pSegs(tIndex).srDisabled = False
Exit For
End If
Next
If Not tInsertOver Then
tSegsEnd = tSegsEnd + 1
ReDim Preserve pSegs(tSegsEnd)
pSegs(tSegsEnd) = pSeg
End If
End FunctionFunction SegGetByRndSet(ByVal pLong As Long, Optional ByVal pMisreg As Long = 0) As tpSegRec
Dim tOutSeg As tpSegRec
With tOutSeg
.srSegOn = Int(Rnd * (pLong + 1)) + pMisreg
'.srSegEnd = Int(Rnd * (pLong + 1)) + pMisreg
.srSegEnd = .srSegOn + Int(Rnd * 20)
ValueBigRight .srSegOn, .srSegEnd
End With
SegGetByRndSet = tOutSeg
End Function'[Level -1]Function ValueBigRight(ByRef pValL As Long, ByRef pValR As Long)
If pValR < pValL Then ValueSwap pValL, pValR
End FunctionFunction ValueSwap(ByRef pValA As Long, ByRef pValB As Long)
Dim tT As Long
tT = pValB: pValB = pValA: pValA = tT
End FunctionForm1的代码:
Private Sub Command1_Click()
Randomize Timer
Dim tSeg As tpSegRec
tSeg = SegGetByRndSet(1000)
Text1.Text = tSeg.srSegOn & " " & tSeg.srSegEnd
SegAddToLine tSeg, tSegs()
SegsViewToListBox List1, tSegs()
SegsViewToPictureBox Picture1, tSegs()
End SubPrivate Sub Form_Load()
ReDim tSegs(0)
tSegs(0).srDisabled = True 'Text1.Text = tSeg.srSegOn & " " & tSeg.srSegEnd
End Sub
Private Type Seg
Begin As Long
End As Long
End Type'刷的次数
Private Const TIMES As Long = 3
'用来模拟木头的字符串
Private strResult As StringPrivate Sub Command2_Click()
Dim aryS(TIMES) As Seg
Dim lngI As Long
'给每次所刷的起点和终点赋初值
aryS(0).Begin = 2
aryS(0).End = 4
aryS(1).Begin = 3
aryS(1).End = 7
aryS(2).Begin = 2
aryS(2).End = 8
aryS(3).Begin = 12
aryS(3).End = 15
'初始化木头
strResult = String(10000, "0")
'开始刷木头
For lngI = LBound(aryS) To UBound(aryS)
Convert aryS(lngI).Begin, aryS(lngI).End
Next '截去未刷的木头
strResult = Replace(strResult, "0", "")
'计算已刷的长度
MsgBox Len(strResult)
End SubPrivate Sub Convert(ByVal BeginPos As Long, ByVal EndPos As Long)
'模拟刷木头的过程
strResult = Left(strResult, BeginPos - 1) & String(EndPos - BeginPos + 1, "1") & Mid(strResult, EndPos + 1)
End Sub
尤其是热心的小仙女,居然真正做了一个程序?
不过,我的最主要的意思不是要模拟刷木头棍的过程。而是要求部分被刷黑的片断有多长?
小仙妹姐姐给出的数学思想我有点迷糊。
2、如果SegOn小于或者等于集合当中任何一个Seg的SegEnd,则两个Seg可以前后合并成一个Seg。删除原来的被合并的Seg。。
你看,有seg(1)on=2,seg(1)end=4;seg(n)on=6,seg(n)end=8;合并为seg(x)len=2+2=4么?那么删除谁?
或者seg(n)on=3,seg(n)end=5;seg(x)len还是2+2=4么?删除谁?
请详细指教。野兽派(北方狼,笨老虎,,,,呵呵)的回答可以得出我的要求,但是要开一个大数组。如果我进一步要求精确到小数点后面3位,是不是要开一个10000000的大数组。再大?
并且有10000个这样的木头棍等着我算,应该会很耗时间吧?大家有什么高速一点的数值算法可以实现要求么?
'S被包含在N(I)里。取消添加操作,因为S被N(I)覆盖了,N(I)已经包含了S。没有添加的必要了。这是首要条件。直观表示是这样的:[SN]表示S和N重合的部分,下同]NNNNNNNNNNNNNSNSNSNSNSNSNSNNNNNNNNNNNNNNNNNNN(I).SegOn>=S.SegOn And N(I).SegEnd<=S.SegEnd
'S包含N(I)。直接删除掉N(I)就可以了。这是次要条件。后面两个条件是并列条件,也就是说下面这两个条件不是排它的,而是可以同时产生的。直观表示是这样的:[SN]表示S和N重合的部分,下同]SSSSSSSSSSSSSSSNSNSNSNSNSNSSSSSSSSSSSSSSN(I).SegOn<=S.SegOn And N(I).SegEnd>=S.SegOn
'S头部与N(I)的尾部有交叉或者相连接。让S.SegOn=N(I).SegOn,然后删除N(I)。这个时候的S.SegOn是不会与前面的任何一个N().SegOn元素重合,只要在序列里没有重合的Seg元素。实际上如果你从头开始一点点用这个办法Add到序列里是不会出现重合的Seg的。所以一次循环就可以,不用重新循环。NNNNNNNNNNNNNNSNSNSNSNSSSSSSSSSSSSSSSSSSN(I).SegOn>=S.SegOn And N(I).SegEnd>=S.SegEnd
'S尾部与N(I)的首部有交叉或者相连接。让S.SegEnd=N(I).SegEnd,然后删除掉N(I)。与前面一样,这个条件不用重新扫描N()集合。SSSSSSSSSSSSSSSSSNSNSNSNSNNNNNNNNNNNNNNN第一次,把2米到4米处刷黑了。S(1) 2 To 4
第二次,把3米到7米处刷黑了。S(2) 3 To 7
第三次,把2米到8米处刷黑了。S(3) 2 To 8
第四次,把12米到15米处刷黑了。S(4) 12 To 151、N(1)是无效的的。N(1).Disibled=True
2、S=S(1)。由于N(1)是无效的。扫描到最后没有有效元素,所以N(1)=S
3、S=S(2)。3<4 7>4 符合交叉条件,则 N(1)成为无效,S.On=2:S.End=7。扫描到最后,N(2)=S。
4、S=S(3)。2=2 8>7 符合覆盖条件。则 N(2)成为无效,N(3)=S
5、S=S(4)。不符合任何交叉覆盖条件。则N(4)=S。最后是这样的:N(1) 无效
N(2) 无效
N(3) 2 To 8
N(4) 12 To 15至于计算长度我想就不用再提醒你了,只要把每个Seg的长度求和就可以了。(8-2)=6
(15-12)=36+3=9最后提醒你一下:S()才是所有段的全部集合,而N()只是“有效段”的集合,用来统计实际刷上的长度用的。而0 To 10000这根木头的长度与集合无关,仅仅是元素取值的问题。比如,我是用Int(rnd*10001)来取的随机数。后来为了使程序测试更有演示性采用Int(rnd*20)+(10000-20)这种办法使取得的短更小,增加程序工作的难度。毕竟真实的刷子刷一次的长度是有限的。而真实的刷子的长度其实更接近一个常量 。