Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 30, 2020 12:10:11 GMT -5
I've created this little routine, which I'm semi proud of! It's less of a question and more of a update for anyone playing along at home and wanting something like this in future.
It places a little popup window adjacent to the mouse when you double click on an object, this will eventually display info associated with the object.
Add this, under 'start event tracking
#1.g "when leftButtonDouble coords"
And this SUB in a nice place elsewhere.
SUB coords handle$, xpos, ypos 'Get window coords STRUCT Rect, x1 As Long, y1 As Long, x2 As Long, y2 As Long : MapCordshandle = hwnd(#1) CallDLL #user32, "GetWindowRect", MapCordshandle as uLong, Rect As struct, result As Long CurrentMapWinPosX = Rect.x1.struct : CurrentMapWinPosY = Rect.y1.struct 'upper y coord
for n = 1 to objects
if xpos>object(n,x) and xpos<object(n,x)+20 and ypos>object(n,y) and ypos<object(n,y)+20 then print "Item: ";n UpperLeftX = CurrentMapWinPosX + MouseX + 10: UpperLeftY = CurrentMapWinPosY + MouseY : WindowWidth = 50 : WindowHeight = 30 STATICTEXT #comp.1, "", 10, 10, 100, 18
IF comp = 0 THEN comp = 1 OPEN "Component" FOR window_popup as #comp #comp.1, object(n,z) #1.g "when mouseMove [CloseCoordsCompWindow]" END IF
exit for end if next END SUB
[CloseCoordsCompWindow]
IF comp THEN CLOSE #comp #1.g "when mouseMove" comp = 0 END IF WAIT
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jul 30, 2020 14:49:35 GMT -5
Please could someone help me with this. I have the background able to move, the sprites follow the background, but if the background is not in the zero X and Y positions when placing an object it places it incorrectly or moving the background up or down causes it again to draw the sprite higher or lower than it should be. I can't seem to get the balance right with adding or subtracting the BackGrounds X and BGY positions to the object array stored positions. However I think I've tried every combination. I'm sure there's a simple solution to this and I can't face starting from scratch again as I think I'm close to getting this working. Obviously, there are poeple here a damn sight better at this and if you feel I need to start again then that's what I'll have to do.
' ** Thanks to & Code contributions/stolen from ' ** Rod Bird ' ** Ideas from tenochtitlanuk post
'nomainwin
'To do 'ADD MAP DATA PATH FROM FILENAME
GOTO [SkipFile] [Start] templateFileString$ = DefaultDir$ + "\Maps\*.bmp"
FILEDIALOG "Open map", templateFileString$, imgfile$ if imgfile$<>"" then print imgfile$ mapchipnumber$ = afterlast$(imgfile$, "\") print mapchipnumber$ mapID$ = LEFT$(mapchipnumber$,6) print mapID$ 'Run check to see if its just numbers in the CHIP NUMBER field CheckString$ = "1234567890" FOR inpos = 1 TO LEN(mapID$) digit$ = MID$(mapID$, inpos, 1) print "digit$ = "; digit$ IF INSTR(CheckString$, digit$) = 0 THEN NOTICE "Warning!" + chr$(13) + "Map name must be the chip number of the site. Either you have selected a map without this or it is not a SIA 3/4 6 digit number. Please rename the map to the correct format or choose CANCEL on the next screen" : GOTO [Start] NEXT ELSE NOTICE "Warning!" + chr$(13) + "No image file chosen. Closing." END END IF
[SkipFile]
imgfile$ = "Maps\000003.bmp" 'Remove this when not skipping file selection above
DIM object(1000,10) DIM AlarmIcon(50,10) DIM info$(0,0) 'Array for check4files sub, filexists
'Define file paths iconimg$ = DefaultDir$ + "\Images\Icons\" maskimg$ = DefaultDir$ + "\Images\Masked\" mappath$ = DefaultDir$ + "\Maps\Data\"
'load the map image and get its size 'file$="Maps\000001.bmp"
open imgfile$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) bmpw=value(mid$(bmp$,19,4))'width bmph=value(mid$(bmp$,23,4))'height
close #bmp
'now find out how much space the 'window style takes for frame and title WindowWidth=200 WindowHeight=200 open "Measuring" for graphics_nf_nsb as #1 #1, "home ; down ; posxy x y" ThemeWidth=WindowWidth-2*x ThemeHeight=WindowHeight-2*y close #1
WindowWidth = bmpw+ThemeWidth-2 if WindowWidth>DisplayWidth then WindowWidth=DisplayWidth WindowHeight = bmph+ThemeHeight-2 if WindowHeight>DisplayHeight then WindowHeight=DisplayHeight UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2 graphicbox #1.g 0,0, WindowWidth , WindowHeight BGWW = WindowWidth : BGWH = WindowHeight
print "bmpw = ";bmpw;" bmph = ";bmph; " WindowWidth "; BGWW;" WindowHeight "; BGWH
STYLEBITS #1, 0, _WS_MINIMIZEBOX, 0, 0 open "Alarm" for window_nf as #1 #1 "trapclose quit" loadbmp "image",imgfile$ #1.g "down ; background image" 'print imgfile$ '#1.g "addsprite image image"
#1.g "drawsprites"
global BGX, BGY global type,x, y, w, h, zone, objects, currentobject, iconimg$, maskimg$, mappath$, mapID$, comp, MaxIcons, Icontype, IconSize
z=1 'zone object assigned to type=2 'type of object 1=door 2=pir x=3 'x y=4 'y w=5 'width of object h=6 'hight of object MaxIcons = 40 Icontype = 0 IconSize = 40 '20 or 40 60 is too big
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete" #1.g "when leftButtonDouble coords"
call LoadMapImages call LoadObjects CALL EditWindow #1.g "backgroundxy ";BGX;" ";BGY #1.g "drawsprites" ' #1.g "flush"
wait
[up] print "UP" IF BGY <= 0 THEN WAIT BGY = BGY - 100 PRINT "BGX="; BGX ; "BGY=" ; BGY #1.g "backgroundxy ";BGX;" ";BGY for moveobj = 1 TO objects #1.g "spritexy s";moveobj;" ";object(moveobj,x) - BGX;" ";object(moveobj,y) - BGY next #1.g "drawsprites" WAIT
[down] print "DOWN" IF BGY >= bmph THEN WAIT IF bmph > BGWH THEN displayed = bmph - BGWH IF displayed <= BGY THEN WAIT BGY = BGY + 100 PRINT "BGX="; BGX ; "BGY=" ; BGY #1.g "backgroundxy ";BGX;" ";BGY for moveobj = 1 TO objects #1.g "spritexy s";moveobj;" ";object(moveobj,x) - BGX;" ";object(moveobj,y) - BGY next #1.g "drawsprites" END IF WAIT
[left] PRINT "LEFT" IF BGX <= 0 THEN WAIT BGX = BGX - 100 PRINT "BGX="; BGX ; "BGY=" ; BGY #1.g "backgroundxy ";BGX;" ";BGY for moveobj = 1 TO objects #1.g "spritexy s";moveobj;" ";object(moveobj,x) - BGX;" ";object(moveobj,y) - BGY next #1.g "drawsprites" WAIT
[right] PRINT "RIGHT" IF bmpw < BGWW THEN WAIT BGX = BGX + 100 PRINT "BGX="; BGX ; "BGY=" ; BGY #1.g "backgroundxy ";BGX;" ";BGY for moveobj = 1 TO objects #1.g "spritexy s";moveobj;" ";object(moveobj,x) - BGX;" ";object(moveobj,y) - BGY next #1.g "drawsprites" WAIT
SUB checkaction h$,xpos,ypos
'check if we clicked on a known object found=0
print "xpos :";xpos;" ypos :";ypos; " | xpos-BGX :";xpos - BGX;" ypos-BGY :";ypos - BGY
for n = 1 to objects
if xpos>object(n,x) - BGX and xpos<object(n,x) - BGX + IconSize and ypos>object(n,y) - BGY and ypos<object(n,y) - BGY + IconSize then found=1 print "object " ; n ; " " ; object(n,x) ; " " ; object(n,y) exit for END IF
'added this to see if adding instead of subtracting the background image position helped, it doesn't if xpos>object(n,x) + BGX and xpos<object(n,x) + BGX + IconSize and ypos>object(n,y) + BGY and ypos<object(n,y) + BGY + IconSize then found=1 print "object " ; n ; " " ; object(n,x) ; " " ; object(n,y) exit for END IF
'Original cpde 'if xpos>object(n,x) and xpos<object(n,x) +IconSize and ypos>object(n,y) and ypos<object(n,y)+IconSize then ' found=1 ' exit for 'end if
next
if found then 'Start tracking #1.g "when leftButtonUp [stoptracking]" #1.g "when leftButtonMove [trackit]" wait
[trackit] object(n,x) = MouseX - 10 object(n,y) = MouseY - 10 #1.g "spritexy s";n;" ";object(n,x);" ";object(n,y) #1.g "backgroundxy ";BGX;" ";BGY #1.g "drawsprites" wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp" '#1.g "when mouseMove"
end if
if found=0 and Icontype<>0 then
'so there was nothing in the cell so we are adding the currently selected object to the cell objects=objects+1 object(objects,type) = Icontype object(objects,x) = xpos + BGX - 10 object(objects,y) = ypos + BGY - 10 print object(objects,x) print object(objects,y) #1.g "addsprite s";objects;" i";object(objects,type) #1.g "spritexy s";objects;" ";object(objects,x) + BGX;" ";object(objects,y) + BGY #1.g "backgroundxy ";BGX;" ";BGY #1.g "drawsprites" #2.gb "UP ; GOTO 40 320 ; DOWN ; drawbmp e0" ; 'Clear Icon selection in edit window Icontype=0 CALL DefineObject objects, ZoneNumber$
object(objects,zone) = VAL(ZoneNumber$) END IF END SUB
SUB coords handle$, xpos, ypos print handle$ , xpos, ypos 'Get window coords STRUCT Rect, x1 As Long, y1 As Long, x2 As Long, y2 As Long : MapCordshandle = hwnd(#1) CallDLL #user32, "GetWindowRect", MapCordshandle as uLong, Rect As struct, result As Long CurrentMapWinPosX = Rect.x1.struct : CurrentMapWinPosY = Rect.y1.struct 'upper y coord
for n = 1 to objects if xpos>object(n,x)- BGX and xpos < object(n,x)- BGX + IconSize and ypos > object(n,y) - BGY and ypos < object(n,y) - BGY + IconSize then print "Item: ";n UpperLeftX = CurrentMapWinPosX + MouseX: UpperLeftY = CurrentMapWinPosY + MouseY + 10 : WindowWidth = 50 : WindowHeight = 30 STATICTEXT #comp.1, "", 5, 5, 50, 18 IF comp = 0 THEN comp = 1 OPEN "Component" FOR window_popup as #comp #comp.1 "!font Trebuchet 12 BOLD" #comp.1, object(n,zone) #1.g "when mouseMove [CloseCoordsCompWindow]" END IF exit for end if next END SUB
[CloseCoordsCompWindow] IF comp THEN CLOSE #comp #1.g "when mouseMove" comp = 0 END IF WAIT
sub checkdelete h$,xpos,ypos found=0 for n = 1 to objects if xpos>object(n,x) - BGX and xpos<object(n,x)- BGX +IconSize and ypos>object(n,y)-BGY and ypos<object(n,y)- BGY +IconSize then found=1 PRINT "Delete Sub - Found object at: "; xpos;" x "; ypos ; " object ";n CONFIRM "Are you sure you wish to DELETE object " + STR$(n) + ". Zone number " + STR$(object(n,zone)) + "?"; Answer$ IF Answer$ = "no" THEN WAIT exit for end if 'n now contains the object id of the object to delete next
'now delete object if found if found then for i = n to objects 'overwrite n with all subsequent objects to erase it #1.g "removesprite s";i 'deal with lst object or sole object if objects =1 or i=objects then object(i,x)=0 object(i,y)=0 object(i,type)=0 object(i,zone)=0 else object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type)=object(i+1,type) object(i,zone)=object(i+1,zone) #1.g "addsprite s";i;" i";object(i,type) #1.g "spritexy s";i;" ";object(i,x);" ";object(i,y) end if next objects=objects-1 end if #1.g "backgroundxy ";BGX;" ";BGY #1.g "drawsprites" END SUB
SUB EditWindow 'place floating Alarmset image WindowWidth = 500 : WindowHeight = 420 UpperLeftX = 200 : UpperLeftY = 200
'set window stylebits to stay on top style= _WS_EX_TOPMOST Stylebits #2, 0, 0,_WS_EX_TOOLWINDOW OR style, 0
'set graphicbox stylebits to no border stylebits #2.gb, 0, _WS_BORDER, 0, 0 graphicbox #2.gb 0,0,300,400
'setup buttons for map movement statictext #2.stxt1, "Map Controls", 350, 5, 200, 20 button #2.bu, "UP", [up], UL, 370, 30, 50, 30 button #2.bd, "DOWN", [down], UL, 370, 110, 50, 30 button #2.bl, "LEFT", [left], UL, 320, 70, 50, 30 button #2.br, "RIGHT", [right], UL, 420, 70, 50, 30
OPEN "Item Selection" for window as #2 #2, "trapclose quit" #2.stxt1, "!font Trebuchet 12 bold"
' start event tracking #2.gb, "when leftButtonMove movewindow" #2.gb, "when leftButtonUp checkicon"
'Setup and draw object and text in lower part of edit window for icon selection #2.gb, "UP ; GOTO 0 300 ; DOWN ; font Trebuchet 12" #2.gb, "\-Current Icon-" #2.gb "UP ; GOTO 40 320 ; DOWN ; drawbmp e0" ;
'Setup position to start drawing icons #2.gb, "UP ; GOTO 0 0"
FOR il = 1 TO MaxIcons
IF il <= 7 THEN xline = 0 : yline = il1 * IconSize : il1 = il1 + 1 IF il >= 8 THEN xline = IconSize : yline = il2 * IconSize : il2 = il2 + 1 IF il >= 15 THEN xline = IconSize *2: yline = il3 * IconSize : il3 = il3 + 1 IF il >= 22 THEN xline = IconSize *3: yline = il4 * IconSize: il4 = il4 + 1 IF il >= 29 THEN xline = IconSize *4: yline = il5 * IconSize: il5 = il5 + 1 IF il >= 36 THEN xline = IconSize *5: yline = il6 * IconSize: il6 = il6 + 1 IF il >= 43 THEN xline = IconSize *6: yline = il7 * IconSize: il7 = il7 + 1
'print "il ";il;" xline ";xline;" yline ";yline #2.gb,"UP ; GOTO ";xline;" ";yline ;" ; DOWN ; drawbmp e" ; il
AlarmIcon(il,x) = xline 'x position AlarmIcon(il,y) = yline 'il * IconSize 'y position AlarmIcon(il,w) = IconSize 'Not used yet but maybe in future if we ever use multiple icon sizes AlarmIcon(il,h) = IconSize '
'print "AlarmIcon(il,x):"; AlarmIcon(il,x) 'print "AlarmIcon(il,y):"; AlarmIcon(il,y)
NEXT #2.gb "flush" END SUB
'This sub checks to see if we've clicked on the Icon Select window (EditWindow) sub checkicon h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize print gridX , gridY FOR n = 1 to MaxIcons if h$ = "#2.gb" AND AlarmIcon(n,x) = gridX AND AlarmIcon(n,y) = gridY THEN Icontype = n 'Draw icon in the current selection area of the Edit window #2.gb "UP ; GOTO 40 320 ; DOWN ; drawbmp e" ; n PRINT "Gx:";gridX; " Gy:";gridY;" Icon = ";Icontype ; " h$ "; h$ EXIT FOR END IF NEXT end sub
SUB quit h$ CALL SaveObjects CLOSE #1 CLOSE #2 END END SUB
SUB movewindow h$,xpos,ypos 'this is Called whenever we drag the popup icon image window hMain = HWND(#2) CALLDLL #user32, "ReleaseCapture",r As void CALLDLL #user32, "SendMessageA",hMain As ULong,_WM_NCLBUTTONDOWN As ULong,_HTCAPTION As Long,0 As Long,r As Long end SUB
'Load map icons
SUB LoadMapImages 'This loop creates images for the Edit window' edit window has a blank icon, which clears the selected item FOR a = 0 to MaxIcons LOADBMP "e" ; a , iconimg$ ; a ;".bmp" NEXT 'This loop creates images for the main mapping window FOR a = 1 to MaxIcons LOADBMP "i" ; a , maskimg$ ; a ;".bmp" NEXT END SUB
SUB DefineObject BYREF objects, BYREF ZoneNumber$ WindowWidth = 200 : WindowHeight = 180 stylebits #dow, _DS_CENTER,0,0,0 'centers dialog modal window statictext #dow.stxt1, "Object Number:", 10, 10, 110, 18 statictext #dow.objectno, "0000", 110, 10, 60, 18 statictext #dow.stxt2, "Device No.", 10, 40, 80, 18 textbox #dow.zonenumber, 100, 38, 50, 25 button #dow.dook, "OK", [doWinOK], UL, 100, 100, 80, 30 ' button #dow.doCancel, "Cancel", [doWinCancel], UL, 10, 100, 80, 30
Open "Define Object" for Dialog_modal as #dow #dow "trapclose [doWinCancel]" #dow "font trebuchet_ms 10" #dow.objectno, objects #dow.zonenumber, ZoneNumber$ Wait
[doWinOK] #dow.zonenumber, "!contents? ZoneNumber$"; IF ZoneNumber$ = "" THEN CONFIRM "Zone number is blank, Are you sure?"; ConfResult$ if ConfResult$ = "no" THEN WAIT
[doWinCancel] close #dow
END SUB
'*************************************************LOAD & SAVE MAP********************************************************* SUB SaveObjects OPEN mappath$ + mapID$ + ".txt" FOR OUTPUT AS #saveFile FOR index = 1 TO objects a$ = STR$(object(index,zone)) b$ = STR$(object(index,type)) c$ = STR$(object(index,x)) d$ = STR$(object(index,y)) e$ = STR$(object(index,w)) f$ = STR$(object(index,h)) g$ = STR$(object(index,7)) h$ = STR$(object(index,8)) FileContents$ = a$ + "," + b$ + "," + c$ + "," + d$ + "," + e$ + "," + f$ + "," + g$ + "," + h$ PRINT #saveFile, FileContents$ PRINT "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
'************REMOVE THIS FROM MAPS bas WHEN AMALGAMATING TO MAIN ALARM HANDLER PROGRAM*********** 'Function to determine if a file exists function fileExists(path$, filename$) files path$, filename$, info$() fileExists = val(info$(0, 0)) 'non zero is true end function '*****************************************************************************************
SUB LoadObjects
'Check to see if a map plan file exists already, if not create one. IF fileExists(mappath$, mapID$ + ".txt") THEN PRINT "Map found" OPEN mappath$ + mapID$ + ".txt" FOR INPUT AS #readFile ELSE PRINT "Map Not Found" OPEN mappath$ + mapID$ + ".txt" FOR APPEND AS #readFile End If
objects=0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$, g$, h$ object(objects,zone) = VAL(a$) object(objects,type) = VAL(b$) ' Icontype object(objects,x) = VAL(c$) ' x position object(objects,y) = VAL(d$) ' y position object(objects,w) = VAL(e$) object(objects,h) = VAL(f$) object(objects,7) = VAL(g$) object(objects,8) = VAL(h$) #1.g "addsprite s";objects;" i";object(objects,type) #1.g "spritexy s";objects;" ";object(objects,x);" ";object(objects,y) WEND #1.g "backgroundxy ";BGX;" ";BGY #1.g "drawsprites" CLOSE #readFile
END SUB
function value(x$) 'Another Rod sizing function, I think. select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
Maps.zip (209.77 KB)
|
|