VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - Check两个物件是否相碰
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:9543, 日期:2001-09-28
 Check两个物件是否相碰


作者: cww 

    基本上这两个物件要是一个四方形的区域,如果是不规则形者,不在此限,
这个问题似乎没有很大的困难,不过API有提供了,何不用上一用省得程式得长,又
有Bug就不好了。
  另外,如果Check某个点有没有在某个RECT中,则用PtInRect API,这应没有什麽太困
难,所以没有范例,而某条线和Rect又有没有相交呢?似乎没有什麽API来做,所以可
以考虑使用PtInRect()来做,将线条的每个点传进去Check不就知道,只是如何取得线
条上的每一个点,我只会土法炼钢,程式臭臭长长的,不敢拿出来给大家叁考,所以
若有人有其演算法,可以Mail给我

注释:以下在.Bas中
Type RECT 注释:榘形的四个座标
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Type POINTAPI
        x As Long
        y As Long
End Type
Declare Function IntersectRect Lib "user32" (lpDestRect As RECT,  _
        lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Declare Function PtInRect Lib "user32" (lpRect As RECT,  _
        pt As POINTAPI) As Long

注释:Check rect1, rect2有没有相交集,若有,则Orect存相交集的四个座标
Public Function GetOverlap(rect1 As RECT, rect2 As RECT, Orect As RECT) _
       As  Boolean
Dim i As Long
GetOverlap = False
i = IntersectRect(Orect, rect1, rect2)
If i <> 0 Then GetOverlap = True
End Function

注释:以下在Form中,form中放两个CommandBox
Private Sub Form_Load()
Dim i As Long, rect1 As RECT, rect2 As RECT, rect3 As RECT
Dim oo As Boolean
rect1.Top = Command1.Top
rect1.Left = Command1.Left
rect1.Bottom = Command1.Top + Command1.Height
rect1.Right = Command1.Left + Command1.Width

rect2.Top = Command2.Top
rect2.Left = Command2.Left
rect2.Bottom = Command2.Top + Command2.Height
rect2.Right = Command2.Left + Command2.Width

oo = GetOverlap(rect1, rect2, rect3)
End Sub