List

Add

Info

Contact

Stats

To edit this entry i need username and password!
Fields marked * are required!

* Username:
* Password:
Type:	Sourcecode (WITHOUT BBCode support)
Name:	blub.bas
* Data: (max. 1 MB) Available TAG's (new window)	'############################################################################################################## 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
Filetype / Highlight:	freeBASIC
Action: