'##############################################################################################################
Type Data_Type
V_Time As Double
V_Raster As Uinteger
V_Width As Uinteger
V_Height As Uinteger
V_Dat As Ubyte Ptr
End Type
'##############################################################################################################
Type Point_Type
V_Next As Point_Type Ptr
V_Prev As Point_Type Ptr
V_X As Uinteger
V_Y As Uinteger
End Type
Type Item_Type
V_Next As Item_Type Ptr
V_Prev As Item_Type Ptr
V_Raster As Uinteger
V_PointF As Point_Type Ptr
V_PointL As Point_Type Ptr
V_PointC As Uinteger
V_RectX1 As Uinteger
V_RectY1 As Uinteger
V_RectX2 As Uinteger
V_RectY2 As Uinteger
End Type
'##############################################################################################################
Sub Cluster(V_Data As Data_Type Ptr, Byref R_ItemsF As Item_Type Ptr, Byref R_ItemsL As Item_Type Ptr, V_Key As Ubyte)
Do Until R_ItemsF = 0
R_ItemsL = R_ItemsF->V_Next
With *R_ItemsF
Do Until .V_PointF = 0
.V_PointL = .V_PointF->V_Next
Deallocate(.V_PointF)
.V_PointF = .V_PointL
Loop
End With
Deallocate(R_ItemsF)
R_ItemsF = R_ItemsL
Loop
Dim X As Uinteger
Dim Y As Uinteger
Dim Z As Uinteger
Dim V As Uinteger
Dim VV As Integer
Dim XX As Integer
Dim XY As Integer
Dim LX As Integer
Dim LY As Integer
Dim NX As Integer
Dim NY As Integer
Dim NP As Integer
Dim RX1 As Uinteger
Dim RX2 As Uinteger
Dim RY1 As Uinteger
Dim RY2 As Uinteger
Dim XTot As Double = Timer + 0.5
Dim TSCol As Uinteger
Dim TFirstL As Ubyte
Dim TWayL As Uinteger
Dim TGroupOK As Ubyte
Dim TAdr As Uinteger
Dim TXX As Integer
Dim TYY As Integer
Dim TXFlag As Ubyte
Dim TXPtr As Uinteger Ptr
Dim TempX As Uinteger
Dim TPointF As Point_Type Ptr
Dim TPointL As Point_Type Ptr
With *V_Data
Dim TImgW As Uinteger = (.V_Width / .V_Raster)
Dim TImgH As Uinteger = (.V_Height / .V_Raster)
Dim TDat As Ubyte Ptr = Callocate(TImgW * TImgH)
For Y = 0 To TImgH - 1
For X = 0 To TImgW - 1
' Line(X * .V_Raster - 1, Y * .V_Raster - 1)-(X * .V_Raster + .V_Raster - 1, Y * .V_Raster + .V_Raster - 1), &HFFFFFF, BF
' sleep 1000, 1
If .V_Dat[(Y * TImgW) + X] = V_Key Then
' Line(X * .V_Raster - 1, Y * .V_Raster - 1)-(X * .V_Raster + .V_Raster - 1, Y * .V_Raster + .V_Raster - 1), &HFF00FF, BF
If TDat[(Y * TImgW) + X] < 100 Then
If TDat[(Y * TImgW) + X] < 255 Then TDat[(Y * TImgW) + X] += 1
TWayL = 1
TGroupOK = 0
XX = X: XY = Y
For Z = X To 0 Step -1
If TDat[(Y * TImgW) + Z] <> V_Key Then
XX = Z: XY = Y
Exit For
End If
Next
LX = XX + 1
LY = XY
RX1 = XX: RX2 = XX
RY1 = XY: RY2 = XY
Do
For Z = 1 To 8
Select Case Z
Case 1: If (XX - 1 = LX) And (XY - 1 = LY) Then NP = Z + 1: Exit For
Case 2: If (XX - 1 = LX) And (XY = LY) Then NP = Z + 1: Exit For
Case 3: If (XX - 1 = LX) And (XY + 1 = LY) Then NP = Z + 1: Exit For
Case 4: If (XX = LX) And (XY + 1 = LY) Then NP = Z + 1: Exit For
Case 5: If (XX + 1 = LX) And (XY + 1 = LY) Then NP = Z + 1: Exit For
Case 6: If (XX + 1 = LX) And (XY = LY) Then NP = Z + 1: Exit For
Case 7: If (XX + 1 = LX) And (XY - 1 = LY) Then NP = Z + 1: Exit For
Case 8: If (XX = LX) And (XY - 1 = LY) Then NP = Z + 1: Exit For
End Select
Next
For Z = NP To 16
Select Case Z
Case 1, 9: NX = XX - 1 : NY = XY - 1
Case 2, 10: NX = XX - 1 : NY = XY
Case 3, 11: NX = XX - 1 : NY = XY + 1
Case 4, 12: NX = XX : NY = XY + 1
Case 5, 13: NX = XX + 1 : NY = XY + 1
Case 6, 14: NX = XX + 1 : NY = XY
Case 7, 15: NX = XX + 1 : NY = XY - 1
Case 8, 16: NX = XX : NY = XY - 1
End Select
If NX < 0 Then Exit For
If NX >= TImgW Then Exit For
If NY < 0 Then Exit For
If NY >= TImgH Then Exit For
TAdr = (NY * TImgW) + NX
If TDat[TAdr] > 100 Then Exit For
If .V_Dat[TAdr] = V_Key Then
If TDat[TAdr] < 255 Then TDat[TAdr] += 1
If RX1 > NX Then RX1 = NX
If RX2 < NX Then RX2 = NX
If RY1 > NY Then RY1 = NY
If RY2 < NY Then RY2 = NY
TWayL += 1
If TPointL <> 0 Then
TPointL->V_Next = Callocate(Sizeof(Point_Type))
TPointL->V_Next->V_Prev = TPointL
TPointL = TPointL->V_Next
Else
TPointL = Callocate(Sizeof(Point_Type))
TPointF = TPointL
End If
TPointL->V_X = NX
TPointL->V_Y = NY
Exit For
End If
If (X = NX) And (Y = NY) Then TGroupOK = 1: Exit For
' Sleep 1, 1
Next
If NX < 0 Then Exit Do
If NX >= TImgW Then Exit Do
If NY < 0 Then Exit Do
If NY >= TImgH Then Exit Do
If TDat[TAdr] > 100 Then Exit Do
If TDat[TAdr] < 255 Then TDat[TAdr] += 1
LX = XX: LY = XY
XX = NX: XY = NY
If (X = XX) And (Y = XY) Then TGroupOK = 1: Exit Do
If XTot < Timer() Then
' Sleep 1, 1
XTot = Timer + 0.3
End If
Loop
' TGroupOK = 0
If TGroupOK = 1 Then
If TWayL >= 10 Then '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
' TFirstL = 1
' For XY = 1 to TImgH - 2
' For XX = 1 to TImgW - 2
' If *(VORCO_Aly_Fielding1_ImgTP + (XY * TImgW) + XX) <> &H000000 Then
' If TFirstL = 1 Then
' R_ItemsC += 1
' TFirstL = 0
' End If
' *(VORCO_Aly_Fielding1_ImgFP + (XY * TImgW) + XX) = &H00FF00
' End If
' Next
' Next
If R_ItemsL <> 0 Then
R_ItemsL->V_Next = Callocate(Sizeof(Item_Type))
R_ItemsL->V_Next->V_Prev = R_ItemsL
R_ItemsL = R_ItemsL->V_Next
Else
R_ItemsL = Callocate(Sizeof(Item_Type))
R_ItemsF = R_ItemsL
End If
With *R_ItemsL
.V_Raster = V_Data->V_Raster
.V_PointF = TPointF
.V_PointL = TPointL
.V_PointC = TWayL
.V_RectX1 = RX1
.V_RectY1 = RY1
.V_RectX2 = RX2
.V_RectY2 = RY2
TPointF = 0
TPointL = 0
TXFlag = 0
End With
Else: TGroupOK = 0
End If
End If
If TGroupOK = 0 Then
Do Until TPointF = 0
TPointL = TPointF->V_Next
If TDat[(TPointF->V_Y * TImgW) + TPointF->V_X] > 0 Then TDat[(TPointF->V_Y * TImgW) + TPointF->V_X] -= 1
Deallocate(TPointF)
TPointF = TPointL
Loop
If TDat[(Y * TImgW) + X] > 0 Then TDat[(Y * TImgW) + X] -= 1
End If
If XTot < Timer() Then
' Sleep 1, 1
XTot = Timer + 0.3
End If
End If
End If
Next
Next
End With
End Sub
