Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Dim As UInteger w,h,x,y,count
- Dim As String shapedata
- ScreenRes 640,480,32
- Dim As Any Ptr horse,temp,t2
- horse = ImageCreate(640,480)
- temp = ImageCreate(640,480)
- t2 = ImageCreate(640,480,RGBA(0,0,0,255))
- BLoad "batman.bmp",horse
- BLoad "batman.bmp",temp
- Put (0,0),horse,PSet 'place on display
- Put (1,0),horse,Xor 'xor x shifted version onto display
- Put temp,(0,1),horse,Xor 'xor y shifted version onto temp
- Put temp,(0,0),t2,Or 'reset alpha channel
- Put (0,0),temp,Or 'or shifted versions together onto display
- BSave ExePath + "\horseOutline.bmp",0
- BLoad ExePath + "\horseOutline.bmp",temp 'load the outline image
- ImageInfo temp,w,h 'get image dimensions
- Color RGB(255,255,255)
- Cls
- Put (0,0),temp,PSet 'draw outline image on screen
- Locate 3,40
- Print "TRAVERSING"
- 'create outline data file
- Open ExePath + "\oTdata.txt" For Output As #1
- Do
- 'scan for line starting point from the top to the bottom
- ' and from the left to the right
- For y = 2 To h-1
- For x = 2 To w-1 'scan line
- If POINT (x,y,temp) <> RGBA(0,0,0,255) Then
- Exit For,For 'line found
- EndIf
- Next
- Next
- If (x = w) And (y = h) Then 'no line found => end scanning
- Exit Do
- EndIf
- Print #1,x 'line starting point
- Print #1,y
- Do 'traverse line
- PSet (x,y),RGB(255,0,0) 'set pixel on screen for control
- PSet temp,(x,y),RGBA(0,0,0,255) 'delete scanned pixel
- If POINT (x+1,y,temp) <> RGBA(0,0,0,255) Then 'right
- x += 1
- shapedata += Chr(50)
- ElseIf POINT (x-1,y,temp) <> RGBA(0,0,0,255) Then 'left
- x -= 1
- shapedata += Chr(51)
- ElseIf POINT (x,y+1,temp) <> RGBA(0,0,0,255) Then 'up
- y += 1
- shapedata += Chr(48)
- ElseIf POINT (x,y-1,temp) <> RGBA(0,0,0,255) Then 'down
- y -= 1
- shapedata += Chr(49)
- ElseIf (Point (x+1,y+1,temp) <> RGBA(0,0,0,255)) Then 'right/up
- x += 1
- y += 1
- shapedata += Chr(55)
- ElseIf (Point (x-1,y+1,temp) <> RGBA(0,0,0,255)) Then 'left/up
- x -= 1
- y += 1
- shapedata += Chr(54)
- ElseIf (Point (x+1,y-1,temp) <> RGBA(0,0,0,255)) Then 'left/down
- x += 1
- y -= 1
- shapedata += Chr(53)
- ElseIf (Point (x-1,y-1,temp) <> RGBA(0,0,0,255)) Then 'right/down
- x -= 1
- y -= 1
- shapedata += Chr(52)
- Else 'line ended
- Print #1, shapedata
- shapedata = ""
- Exit Do 'search for next line
- EndIf
- Sleep 1
- Loop
- Loop
- Close
- Locate 3,40
- Print " "
- ImageDestroy horse
- ImageDestroy temp
- 'draw image outline from the saved file
- Locate 3,40
- Print "DRAWING FROM FILE"
- Open ExePath + "\oTdata.txt" For Input As #1
- Do
- Input #1, x, y 'starting point
- PSet(x,y),RGB(0,255,0)
- Input #1, shapedata
- If Len(shapedata) = 0 Then 'single point
- Continue Do
- EndIf
- For count = 0 To Len(shapedata) - 1
- Select Case shapedata[count] - 48
- Case 0 'down
- y += 1
- Case 1 'up
- y -= 1
- Case 2 'right
- x += 1
- Case 3 'left
- x -= 1
- Case 4 'left/up
- x -= 1
- y -= 1
- Case 5 'right/up
- x += 1
- y -= 1
- Case 6 'left/down
- x -= 1
- y += 1
- Case 7 'right/down
- x += 1
- y += 1
- End Select
- PSet(x,y),RGB(0,255,0)
- Locate 31,40
- Print "^"
- Locate 30,30
- Print Mid(shapedata,count-10,20)
- Sleep 3, 1
- Next
- Loop Until Eof(1)
- Close
- Sleep
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement