PolygonEditorAmaya

code format="vbnet" ' Polygon Editor ' Andy Amaya ' 2009.06.25 ' This utility accompanies Sprite Collision Detection Tutorial ' http://justbasic.wikispaces.com/SpriteCollisionDetection

NoMainWin Global sw, sh, gw, gh, bmpWidth, bmpHeight, bitDepth, bt, mult Dim zoom$(8), scanline$(0), info$(0, 0) 'Fill the ListBox's zoom$ array with choices mult = 1 For i = 1 To 8 zoom$(i) = Str$(i)+"X" Next 'store polygon coordinates in the poly array Dim poly(1,200)

screen = 1 Select Case screen Case 1: sw = 640: sh =  480 Case 2: sw = 800: sh =  600 Case 3: sw = 1024: sh = 768 Case 4: sw = 1280: sh = 1024 End Select WindowWidth = sw :WindowHeight = sh   UpperLeftX=Int((DisplayWidth-WindowWidth)/2) UpperLeftY=Int((DisplayHeight-WindowHeight)/2) 'Open Standard Window with Graphic Box (canvas) Menu #1, "File",_ "LoadBMP", [LoadBitMap],_ "Save Data", [SaveData], |,_ "Exit", [xit] Menu#1, "Help", "Help",[helpFile] '=========================================================================   Button #1.btn1, "Load BMP",    [LoadBitMap] ,UL, 5,  20, 100, 25 Button #1.btn2, "Plot Points", [PlotPoints] ,UL, 5, 120, 100, 25 Button #1.btn3, "Save Data",  [SaveData],   UL, 5, 160, 100, 25 Button #1.btn4, "Exit",       [xit],        UL, 5, 400, 100, 25 '=========================================================================   StaticText #1.stx1, "Polygon Name", 5,  55, 100, 25 TextBox   #1.txt1,                 5,  80, 100, 25 StaticText #1.stx2, "Zoom Level", 5, 240, 100, 25 ListBox#1.lbx1, zoom$, [Zoom] , 5, 260, 100, 40

gw = sw-118 : gh = sh-40 xOrigin = 110   : yOrigin  = 0 GraphicBox #1.g, xOrigin, yOrigin, gw, gh   Open "Polygon Editor" For Window_nf As #1 #1 "Font Arial 12; TrapClose [xit]" #1.g "Down; Fill blue; Color black; BackColor blue; Flush" #1.btn1, "!Font Arial 10 Bold" '<sets button font #1.btn2, "!Font Arial 10 Bold" '<sets button font #1.btn3, "!Font Arial 10 Bold" '<sets button font #1.btn4, "!Font Arial 10 Bold" '<sets button font #1.txt1, "!Font Arial 10 Bold" #1.txt1, "noName" #1.stx1, "!Font Arial 10 Bold" #1.stx2, "!Font Arial 10 Bold" #1.lbx1, "Font Arial 10 Bold" h$ = "#1.g"

#1.g "BackColor red;Color white; when mouseMove moveMouse" Wait

[addPoint] 'mouse coordinates mx = MouseX        : my = MouseY 'zoom adjusted coordinates picX = Int(mx/mult) : picY = Int(my/mult) 'is this the first point? If pointCount = 0 Then 'clear out any existing values #1.g "Size 3; Color Green" #1.g "Place ";picX*mult;" ";picY*mult;"; CircleFilled 3; Size 1" poly(1,5) = picX   'This is the 1st polygon X coordinate poly(1,6) = picY   'This is the 1st polygon Y coordinate pointCount = 1 If picX >= bbw Then bbw = picX If picY >= bbh Then bbh = picY Else pointCount = pointCount + 1 poly(1,pointCount*2 + 3) = picX 'the next polygon X coord poly(1,pointCount*2 + 4) = picY 'the next polygon Y coord #1.g "Size mult; Color yellow; Line ";lastX;" ";lastY;" ";mx;" ";my #1.g "Size 3: Color Green; CircleFilled 3; Size 1" If picX >= bbw Then bbw = picX If picY >= bbh Then bbh = picY End If   numPoints = pointCount lastX = mx   lastY = my    Wait

