Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. 
    
  2. 
    
  3. 
    
  4. '##############################################################################################################
    
  5. Type Data_Type
    
  6.     V_Time      As Double
    
  7.     V_Raster    As Uinteger
    
  8.     V_Width     As Uinteger
    
  9.     V_Height    As Uinteger
    
  10.     V_Dat       As Ubyte Ptr
    
  11. End Type
    
  12. 
    
  13. 
    
  14. 
    
  15. '##############################################################################################################
    
  16. Type Point_Type
    
  17.     V_Next      As Point_Type Ptr
    
  18.     V_Prev      As Point_Type Ptr
    
  19.     
    
  20.     V_X         As Uinteger
    
  21.     V_Y         As Uinteger
    
  22. End Type
    
  23. Type Item_Type
    
  24.     V_Next      As Item_Type Ptr
    
  25.     V_Prev      As Item_Type Ptr
    
  26.     
    
  27.     V_Raster    As Uinteger
    
  28.     V_PointF    As Point_Type Ptr
    
  29.     V_PointL    As Point_Type Ptr
    
  30.     V_PointC    As Uinteger
    
  31.     
    
  32.     V_RectX1    As Uinteger
    
  33.     V_RectY1    As Uinteger
    
  34.     V_RectX2    As Uinteger
    
  35.     V_RectY2    As Uinteger
    
  36. End Type
    
  37. 
    
  38. 
    
  39. 
    
  40. '##############################################################################################################
    
  41. 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)
    
  42. Do Until R_ItemsF = 0
    
  43.     R_ItemsL = R_ItemsF->V_Next
    
  44.     With *R_ItemsF
    
  45.         Do Until .V_PointF = 0
    
  46.             .V_PointL = .V_PointF->V_Next
    
  47.             Deallocate(.V_PointF)
    
  48.             .V_PointF = .V_PointL
    
  49.         Loop
    
  50.     End With
    
  51.     Deallocate(R_ItemsF)
    
  52.     R_ItemsF = R_ItemsL
    
  53. Loop
    
  54. Dim X As Uinteger
    
  55. Dim Y As Uinteger
    
  56. Dim Z As Uinteger
    
  57. Dim V As Uinteger
    
  58. Dim VV As Integer
    
  59. Dim XX As Integer
    
  60. Dim XY As Integer
    
  61. Dim LX As Integer
    
  62. Dim LY As Integer
    
  63. Dim NX As Integer
    
  64. Dim NY As Integer
    
  65. Dim NP As Integer
    
  66. Dim RX1 As Uinteger
    
  67. Dim RX2 As Uinteger
    
  68. Dim RY1 As Uinteger
    
  69. Dim RY2 As Uinteger
    
  70. Dim XTot As Double = Timer + 0.5
    
  71. Dim TSCol As Uinteger
    
  72. Dim TFirstL As Ubyte
    
  73. Dim TWayL As Uinteger
    
  74. Dim TGroupOK As Ubyte
    
  75. Dim TAdr As Uinteger
    
  76. Dim TXX As Integer
    
  77. Dim TYY As Integer
    
  78. Dim TXFlag As Ubyte
    
  79. Dim TXPtr As Uinteger Ptr
    
  80. Dim TempX As Uinteger
    
  81. Dim TPointF As Point_Type Ptr
    
  82. Dim TPointL As Point_Type Ptr
    
  83. With *V_Data
    
  84.     Dim TImgW As Uinteger = (.V_Width / .V_Raster)
    
  85.     Dim TImgH As Uinteger = (.V_Height / .V_Raster)
    
  86.     Dim TDat As Ubyte Ptr = Callocate(TImgW * TImgH)
    
  87.     For Y = 0 To TImgH - 1
    
  88.         For X = 0 To TImgW - 1
    
  89. '           Line(X * .V_Raster - 1, Y * .V_Raster - 1)-(X * .V_Raster + .V_Raster - 1, Y * .V_Raster + .V_Raster - 1), &HFFFFFF, BF
    
  90. '           sleep 1000, 1
    
  91.             If .V_Dat[(Y * TImgW) + X] = V_Key Then
    
  92. '               Line(X * .V_Raster - 1, Y * .V_Raster - 1)-(X * .V_Raster + .V_Raster - 1, Y * .V_Raster + .V_Raster - 1), &HFF00FF, BF
    
  93.                 If TDat[(Y * TImgW) + X] < 100 Then
    
  94.                     If TDat[(Y * TImgW) + X] < 255 Then TDat[(Y * TImgW) + X] += 1
    
  95.                     TWayL = 1
    
  96.                     TGroupOK = 0
    
  97.                     XX = X: XY = Y
    
  98.                     For Z = X To 0 Step -1
    
  99.                         If TDat[(Y * TImgW) + Z] <> V_Key Then
    
  100.                             XX = Z: XY = Y
    
  101.                             Exit For
    
  102.                         End If
    
  103.                     Next
    
  104.                     LX = XX + 1
    
  105.                     LY = XY
    
  106.                     RX1 = XX: RX2 = XX
    
  107.                     RY1 = XY: RY2 = XY
    
  108.                     Do
    
  109.                         For Z = 1 To 8
    
  110.                             Select Case Z
    
  111.                                 Case 1: If (XX - 1  = LX) And (XY - 1   = LY) Then NP = Z + 1: Exit For
    
  112.                                 Case 2: If (XX - 1  = LX) And (XY       = LY) Then NP = Z + 1: Exit For
    
  113.                                 Case 3: If (XX - 1  = LX) And (XY + 1   = LY) Then NP = Z + 1: Exit For
    
  114.                                 Case 4: If (XX      = LX) And (XY + 1   = LY) Then NP = Z + 1: Exit For
    
  115.                                 Case 5: If (XX + 1  = LX) And (XY + 1   = LY) Then NP = Z + 1: Exit For
    
  116.                                 Case 6: If (XX + 1  = LX) And (XY       = LY) Then NP = Z + 1: Exit For
    
  117.                                 Case 7: If (XX + 1  = LX) And (XY - 1   = LY) Then NP = Z + 1: Exit For
    
  118.                                 Case 8: If (XX      = LX) And (XY - 1   = LY) Then NP = Z + 1: Exit For
    
  119.                             End Select
    
  120.                         Next
    
  121.                         For Z = NP To 16
    
  122.                             Select Case Z
    
  123.                                 Case 1, 9:  NX = XX - 1 :   NY = XY - 1
    
  124.                                 Case 2, 10: NX = XX - 1 :   NY = XY
    
  125.                                 Case 3, 11: NX = XX - 1 :   NY = XY + 1
    
  126.                                 Case 4, 12: NX = XX     :   NY = XY + 1
    
  127.                                 Case 5, 13: NX = XX + 1 :   NY = XY + 1
    
  128.                                 Case 6, 14: NX = XX + 1 :   NY = XY
    
  129.                                 Case 7, 15: NX = XX + 1 :   NY = XY - 1
    
  130.                                 Case 8, 16: NX = XX     :   NY = XY - 1
    
  131.                             End Select
    
  132.                             If NX < 0 Then Exit For
    
  133.                             If NX >= TImgW Then Exit For
    
  134.                             If NY < 0 Then Exit For
    
  135.                             If NY >= TImgH Then Exit For
    
  136.                             TAdr = (NY * TImgW) + NX
    
  137.                             If TDat[TAdr] > 100 Then Exit For
    
  138.                             If .V_Dat[TAdr] = V_Key Then
    
  139.                                 If TDat[TAdr] < 255 Then TDat[TAdr] += 1
    
  140.                                 If RX1 > NX Then RX1 = NX
    
  141.                                 If RX2 < NX Then RX2 = NX
    
  142.                                 If RY1 > NY Then RY1 = NY
    
  143.                                 If RY2 < NY Then RY2 = NY
    
  144.                                 TWayL += 1
    
  145.                                 If TPointL <> 0 Then
    
  146.                                     TPointL->V_Next = Callocate(Sizeof(Point_Type))
    
  147.                                     TPointL->V_Next->V_Prev = TPointL
    
  148.                                     TPointL = TPointL->V_Next
    
  149.                                 Else
    
  150.                                     TPointL = Callocate(Sizeof(Point_Type))
    
  151.                                     TPointF = TPointL
    
  152.                                 End If
    
  153.                                 TPointL->V_X = NX
    
  154.                                 TPointL->V_Y = NY
    
  155.                                 Exit For
    
  156.                             End If
    
  157.                             If (X = NX) And (Y = NY) Then TGroupOK = 1: Exit For
    
  158.     '                       Sleep 1, 1
    
  159.                         Next
    
  160.                         If NX < 0 Then Exit Do
    
  161.                         If NX >= TImgW Then Exit Do
    
  162.                         If NY < 0 Then Exit Do
    
  163.                         If NY >= TImgH Then Exit Do
    
  164.                         If TDat[TAdr] > 100 Then Exit Do
    
  165.                         If TDat[TAdr] < 255 Then TDat[TAdr] += 1
    
  166.                         LX = XX: LY = XY
    
  167.                         XX = NX: XY = NY
    
  168.                         If (X = XX) And (Y = XY) Then TGroupOK = 1: Exit Do
    
  169.                         If XTot < Timer() Then
    
  170.     '                       Sleep 1, 1
    
  171.                             XTot = Timer + 0.3
    
  172.                         End If
    
  173.                     Loop
    
  174.     '               TGroupOK = 0
    
  175.                     If TGroupOK = 1 Then
    
  176.                         If TWayL >= 10 Then     '# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
    
  177. '                           TFirstL = 1
    
  178. '                           For XY = 1 to TImgH - 2
    
  179. '                               For XX = 1 to TImgW - 2
    
  180. '                                   If *(VORCO_Aly_Fielding1_ImgTP + (XY * TImgW) + XX) <> &H000000 Then
    
  181. '                                       If TFirstL = 1 Then
    
  182. '                                           R_ItemsC += 1
    
  183. '                                           TFirstL = 0
    
  184. '                                       End If
    
  185. '                                       *(VORCO_Aly_Fielding1_ImgFP + (XY * TImgW) + XX) = &H00FF00
    
  186. '                                   End If
    
  187. '                               Next
    
  188. '                           Next
    
  189.                             If R_ItemsL <> 0 Then
    
  190.                                 R_ItemsL->V_Next = Callocate(Sizeof(Item_Type))
    
  191.                                 R_ItemsL->V_Next->V_Prev = R_ItemsL
    
  192.                                 R_ItemsL = R_ItemsL->V_Next
    
  193.                             Else
    
  194.                                 R_ItemsL = Callocate(Sizeof(Item_Type))
    
  195.                                 R_ItemsF = R_ItemsL
    
  196.                             End If
    
  197.                             With *R_ItemsL
    
  198.                                 .V_Raster   = V_Data->V_Raster
    
  199.                                 .V_PointF   = TPointF
    
  200.                                 .V_PointL   = TPointL
    
  201.                                 .V_PointC   = TWayL
    
  202.                                 .V_RectX1   = RX1
    
  203.                                 .V_RectY1   = RY1
    
  204.                                 .V_RectX2   = RX2
    
  205.                                 .V_RectY2   = RY2
    
  206.                                 TPointF = 0
    
  207.                                 TPointL = 0
    
  208.                                 TXFlag = 0
    
  209.                             End With
    
  210.                         Else: TGroupOK = 0
    
  211.                         End If
    
  212.                     End If
    
  213.                     If TGroupOK = 0 Then
    
  214.                         Do Until TPointF = 0
    
  215.                             TPointL = TPointF->V_Next
    
  216.                             If TDat[(TPointF->V_Y * TImgW) + TPointF->V_X] > 0 Then TDat[(TPointF->V_Y * TImgW) + TPointF->V_X] -= 1
    
  217.                             Deallocate(TPointF)
    
  218.                             TPointF = TPointL
    
  219.                         Loop
    
  220.                         If TDat[(Y * TImgW) + X] > 0 Then TDat[(Y * TImgW) + X] -= 1
    
  221.                     End If
    
  222.                     If XTot < Timer() Then
    
  223.     '                   Sleep 1, 1
    
  224.                         XTot = Timer + 0.3
    
  225.                     End If
    
  226.                 End If
    
  227.             End If
    
  228.         Next
    
  229.     Next
    
  230. End With
    
  231. End Sub