|
Post by Rod on Jun 23, 2020 14:07:55 GMT -5
Yeah the flush is inside the loop it should be outside.so in DrawObjects move the flush outside the for n = 1 to objects loop
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 24, 2020 2:33:47 GMT -5
Thanks Rod, that managed to sneak back in during the edits! And I'm a little closer. I've had to reinstated the Grid system for the Icon selection window only, otherwise that went back to giving the 1 number higher issue like before, and basically I'm not clever enough to work out another way! I've added loads of print statements to help me try to find a reason for the "Attempt to access absent element" error. Originally I thought this was an issue with [trackit] routine. However I also get strange issues if you add an icon overlapping another object, by clicking just outside its box, you also get object randomly appearing about 30px away sometimes, so I'm thinking this could be an issue with the maths? EDIT: Overlapping isn't the issue. It's if you click on a known object. To replicate it, click once to add an object, click again on the same object, then add a 2nd anywhere else, then add a 3rd. It draws the 3rd then errors out (absent element).
'nomainwin
imgfile$="Maps\000001.jpg"
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type
DIM AlarmIcon(30,10) DIM object(1000,10) 'array index variables to aid access and understanding type = 2 x=3 y=4 w=5 h=6 MapZone = 8
MaxIcons = 5 'Total Icons to name and draw IconSize = 20 'Define icon/object image size Icontype = 1
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 5, 5, WindowWidth, WindowHeight
OPEN WindowTitle$ for window as #1 WinHandle1=hwnd(#1) #1 "trapclose quit" #1, "resizehandler resizer"
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete"
GOSUB [LoadBackground] CALL LoadMapImages CALL EditWindow CALL LoadObjects CALL DrawObjects
WAIT
SUB checkaction h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize Print "Grid X,Y:";gridX;" , ";gridY ; " window:";h$ ; " Mouse=" ; xpos , ypos
'first check if we have clicked to change Icontype IF gridX < 100 and gridY < 400 AND h$ = "#2.gb" THEN FOR n = 1 to MaxIcons if AlarmIcon(n,x) = gridX AND AlarmIcon(n,y) = gridY + IconSize THEN Icontype = n PRINT "Gx:";gridX; " Gy:";gridY;" Icon = "; Icontype EXIT FOR END IF NEXT ELSE
'check if we clicked on a known object found=0 for n = 1 to objects 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
'Start tracking #1.g "when leftButtonUp [stoptracking]" #1.g "when leftButtonMove [trackit]" wait
[trackit] object(n,x)=MouseX-10 object(n,y)=MouseY-10 Print "Trackit = "; MouseX , MouseY call DrawObjects wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp checkaction"
exit for end if next end if
if found = 0 AND h$ = "#1.g" THEN
'so there was nothing in the cell so we are adding the currently selected object to the cell PRINT "CheckAction Sub Pre Add - Icontype ";Icontype;" xpos ";xpos;" ypos = ";ypos;" objects =";objects objects=objects+1 object(objects,type) = Icontype object(objects,x) = xpos-10 object(objects,y) = ypos-10 PRINT "CheckAction Sub Post Add - Icontype ";Icontype;" xpos ";xpos;" ypos = ";ypos;" objects =";objects CALL DrawObjects END IF END SUB
sub checkdelete h$,xpos,ypos found=0 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 found=1 PRINT "Delete Sub - Found object at: "; xpos, ypos exit for end if 'n now contains the object id of the object to delete next
'now delete object if found if found then PRINT "Delete Sub - Deleting object from array number: "; n for i = n to objects 'overwrite n with all subsequent objects to erase it 'you will need to copy all object data x,y,w,h,type etc object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,type) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects Print "Drawing objects on screen" #1.g "delsegment drawing" #1.g "drawbmp image 0 0" FOR n = 1 to objects #1.g "drawbmp i";object(n,type);" ";object(n,x);" ";object(n,y) PRINT "Drawing: i";object(n,type);" ";object(n,x);" ";object(n,y);" objects =";n NEXT #1.g "flush drawing" END SUB
SUB EditWindow 'place floating Alarmset image WindowWidth = 118 : 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,105,400
OPEN "Item Selection" for window as #2 #2, "trapclose quit" ' start event tracking #2.gb, "when leftButtonMove movewindow" #2.gb, "when leftButtonUp checkaction" #2.gb, "UP ; GOTO 0 0"
FOR il = 1 TO MaxIcons #2.gb "down ; drawbmp i" ; il #2.gb,"UP ; GOTO 0 ";il * IconSize ;" ; DOWN" AlarmIcon(il,x) = 0 'x position is always 0 as they're all in line AlarmIcon(il,y) = 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 "il:"; il 'print "AlarmIcon(il,x):"; AlarmIcon(il,x) 'print "AlarmIcon(il,y)"; AlarmIcon(il,y)
NEXT
#2.gb "flush" END SUB
SUB quit h$ CALL SaveObjects if hBitmap<>0 then 'if an image has been loaded, delete it unloadbmp "image" 'Remove from memory calldll #gdi32,"DeleteObject",hBitmap as ulong, ret as ulong end if CLOSE #1 CLOSE #2 PRINT "END" END END SUB
'*************************************************LOAD & SAVE MAP********************************************************* SUB SaveObjects OPEN "plan.txt" FOR OUTPUT AS #saveFile FOR index = 1 TO objects a$ = STR$(object(index,1)) b$ = STR$(object(index,type)) c$ = STR$(object(index,x)) d$ = STR$(object(index,y)) e$ = STR$(object(index,5)) f$ = STR$(object(index,6)) g$ = STR$(object(index,7)) h$ = STR$(object(index,8)) FileContents$ = a$ + "," + b$ + "," + c$ + "," + d$ + "," + e$ + "," + f$ + "," + g$ + "," + h$ PRINT #saveFile, FileContents$ PRINT "Saving - index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects OPEN "plan.txt" FOR INPUT AS #readFile objects = 0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$, g$, h$ object(objects,1) = VAL(a$) object(objects,type) = VAL(b$) ' Icontype object(objects,x) = VAL(c$) ' x position object(objects,y) = VAL(d$) ' y position object(objects,5) = VAL(e$) object(objects,6) = VAL(f$) object(objects,7) = VAL(g$) object(objects,8) = VAL(h$) WEND CLOSE #readFile END SUB
'Load map icons SUB LoadMapImages FOR a = 1 to MaxIcons LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
'*************************************************WINDOW MOVE AND RESIZERS************************************************ SUB resizer handle$ WindowHeight = WindowHeight : WindowWidth = WindowWidth #1.g, "LOCATE 0 0 "; WindowWidth ; " " ; WindowHeight #1 "refresh" 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
'****************************************************GDIPLUS FUNCTIONS FOR LOADING IMAGES********************************* 'Code inspired by Dan Teel's GDIPlus example. 'Code from https://alycesrestaurant.com/gdip2.htm
function GDIPlusLoadImage(file$) open "gdiplus.dll" for dll as #gdiplus 'this struct will be filled by API functions STRUCT GDITOKEN, token as ulong 'we MUST fill this struct with GdiPlusVersion number STRUCT GdiplusStartupInput, GdiplusVersion as ulong, DebugEventCallback as ulong,SuppressBackgroundThread as long, SuppressExternalCodecs as long GdiplusStartupInput.GdiplusVersion.struct=1 'must be = 1 calldll #gdiplus,"GdiplusStartup", GDITOKEN as struct, GdiplusStartupInput as struct, status as ulong 'returns zero if successful token=GDITOKEN.token.struct if status<>0 then GDIPlusLoadImage=0 else wFile$=MultiByteToWideChar$(file$) calldll #gdiplus,"GdipCreateBitmapFromFile", wFile$ as ptr, GDITOKEN as struct,status as ulong 'returns zero if successful hBmpGdip=GDITOKEN.token.struct 'GDI+ bitmap returned in struct if status<>0 then GDIPlusLoadImage=0 else 'create GDI bitmap handle from GDI+ bitmap calldll #gdiplus,"GdipCreateHBITMAPFromBitmap", hBmpGdip as ulong, GDITOKEN as struct,0 as ulong,status as ulong 'returns zero if successful if status<>0 then GDIPlusLoadImage=0 else 'get a bitmap handle we can use with Liberty BASIC's LOADBMP GDIPlusLoadImage=GDITOKEN.token.struct end if calldll #gdiplus,"GdiplusShutdown", token as ulong,result as void 'no return from this function end if calldll #gdiplus,"GdiplusShutdown", token as ulong, result as void close #gdiplus end if end function
function MultiByteToWideChar$(String$) 'converts any string into unicode CodePage = 0 : dwFlags = 0 : cchMultiByte = -1 lpMultiByteStr$ = String$ : cchWideChar = len(String$) * 3 lpWideCharStr$ = space$(cchWideChar) calldll #kernel32, "MultiByteToWideChar", CodePage as ulong,dwFlags as ulong, lpMultiByteStr$ as ptr, cchMultiByte as long, lpWideCharStr$ as ptr, cchWideChar as long, result as long if result = 0 then MultiByteToWideChar$ = "" else MultiByteToWideChar$ = left$(lpWideCharStr$, result * 2) end if end function
Function BitmapWidth(hBmp) struct BITMAP,bmType as long,bmWidth As long,bmHeight As long, bmWidthBytes As long,bmPlanes as word,bmBitsPixel as word,bmBits as Long length=len(BITMAP.struct) calldll #gdi32, "GetObjectA", hBmp as ulong, length as long,BITMAP as struct,results as long BitmapWidth=BITMAP.bmWidth.struct End Function
Function BitmapHeight(hBmp) struct BITMAP,bmType as long,bmWidth As long,bmHeight As long, bmWidthBytes As long,bmPlanes as word,bmBitsPixel as word,bmBits as Long length=len(BITMAP.struct) calldll #gdi32, "GetObjectA", hBmp as ulong, length as long,BITMAP as struct,results as long BitmapHeight=BITMAP.bmHeight.struct End Function
[LoadBackground] if hBitmap<>0 then 'if an image has been loaded, delete it first unloadbmp "image" 'Remove from memory calldll #gdi32,"DeleteObject",hBitmap as ulong, ret as ulong 'turn off scrollbars #1.g "vertscrollbar off;horizscrollbar off" end if
hBitmap=GDIPlusLoadImage(imgfile$) if hBitmap<>0 then bmpWide=BitmapWidth(hBitmap) bmpHigh=BitmapHeight(hBitmap) if bmpWide>DisplayWidth then 'if width of bmp greater than maximum width of gbox, add scrollbar gboxWide=DisplayWidth - 100 #1.g "horizscrollbar on 0 ";bmpWide else 'set gbox width=image width gboxWide=bmpWide #1.g "horizscrollbar off" end if if bmpHigh>DisplayHeight then 'if height of bmp is greater than maximum height of gbox, add scrollbar gboxHigh=DisplayHeight - 100 #1.g "vertscrollbar on 0 ";bmpHigh else 'set gbox height=image height gboxHigh=bmpHigh #1.g "vertscrollbar off" end if
'resize gbox to fit image #1.g "locate 0 0 ";gboxWide;" ";gboxHigh 'image width and height #1 "refresh" print gboxWide; gboxHigh loadbmp "image",hBitmap #1.g "delsegment mainSegment; discard" 'remove graphics from memory #1.g "down ; drawbmp image 0 0;flush mainSegment"
CALLDLL #user32, "SetWindowPos",WinHandle1 as ulong,_HWND_TOP as ulong, UpperLeftX as long, UpperLeftY as long, gboxWide as long, gboxHigh as long, _SWP_SHOWWINDOW as long,re as boolean
else notice "Unable to load image file!" end if RETURN
|
|
|
Post by Rod on Jun 24, 2020 3:37:18 GMT -5
Try this checkaction. I think I was setting the event tracking too early and it was looping back on itself.
SUB checkaction h$,xpos,ypos
'first check if we have clicked to change Icontype IF h$ = "#2.gb" THEN FOR n = 1 to MaxIcons if xpos>AlarmIcon(n,x) and xpos<AlarmIcon(n,x)+20 and ypos>AlarmIcon(n,y) and ypos<AlarmIcon(n,y)+20 THEN Icontype = n EXIT FOR END IF NEXT ELSE
'check if we clicked on a known object found=0 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 found=1
'Start tracking #1.g "when leftButtonUp [stoptracking]" #1.g "when leftButtonMove [trackit]" wait
[trackit] object(n,x)=MouseX-10 object(n,y)=MouseY-10 call DrawObjects wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp"
exit for end if next end if
if found = 0 AND h$ = "#1.g" 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-10 object(objects,y) = ypos-10 CALL DrawObjects END IF #1.g "when leftButtonUp checkaction" END SUB
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 24, 2020 10:56:03 GMT -5
I feel like my signature should say, thanks Rod and Chris! Ok, so I think I have a solution. It seems that if you left click and hold, move the mouse, then release, it places 2 objects, one at down and another on release. I've moved stuff around and had to disable the tracking completely, which is a shame. But this seems to work.
'nomainwin
imgfile$="Maps\000001.jpg"
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type
DIM AlarmIcon(30,10) DIM object(1000,10) 'array index variables to aid access and understanding type = 2 x=3 y=4 w=5 h=6 MapZone = 8
MaxIcons = 5 'Total Icons to name and draw IconSize = 20 'Define icon/object image size Icontype = 1
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 5, 5, WindowWidth, WindowHeight
OPEN WindowTitle$ for window as #1 WinHandle1=hwnd(#1) #1 "trapclose quit" #1, "resizehandler resizer"
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete"
GOSUB [LoadBackground] CALL LoadMapImages CALL EditWindow CALL LoadObjects CALL DrawObjects
WAIT
SUB checkaction h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize Print "Grid X,Y:";gridX;" , ";gridY ; " window:";h$ ; " Mouse=" ; xpos , ypos
'first check if we have clicked to change Icontype IF gridX < 100 and gridY < 400 AND h$ = "#2.gb" THEN FOR n = 1 to MaxIcons if AlarmIcon(n,x) = gridX AND AlarmIcon(n,y) = gridY + IconSize THEN Icontype = n PRINT "Gx:";gridX; " Gy:";gridY;" Icon = "; Icontype EXIT FOR END IF NEXT ELSE
'check if we clicked on a known object found=0 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 found=1
'Start tracking #1.g "when leftButtonUDown [stoptracking]" '#1.g "when leftButtonMove [trackit]" wait
[stoptracking] object(n,x)=MouseX-10 object(n,y)=MouseY-10 call DrawObjects #1.g "when leftButtonMove" #1.g "when leftButtonUp" wait
exit for end if next end if
if found = 0 AND h$ = "#1.g" 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-10 object(objects,y) = ypos-10 CALL DrawObjects END IF
'#1.g "when leftButtonUp checkaction" END SUB
sub checkdelete h$,xpos,ypos found=0 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 found=1 PRINT "Delete Sub - Found object at: "; xpos, ypos exit for end if 'n now contains the object id of the object to delete next
'now delete object if found if found then PRINT "Delete Sub - Deleting object from array number: "; n for i = n to objects 'overwrite n with all subsequent objects to erase it 'you will need to copy all object data x,y,w,h,type etc object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,type) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects Print "Drawing objects on screen" #1.g "delsegment image" #1.g "delsegment drawing" #1.g "drawbmp image 0 0" FOR n = 1 to objects #1.g "drawbmp i";object(n,type);" ";object(n,x);" ";object(n,y) PRINT "Drawing: i";object(n,type);" ";object(n,x);" ";object(n,y);" objects =";n NEXT #1.g "flush drawing" END SUB
SUB EditWindow 'place floating Alarmset image WindowWidth = 118 : 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,105,400
OPEN "Item Selection" for window as #2 #2, "trapclose quit" ' start event tracking #2.gb, "when leftButtonMove movewindow" #2.gb, "when leftButtonUp checkaction" #2.gb, "UP ; GOTO 0 0"
FOR il = 1 TO MaxIcons #2.gb "down ; drawbmp i" ; il #2.gb,"UP ; GOTO 0 ";il * IconSize ;" ; DOWN" AlarmIcon(il,x) = 0 'x position is always 0 as they're all in line AlarmIcon(il,y) = 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 "il:"; il 'print "AlarmIcon(il,x):"; AlarmIcon(il,x) 'print "AlarmIcon(il,y)"; AlarmIcon(il,y)
NEXT
#2.gb "flush" END SUB
SUB quit h$ CALL SaveObjects if hBitmap<>0 then 'if an image has been loaded, delete it unloadbmp "image" 'Remove from memory calldll #gdi32,"DeleteObject",hBitmap as ulong, ret as ulong end if CLOSE #1 CLOSE #2 PRINT "END" END END SUB
'*************************************************LOAD & SAVE MAP********************************************************* SUB SaveObjects OPEN "plan.txt" FOR OUTPUT AS #saveFile FOR index = 1 TO objects a$ = STR$(object(index,1)) b$ = STR$(object(index,type)) c$ = STR$(object(index,x)) d$ = STR$(object(index,y)) e$ = STR$(object(index,5)) f$ = STR$(object(index,6)) g$ = STR$(object(index,7)) h$ = STR$(object(index,8)) FileContents$ = a$ + "," + b$ + "," + c$ + "," + d$ + "," + e$ + "," + f$ + "," + g$ + "," + h$ PRINT #saveFile, FileContents$ PRINT "Saving - index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects OPEN "plan.txt" FOR INPUT AS #readFile objects = 0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$, g$, h$ object(objects,1) = VAL(a$) object(objects,type) = VAL(b$) ' Icontype object(objects,x) = VAL(c$) ' x position object(objects,y) = VAL(d$) ' y position object(objects,5) = VAL(e$) object(objects,6) = VAL(f$) object(objects,7) = VAL(g$) object(objects,8) = VAL(h$) WEND CLOSE #readFile END SUB
'Load map icons SUB LoadMapImages FOR a = 1 to MaxIcons LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
'*************************************************WINDOW MOVE AND RESIZERS************************************************ SUB resizer handle$ WindowHeight = WindowHeight : WindowWidth = WindowWidth #1.g, "LOCATE 0 0 "; WindowWidth ; " " ; WindowHeight #1 "refresh" 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
'****************************************************GDIPLUS FUNCTIONS FOR LOADING IMAGES********************************* 'Code inspired by Dan Teel's GDIPlus example. 'Code from https://alycesrestaurant.com/gdip2.htm
function GDIPlusLoadImage(file$) open "gdiplus.dll" for dll as #gdiplus 'this struct will be filled by API functions STRUCT GDITOKEN, token as ulong 'we MUST fill this struct with GdiPlusVersion number STRUCT GdiplusStartupInput, GdiplusVersion as ulong, DebugEventCallback as ulong,SuppressBackgroundThread as long, SuppressExternalCodecs as long GdiplusStartupInput.GdiplusVersion.struct=1 'must be = 1 calldll #gdiplus,"GdiplusStartup", GDITOKEN as struct, GdiplusStartupInput as struct, status as ulong 'returns zero if successful token=GDITOKEN.token.struct if status<>0 then GDIPlusLoadImage=0 else wFile$=MultiByteToWideChar$(file$) calldll #gdiplus,"GdipCreateBitmapFromFile", wFile$ as ptr, GDITOKEN as struct,status as ulong 'returns zero if successful hBmpGdip=GDITOKEN.token.struct 'GDI+ bitmap returned in struct if status<>0 then GDIPlusLoadImage=0 else 'create GDI bitmap handle from GDI+ bitmap calldll #gdiplus,"GdipCreateHBITMAPFromBitmap", hBmpGdip as ulong, GDITOKEN as struct,0 as ulong,status as ulong 'returns zero if successful if status<>0 then GDIPlusLoadImage=0 else 'get a bitmap handle we can use with Liberty BASIC's LOADBMP GDIPlusLoadImage=GDITOKEN.token.struct end if calldll #gdiplus,"GdiplusShutdown", token as ulong,result as void 'no return from this function end if calldll #gdiplus,"GdiplusShutdown", token as ulong, result as void close #gdiplus end if end function
function MultiByteToWideChar$(String$) 'converts any string into unicode CodePage = 0 : dwFlags = 0 : cchMultiByte = -1 lpMultiByteStr$ = String$ : cchWideChar = len(String$) * 3 lpWideCharStr$ = space$(cchWideChar) calldll #kernel32, "MultiByteToWideChar", CodePage as ulong,dwFlags as ulong, lpMultiByteStr$ as ptr, cchMultiByte as long, lpWideCharStr$ as ptr, cchWideChar as long, result as long if result = 0 then MultiByteToWideChar$ = "" else MultiByteToWideChar$ = left$(lpWideCharStr$, result * 2) end if end function
Function BitmapWidth(hBmp) struct BITMAP,bmType as long,bmWidth As long,bmHeight As long, bmWidthBytes As long,bmPlanes as word,bmBitsPixel as word,bmBits as Long length=len(BITMAP.struct) calldll #gdi32, "GetObjectA", hBmp as ulong, length as long,BITMAP as struct,results as long BitmapWidth=BITMAP.bmWidth.struct End Function
Function BitmapHeight(hBmp) struct BITMAP,bmType as long,bmWidth As long,bmHeight As long, bmWidthBytes As long,bmPlanes as word,bmBitsPixel as word,bmBits as Long length=len(BITMAP.struct) calldll #gdi32, "GetObjectA", hBmp as ulong, length as long,BITMAP as struct,results as long BitmapHeight=BITMAP.bmHeight.struct End Function
[LoadBackground] if hBitmap<>0 then 'if an image has been loaded, delete it first unloadbmp "image" 'Remove from memory calldll #gdi32,"DeleteObject",hBitmap as ulong, ret as ulong 'turn off scrollbars #1.g "vertscrollbar off;horizscrollbar off" end if
hBitmap=GDIPlusLoadImage(imgfile$) if hBitmap<>0 then bmpWide=BitmapWidth(hBitmap) bmpHigh=BitmapHeight(hBitmap) if bmpWide>DisplayWidth then 'if width of bmp greater than maximum width of gbox, add scrollbar gboxWide=DisplayWidth - 100 #1.g "horizscrollbar on 0 ";bmpWide else 'set gbox width=image width gboxWide=bmpWide #1.g "horizscrollbar off" end if if bmpHigh>DisplayHeight then 'if height of bmp is greater than maximum height of gbox, add scrollbar gboxHigh=DisplayHeight - 100 #1.g "vertscrollbar on 0 ";bmpHigh else 'set gbox height=image height gboxHigh=bmpHigh #1.g "vertscrollbar off" end if
'resize gbox to fit image #1.g "locate 0 0 ";gboxWide;" ";gboxHigh 'image width and height #1 "refresh" print gboxWide; gboxHigh loadbmp "image",hBitmap #1.g "delsegment mainSegment; discard" 'remove graphics from memory #1.g "down ; drawbmp image 0 0;flush mainSegment"
CALLDLL #user32, "SetWindowPos",WinHandle1 as ulong,_HWND_TOP as ulong, UpperLeftX as long, UpperLeftY as long, gboxWide as long, gboxHigh as long, _SWP_SHOWWINDOW as long,re as boolean
else notice "Unable to load image file!" end if RETURN
It's a shame that it has to go through all the for loops as that slows the drawing down. With the Mainwin on once you get to 50 objects its very slow and flickery, with the Mainwin off it's better but not great. But I have little ability! So unless there's a Graphics Guru amongst us, it'll have to stay!
|
|
|
Post by Rod on Jun 24, 2020 13:49:22 GMT -5
I would need to go back to the drawing board to get the event changes right. However if you are drawing bmps there is no escaping redrawing the background which is where the flickering is coming from. Sprites might be a better option since they draw transparently over a static background.
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 24, 2020 15:40:44 GMT -5
Transparent! There was me trying to manipulate JPGs into transparent, so I didn't get the dodgy white background. When I should have been working with Sprites all this time! I know someone who has developed a great piece of software for making sprite etc......
|
|
|
Post by Rod on Jun 25, 2020 2:55:07 GMT -5
Ah it was me, can't see the wood for the trees. It was as simple as when leftButtonDown instead of Up! I was simplifying the code to find the problem. You will need to change the button handler for #2 to checkicon. On my machine the small bmps flicker but the main image is stable.
sub checkicon h$,xpos,ypos FOR n = 1 to MaxIcons if xpos>AlarmIcon(n,x) and xpos<AlarmIcon(n,x)+20 and ypos>AlarmIcon(n,y) and ypos<AlarmIcon(n,y)+20 THEN Icontype = n EXIT FOR END IF NEXT end sub
SUB checkaction h$,xpos,ypos
'check if we clicked on a known object found=0 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 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 call DrawObjects wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp" end if
if found=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-10 object(objects,y) = ypos-10 CALL DrawObjects
END IF #1.g "when leftButtonDown checkaction" END SUB
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 25, 2020 12:17:47 GMT -5
Rod, Thanks once again for your help and time on this.
I'm sure I tried both up and down in different combos to no avail.
I think Sprites maybe a way to turn. I'm unsure at the minute if this could be simply adjusted to turn to Sprites so I'm off to read the helpfile and perhaps to attempt it.
So I'll be back in about 5 minutes!
|
|
|
Post by Rod on Jun 25, 2020 14:06:47 GMT -5
it runs ok for me right now. to eliminate the icon bmp flickering we need to move to sprites but it introduces limitations. first off only one sprite window. second, you need to create a new sprite to add it to the diagram or hold a stack off screen to pull in. So perhaps a menu to add an object. You need a strategy. Also I was thinking that the PIR's need angled coverage sweeps. How to point them?
Actually quite a complex process.
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 27, 2020 6:07:52 GMT -5
So sprites adds another layer of confusion! Great!!
Addressing points -
Only one sprite window, well that can be accomplished by just having the selection window as just normal images which when selected add the type to a variable so we know which sprite to use.
Not 100% sure how to create a sprite yet, whether this has to be done before the icon is drawn to screen or at start of program. I assume this could be done on the fly, each new sprite is just named sequentially up by one number?
Flickering, isn't the end of the world, as the user will only be generally be drawing the map once, and perhaps changing an object if one is moved, removed or added.
PIR spread, since this is going onto quite detailed maps, just the general location of the device is sufficient, if an activation occurs then someone will go and check the area.
Flash, the idea of the mapping is to indicate not only the positions of devices but to actually display the map upon an activation occurring, I think this is going to be better suited to use sprites? Can you make sprite flash without the use of a Timer? I can't see it anywhere in the helpfile, so will assume it must have a use a Timer.
I have already implemented a small menu allowing the user to enter a 4 digit device number, this is stored in the object location array, the idea is the alarm in received, then the array is searched to see if a corresponding zone number exists, if it does the array position already holds the x, y and type values. So it should be "easy" to manipulate that particular object.
I'm thinking this needs to be a standalone solution away from the orginial alarm handler code. I'm sure I have read before that a standalone program can accept args passed on the command line into it? For instance map.exe -1234 So the program will start and fill a variable with 1234
--
Can the existing code be easily changed to accommodate sprites or is it worth starting from scratch?
As always thanks for just taking the time to read my post!
|
|
|
Post by Rod on Jun 27, 2020 11:04:59 GMT -5
Well the sprite part is relatively easy but for some reason your API code would not let them be displayed. I don't have time to debug but I have coded a native solution to sizing but it needs the graphic to be .bmp and i did not code in the scrollbar decision but it can be done. I dont think it was the .jpg load code I think it was the resizer code but no time to debug right now.
This uses sprites (which have a mask) If you just use your current .bmps they will display but look a bit funny. There is no flicker at all.
I would not use two programs. Getting one to run is hard enough. If the program receives an alarm it could display the map and a flashing object but the objects are quite small. you would probably need a big filled circle round the object to show it clearly.
Anyways some code to look at.
nomainwin
'load the map image and get its size file$="Maps\000001.bmp" loadbmp "image",file$ open file$ 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 WindowHeight = bmph+ThemeHeight-2 UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2
graphicbox #1.g 0,0, bmpw, bmph open "Alarm" for window_nf as #1 #1 "trapclose quit" #1.g "background image"
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type, bmpWide, bmpHigh
DIM AlarmIcon(30,1000) DIM object(1000,10) 'array index variables to aid access and understanding type = 2 x=3 y=4 w=5 h=6 'type = 7 MapZone = 8
MaxIcons = 5 'Total Icons to name and draw IconSize = 20 'Define icon/object image size Icontype = 1
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete"
call LoadMapImages CALL EditWindow
CALL LoadObjects #1.g "drawsprites"
WAIT
sub checkicon h$,xpos,ypos FOR n = 1 to MaxIcons if xpos>AlarmIcon(n,x) and xpos<AlarmIcon(n,x)+20 and ypos>AlarmIcon(n,y) and ypos<AlarmIcon(n,y)+20 THEN Icontype = n EXIT FOR END IF NEXT end sub
SUB checkaction h$,xpos,ypos
'check if we clicked on a known object found=0 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 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 "drawsprites" wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp" end if
if found=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-10 object(objects,y) = ypos-10 #1.g "addsprite s";objects;" i";object(objects,type) #1.g "spritexy s";objects;" ";object(objects,x);" ";object(objects,y) #1.g "drawsprites"
END IF '#1.g "when leftButtonDown checkaction" END SUB
sub checkdelete h$,xpos,ypos found=0 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 found=1 exit for end if 'n now contains the object id of the object to delete next
'now delete object if found if found then #1.g "removesprite s";n for i = n to objects 'overwrite n with all subsequent objects to erase it 'you will need to copy all object data x,y,w,h,type etc object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,type) next objects=objects-1 end if #1.g "drawsprites" END SUB
SUB EditWindow 'place floating Alarmset image WindowWidth = 118 : 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,105,400
OPEN "Item Selection" for window as #2 #2, "trapclose quit" ' start event tracking #2.gb, "when leftButtonMove movewindow" #2.gb, "when leftButtonUp checkicon" #2.gb, "UP ; GOTO 0 0"
FOR il = 1 TO MaxIcons #2.gb "down ; drawbmp i" ; il #2.gb,"UP ; GOTO 0 ";il * IconSize ;" ; DOWN" AlarmIcon(il,x) = 0 'x position is always 0 as they're all in line AlarmIcon(il,y) = 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 "il:"; il print "AlarmIcon(il,x):"; AlarmIcon(il,x) print "AlarmIcon(il,y)"; AlarmIcon(il,y)
NEXT
#2.gb "flush" END SUB
SUB quit h$ CALL SaveObjects CLOSE #1 CLOSE #2 PRINT "END" END END SUB
'*************************************************LOAD & SAVE MAP********************************************************* SUB SaveObjects OPEN "plan.txt" FOR OUTPUT AS #saveFile FOR index = 1 TO objects a$ = STR$(object(index,1)) b$ = STR$(object(index,type)) c$ = STR$(object(index,x)) d$ = STR$(object(index,y)) e$ = STR$(object(index,5)) f$ = STR$(object(index,6)) 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
SUB LoadObjects
OPEN "plan.txt" FOR INPUT AS #readFile objects=0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$, g$, h$ object(objects,1) = VAL(a$) object(objects,type) = VAL(b$) ' Icontype object(objects,x) = VAL(c$) ' x position object(objects,y) = VAL(d$) ' y position object(objects,5) = VAL(e$) object(objects,6) = 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 "drawsprites" CLOSE #readFile
END SUB
'Load map icons SUB LoadMapImages FOR a = 1 to MaxIcons LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
function value(x$) 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
|
|
|
Post by Rod on Jun 28, 2020 4:40:54 GMT -5
The erase routine needs to change all the sprites not just eliminate one. Use this delete sub
sub checkdelete h$,xpos,ypos found=0 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 found=1 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-1 'overwrite n with all subsequent objects to erase it #1.g "removesprite s";i object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,type) #1.g "addsprite s";i;" i";object(i,type) #1.g "spritexy s";i;" ";object(i,x);" ";object(i,y) next objects=objects-1 end if #1.g "drawsprites" END SUB
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 28, 2020 10:19:03 GMT -5
Really wish I had logged back in to check this thread, I've been trying to sort the checkdelete sub for ages! Thanks again for the help on this Rod and it's actually starting to do things correctly and without crashing! I've had to alter the checkicon sub back to the "Grid" type selection, for some reason it was having the older issue of not selecting the correct icon and being +1, selecting the icon above. I've drawn the flat icons in the selection window, I'm sure this could have been done by just drawing the bottom half of the masked icon, but this was the only way I could think (and work out) of doing it, also with only really ever having a handful of icons, I don't see this as a major flaw (watch me now want to add 50+ icons in the future, and have to eat those words!!). I've mnoved the file structures around because of the 2 sets of icons, a flat set and a masked set, so anyone running this will need the images.zip I did originally try to use sprites to draw them in but was getting Sprites.dll already in use error, this is because I'm still an idiot and forgot, one sprite graphics window, despite reading this about 15 times! The movewindow sub is back in for the selection window again, as that was calling and crashing the program without any error code, didn't see the LeftButtonDown code in the sub for ages, so it took a while to debug that one. I haven't tried adding the gdiplus stuff back in yet, this is just so the user doesn't have to use BMP's files as most maps I come across are jpg. Whether I bother with this, I don't know. There's still an issue with the checkdelete, whereby if you click the very last object, it deletes it but doesn't remove the sprite, then it doesn't remove any of the others after, but does remove them from the objects array, still debugging that one. I think next challenge is to either draw a filled circle around the object or replace the sprite when an alarm comes in.
' nomainwin 'Define map id, this will be given into this code from the Alarm Handler (Chipnumber$) mapID$ = "000001"
'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" loadbmp "image",file$ open file$ 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 WindowHeight = bmph+ThemeHeight-2 UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2
graphicbox #1.g 0,0, bmpw, bmph open "Alarm" for window_nf as #1 #1 "trapclose quit" #1.g "background image"
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type, bmpWide, bmpHigh, iconimg$, maskimg$, mappath$, mapID$
DIM AlarmIcon(30,1000) DIM object(1000,10) 'array index variables to aid access and understanding zone = 1 type = 2 x=3 y=4 w=5 h=6 'type = 7 MapZone = 8
MaxIcons = 5 'Total Icons to name and draw IconSize = 20 'Define icon/object image size Icontype = 1
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete"
call LoadMapImages CALL EditWindow CALL LoadObjects #1.g "drawsprites"
WAIT
sub checkicon h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize FOR n = 1 to MaxIcons if h$ = "#2.gb" AND AlarmIcon(n,x) = gridX AND AlarmIcon(n,y) = gridY + IconSize 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 checkaction h$,xpos,ypos
'check if we clicked on a known object found=0 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 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 "drawsprites" wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp" end if
if found=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-10 object(objects,y) = ypos-10 #1.g "addsprite s";objects;" i";object(objects,type) #1.g "spritexy s";objects;" ";object(objects,x);" ";object(objects,y) #1.g "drawsprites"
END IF '#1.g "when leftButtonDown checkaction" END SUB
sub checkdelete h$,xpos,ypos found=0 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 found=1 PRINT "Delete Sub - Found object at: "; xpos, 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 PRINT "Delete Sub - Deleting object from array number: "; n for i = n to objects-1 'overwrite n with all subsequent objects to erase it #1.g "removesprite s";i 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) next objects=objects-1 end if #1.g "drawsprites" END SUB
SUB EditWindow 'place floating Alarmset image WindowWidth = 118 : 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,105,400
OPEN "Item Selection" for window as #2 #2, "trapclose quit"
' 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 e1" ;
'Setup position to start drawing icons #2.gb, "UP ; GOTO 0 0"
FOR il = 1 TO MaxIcons #2.gb "down ; drawbmp e" ; il #2.gb,"UP ; GOTO 0 ";il * IconSize ;" ; DOWN" AlarmIcon(il,x) = 0 'x position is always 0 as they're all in line AlarmIcon(il,y) = 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 "il:"; il print "AlarmIcon(il,x):"; AlarmIcon(il,x) print "AlarmIcon(il,y):"; AlarmIcon(il,y)
NEXT #2.gb "flush" END SUB
'*************************************************************************************************************************
SUB quit h$ CALL SaveObjects CLOSE #1 CLOSE #2 PRINT "END" 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 & SAVE MAP********************************************************* SUB SaveObjects PRINT "Saving..." 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,5)) f$ = STR$(object(index,6)) g$ = STR$(object(index,7)) h$ = STR$(object(index,8)) FileContents$ = a$ + "," + b$ + "," + c$ + "," + d$ + "," + e$ + "," + f$ + "," + g$ + "," + h$ PRINT #saveFile, FileContents$ PRINT "index/object = ";index;" " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects OPEN mappath$ + mapID$ + ".txt" FOR INPUT AS #readFile objects=0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$, g$, h$ object(objects,zone) = VAL(a$) ' Zone number object(objects,type) = VAL(b$) ' Icontype object(objects,x) = VAL(c$) ' x position object(objects,y) = VAL(d$) ' y position object(objects,5) = VAL(e$) object(objects,6) = 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 "drawsprites" CLOSE #readFile
END SUB
'Load map icons 'This loop creates images for the Edit window SUB LoadMapImages FOR a = 1 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 '**********************************************************************************************************
'A Rod function, Noun, A function that I have no clue what is really does or how it works! But it just works so don't mess about with it! function value(x$) 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
Images.rar (327.22 KB)
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 29, 2020 12:13:58 GMT -5
Ok so far I have ascertained the issues all lie with the last object added. This affects it if you drag it or attempt to delete it. I'm unsure yet where the problem lies but its as if 1 needs to be added after an object is added, however, this is already being done, so I'm unsure where this should or can be added.
|
|
|
Post by Rod on Jun 30, 2020 1:56:45 GMT -5
Ok, sorry I thought I had posted this. It fixes the removal and sorts out the handling of the sole or last object. It also handles the object selection differently. I have a menu option, select a component then click to add it. Then you can move it about or delete it.
nomainwin
'load the map image and get its size file$="Maps\000001.bmp" open file$ 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 menu #1, "&Add Component", "&Door", [setdoor], "&Entry", [setentry],_ "&PIR", [setpir] 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 WindowHeight = bmph+ThemeHeight-2 UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2 menu #1, "&Add Component", "&Door", [setdoor], "&Entry", [setentry],_ "&PIR", [setpir] menu #1, "&Zone", "&Rectangle", [asRect], "&Circle",_ [asCircle], "&Line", [asLine] graphicbox #1.g 0,0, bmpw, bmph open "Alarm" for window_nf as #1 #1 "trapclose quit" loadbmp "image",file$ #1.g "down ; background image" #1.g "drawsprites"
global t,x, y, w, h, z, objects, currentobject dim object(100,7) t=2 'type of object 1=door 2=pir x=3 'x y=4 'y w=5 'width of object h=6 'hight of object z=1 'zone object assigned to
'Start event tracking #1.g "when leftButtonDown checkaction" #1.g "when rightButtonUp checkdelete"
call LoadMapImages call LoadObjects #1.g "drawsprites" wait
[setdoor] currentobject=1 wait
[setentry] currentobject=2 wait
[setpir] currentobject=3 wait
SUB checkaction h$,xpos,ypos
'check if we clicked on a known object found=0 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 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 "drawsprites" wait
[stoptracking] #1.g "when leftButtonMove" #1.g "when leftButtonUp" end if
if found=0 and currentobject<>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,t) = currentobject object(objects,x) = xpos-10 object(objects,y) = ypos-10 #1.g "addsprite s";objects;" i";object(objects,t) #1.g "spritexy s";objects;" ";object(objects,x);" ";object(objects,y) #1.g "drawsprites" currentobject=0 END IF END SUB
sub checkdelete h$,xpos,ypos found=0 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 found=1 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,t)=0 else object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,t)=object(i+1,t) #1.g "addsprite s";i;" i";object(i,t) #1.g "spritexy s";i;" ";object(i,x);" ";object(i,y) end if next objects=objects-1 end if #1.g "drawsprites" END SUB
SUB quit h$ CALL SaveObjects CLOSE #1 END END SUB
'*************************************************LOAD & SAVE MAP********************************************************* SUB SaveObjects OPEN "plan.txt" FOR OUTPUT AS #saveFile FOR index = 1 TO objects a$ = STR$(object(index,z)) b$ = STR$(object(index,t)) c$ = STR$(object(index,x)) d$ = STR$(object(index,y)) e$ = STR$(object(index,w)) f$ = STR$(object(index,h)) FileContents$ = a$ + "," + b$ + "," + c$ + "," + d$ + "," + e$ + "," + f$ PRINT #saveFile, FileContents$ PRINT "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects
OPEN "plan.txt" FOR INPUT AS #readFile objects=0 WHILE NOT(EOF(#readFile)) objects = objects + 1 INPUTCSV #readFile, a$, b$, c$, d$, e$, f$ object(objects,z) = VAL(a$) object(objects,t) = 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$) #1.g "addsprite s";objects;" i";object(objects,t) #1.g "spritexy s";objects;" ";object(objects,x);" ";object(objects,y) WEND #1.g "drawsprites" CLOSE #readFile
END SUB
'Load map icons SUB LoadMapImages FOR a = 1 to 3 LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
function value(x$) 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
|
|