[lastPoint] 'reset point counter pointCount = 0 #1.g "Size mult; Color yellow" #1.g "Line ";lastX;" ";lastY;" ";poly(1,5)*mult;" ";poly(1,6)*mult #1.g "Size 3: Color Green; CircleFilled 3; Size 1"

'turn off mouse click polling #1.g "when leftButtonDown; when rightButtonDown" Wait

[xit] If bmpLoaded = 1 Then UnloadBMP "temp" Close #1 End

[helpFile] help$ = DefaultDir$+"\Polygon Editor Instructions.htm" print help$ Run "C:\Program Files\Internet Explorer\IEXPLORE.EXE ";help$, SHOWMAXIMIZED Wait

[LoadBitMap] fileName$ = "" FileDialog "Open bitmap (.bmp)", "*.bmp", fileName$ If fileName$ <> "" Then Call readBMP fileName$ LoadBMP "temp",fileName$ bmpLoaded = 1: mult = 1 pointCount = 0 #h$ "Cls; Fill blue" #h$ "DrawBMP temp 0 0; Flush"';ox;" ";oy;"; Flush" Else Notice "Bitmap NOT Loaded!"+Chr$(13)+"Load BMP cancelled." Call status h$, 5, 70, "Open bitmap file: Cancelled." End If   'initial bounding box width and height values bbw = 0 : bbh = 0 Wait

[SaveData] fileCount = 1 fileCounter$ = Right$("000"+Str$(fileCount),3) #1.txt1, "!contents? polyName$" saveName$ = polyName$ + fileCounter$ While fileExists(DefaultDir$,saveName$+".txt")=1 fileCount = fileCount+1 fileCounter$ = Right$("000"+Str$(fileCount),3) saveName$ = polyName$+fileCounter$ Wend

Open saveName$+".txt" For Output As #dat 'number of "points per line" saved in each DATA statement ppl = 10   'change to suit your preference count = 0 If numPoints > 0 Then Print #dat, "[";polyName$;"]" Print #dat, "'==========================================================" Print #dat, "'Number of points used to define this polygon" Print #dat, "Data ";numPoints Print #dat, "'==========================================================" Print #dat, "'x & y offsets to place polygon anywhere on screen" Print #dat, "Data 0, 0  'change to appropriate on screen coords" Print #dat, "'==========================================================" Print #dat, "'width & height of the polygon's bounding box" Print #dat, "Data ";bbw + 1;", ";bbh + 1 Print #dat, "'==========================================================" Print #dat, "'The ";numPoints;" coordinate pairs are:" lastX = numPoints * 2 + 3 For i = 5 To lastX Step 2 If i = 5 Then Print #dat, "Data "; If numPoints > ppl Then count = count + 1 If count= ppl Then Print #dat, poly(1,i);",";poly(1,i+1) Print #dat, "Data "; count = 1 Else If i = lastX Then Print #dat, poly(1,i);",";poly(1,i+1) Else Print #dat, poly(1,i);",";poly(1,i+1);","; End If                   End If                Else If i = lastX Then Print #dat, poly(1,i);",";poly(1,i+1) Else Print #dat, poly(1,i);",";poly(1,i+1);","; End If               End If            Next i            Notice saveName$+".txt has been saved to disk." Else Notice "No data points to save!" bbw = 0 : bbh = 0 End If   Close #dat Wait

[PlotPoints] pointCount = 0 #1.g "Setfocus; when leftButtonDown [addPoint]; when rightButtonDown [lastPoint]" Wait

[Zoom] If bmpLoaded = 1 Then #1.g "Cls;Fill blue" lineLen = bmpWidth*bt #1.lbx1, "SelectionIndex? mult" If mult < 5 Then #1.g "Size "; mult Else #1.g "Size 1" End If       For j = 0 To bmpHeight- 1 count = 0 For i = 1 To lineLen-1 Step bt               t$ = Mid$(scanline$(j+1),i,bt) r$ = Str$(Asc(Mid$(t$,3,1))) g$ = Str$(Asc(Mid$(t$,2,1))) b$ = Str$(Asc(Mid$(t$,1,1))) clr$ = r$+" "+g$+" "+b$ If mult < 5 Then #1.g "Color ";clr$;"; Set ";count*mult;" ";j*mult+1 Else x1 = count * mult y1 = j * mult #1.g "Color ";clr$;"; BackColor ";clr$ #1.g "Place ";x1;" ";y1 #1.g "BoxFilled ";x1+mult;" ";y1+mult End If               count = count+1 Next i       Next j        #1.g "Color white; BackColor red;Size 1" End If   Wait

'====================================================== ' 'moveMouse' is a mouse movement event handler. ' Every time the mouse is moved the mouse coordinates ' are returned in the upper right corner of the ' graphic screen. '====================================================== Sub moveMouse handle$, x, y   mx = Int(MouseX/mult) my = Int(MouseY/mult) dx = gw - 60 'Show mouse coordinates #handle$ "Place ";dx;" 425;\             " #handle$ "Place ";dx;" 425;\";mx;" ";my End Sub

'==================================================================== ' This SUB reads a .BMP file from disk and places the bitmap data ' in the scanline$ array for later processing. '==================================================================== ' The only parameter is the path and file name of the bitmap to be ' placed in "fileName$" '==================================================================== ' NOTE: bt, bitDepth, bmpWidth & bmpHeight must be global variables '==================================================================== Sub readBMP fileName$ 'Open a bitmap Open fileName$ For Binary As #bmpIn 'get the length of the file lenFile = LOF(#bmpIn) 'get bmpHeaderInfo info$ = Input$(#bmpIn,29) 'get width of bmp bmpWidth = Asc(Mid$(info$,19,1))+Asc(Mid$(info$,20,1))*256 'get height of bmp bmpHeight = Asc(Mid$(info$,23,1))+Asc(Mid$(info$,24,1))*256 'Saved by LB/JB or MS Paint? bitDepth = Asc(Mid$(info$,29,1)) If bitDepth <> 24 And bitDepth <> 32 Then Notice Str$(bitDepth)+"-bit bitmaps not supported!" Exit Sub End If

'allocate only exact array space needed ReDim scanline$(bmpHeight)

Select Case bitDepth Case 24 lenHdr = 54 'MS Paint format bt = 3 Case 32 lenHdr = 66 'JB/LB GetBMP format bt = 4 End Select 'Set to start of bitmap color triplets Seek #bmpIn,lenHdr 'load in all bitmap triplet data all$ = Input$(#bmpIn,lenFile-lenHdr) 'all done, close BMP Close #bmpIn

'check for correct bmp data length If (lenFile-lenHdr) Mod bmpHeight = 0 Then 'MS Paint style bmp If bitDepth = 24 Then 'do scanlines require padding? checkPad = (bmpWidth*3) Mod 4 Select Case checkPad 'no padding Case 0: row = bmpWidth*3 'padded with 3 zeroes Case 1: row = bmpWidth*3+3 'padded with 2 zeroes Case 2: row = bmpWidth*3+2 'padded with 1 zero Case 3: row = bmpWidth*3+1 End Select Else 'LB/JB style bmp row = bmpWidth*4 End If

'Reverse the order of scanlines and store in scanline$ array For i = bmpHeight-1 To 0 Step -1 count = count + 1 scanline$(count) = Mid$(all$, row*i+1, row) Next i   Else Notice "Cannot process this type of bitmap!" End If End Sub

Sub text h$, x, y, message$ #h$,"Place ";x;" ";y;";\";message$ End Sub

Sub status h$, x, y, msg$ #h$ "Font Arial 10 Bold" #h$ "Color white; BackColor red; Place ";x;" ";y;";|";msg$ End Sub

Function fileExists(path$, filename$) 'dimension the array info$( at the beginning of your program Files path$, filename$, info$  fileExists = Val(info$(0, 0))  'non zero is true End Function code