Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 21, 2020 14:48:22 GMT -5
Some years ago Rod helped create a mapping solution, which I adapted and implemented in my program. Cheers Rod! However sadly that was on the old forum which has now gone, the only code I have left is inter mingled with other code so I decided to start again with limited success. I then realised I maybe heading in the wrong direction and decided to ask people for their approach. The idea is to make a graphical area where the user can "drag" items and place them on another window, this info is saved so when the user reopens the program the items are displayed again. I went for the grid approach. But it's not working out as easy as I thought. Am I looking at this the wrong way? Is there a simpler way of doing this? In the code there is an issue where it doesn't select the icon correctly, which has stumped me for days! 'nomainwin
GLOBAL MaxIcons, IconSize, x, y, w, h, objects
DIM AlarmIcon(30,1000) DIM object(1000,10) 'array index variables to aid access and understanding 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
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 0, 0, WindowWidth, WindowHeight
OPEN WindowTitle$ for window as #1 #1 "trapclose quit" #1, "resizehandler resizer"
'Start event tracking #1.g, "when leftButtonUp checkaction" #1.g, "when rightButtonUp checkdelete"
CALL LoadMapImages CALL EditWindow
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 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 object(n,x)=gridX then if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
end if next ENd IF
if found=0 then
objects=objects+1 object(objects,x)=gridX object(objects,y)=gridY object(objects,w)=AlarmIcon(Icontype,w) object(objects,h)=AlarmIcon(Icontype,h) object(objects,type)=Icontype 'object(n,)=Affects 'object(n,Spare1)=Spare1 'object(n,Spare2)=Spare2 'object(n,Spare3)=Spare3 'object(n,Spare4)=Spare4 END IF
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 LoadMapImages FOR a = 1 to MaxIcons LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
SUB resizer handle$ WindowHeight = WindowHeight : WindowWidth = WindowWidth #1.g, "LOCATE 0 0 "; WindowWidth ; " " ; WindowHeight #1, "refresh" END SUB
SUB quit h$ 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
You'll need 5, 20 x 20 bmp images to run they are here Images.rar (2.31 KB)
|
|
|
Post by metro on Jun 21, 2020 19:20:04 GMT -5
Not sure if this is what you are looking for
|
|
|
Post by metro on Jun 21, 2020 19:22:09 GMT -5
|
|
|
Post by Rod on Jun 22, 2020 2:32:07 GMT -5
I think it was this, on my iPad and can’t check it out. link
|
|
|
Post by Rod on Jun 22, 2020 3:01:49 GMT -5
is the problem that the grid starts from 0? the first 20 x,y will give grid position 0 which is correct. your current selection gives me one above the icon I choose.
|
|
|
Post by Rod on Jun 22, 2020 6:36:09 GMT -5
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 22, 2020 10:25:58 GMT -5
Thanks Metro, interesting, do you have a backup to the old conforums site?
Rod, yes, RailManager was where it came from. The tethered approach looks complex! I'm literally still on Print "Hello World!"
I've updated my code, so you now get the correct Icon when clicking on it. It was a case of adding the icon size to the gridY check.
However for some reason I'm unable to place an icon directly underneath one I've just placed?
Also I'm thinking, I don't actually need it to be a grid system, it could be place wherever the user wishes to place it, but would that massively over complicate things?
This is what I have at the moment.
'nomainwin
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype
DIM AlarmIcon(30,1000) DIM object(1000,10) 'array index variables to aid access and understanding 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
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 0, 0, WindowWidth, WindowHeight
OPEN WindowTitle$ for window as #1 #1 "trapclose quit" #1, "resizehandler resizer"
'Start event tracking #1.g, "when leftButtonUp checkaction" #1.g, "when rightButtonUp checkdelete"
CALL LoadMapImages CALL EditWindow
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 object(n,x)=gridX then if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
end if next ENd IF
if found = 0 AND h$ = "#1.g" THEN print "Draw ";gridX;" ";gridY;" Icontype ";Icontype #1.g "drawbmp i";Icontype;" ";gridX;" ";gridY objects=objects+1 object(objects,x)=gridX object(objects,y)=gridY object(objects,w)=AlarmIcon(Icontype,w) object(objects,h)=AlarmIcon(Icontype,h) object(objects,type)=Icontype 'object(n,)=Affects 'object(n,Spare1)=Spare1 'object(n,Spare2)=Spare2 'object(n,Spare3)=Spare3 'object(n,Spare4)=Spare4 END IF
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 LoadMapImages FOR a = 1 to MaxIcons LOADBMP "i";a, "Images\";a;".bmp" NEXT END SUB
SUB resizer handle$ WindowHeight = WindowHeight : WindowWidth = WindowWidth #1.g, "LOCATE 0 0 "; WindowWidth ; " " ; WindowHeight #1, "refresh" END SUB
SUB quit h$ 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
|
|
|
Post by Rod on Jun 22, 2020 13:00:32 GMT -5
A grid is used to help join things together, if they can be placed freely and overlap you don’t need a grid. But avoiding overlap can get more complex than running a grid.
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 22, 2020 15:28:06 GMT -5
Yes Rod, I think your right, The grid is the correct way to go. I'm having to give up tonight, I've really broken it! And I'm code blinded! I don't really understand drawing segments, for some reason I delsegment drawing, draw more then flush, but that doesn't seem to "stick", then resizing the window seems to do very random things! Any input gratefully received! 'nomainwin
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type, WinHandle1, imgfile$
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 'Default Icon
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 leftButtonUp checkaction" #1.g, "when rightButtonUp checkdelete"
'Load background image from file imgfile$="Maps\000001.jpg" GOSUB [LoadBackground]
'Resize Window so image fits completelyish
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 object(n,x)=gridX then if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
end if next ENd IF
if found = 0 AND h$ = "#1.g" THEN
objects=objects+1 object(objects,type) = Icontype object(objects,x) = gridX object(objects,y) = gridY CALL DrawObjects END IF END SUB
sub checkdelete h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize
for n = 1 to objects if object(n,x)=gridX then print object(n,x),object(n,y),gridY if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 Print "Found ? "; found exit for end if end if next
'now delete object if found if found then for i = n to objects object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,Icontype) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects for n = 1 to objects #1.g "delsegment drawing" print "Draw ";gridX;" ";gridY;" Icontype ";Icontype; " objects:"; objects #1.g "drawbmp i";Icontype;" ";object(n,x);" ";object(n,y) #1.g "flush drawing"
NEXT 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 "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects OPEN "plan.txt" FOR INPUT AS #readFile 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 #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
You'll need these images to run Attachments:Maps.rar (117.18 KB)
|
|
|
Post by metro on Jun 23, 2020 1:48:31 GMT -5
Thanks Metro, interesting, do you have a backup to the old conforums site? Not sure an Alien can plead the 5th so I'll just reserve my right to remain silent
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 23, 2020 3:23:51 GMT -5
So I had another crack at this, this morning and I believe I have sorted the drawing issues. I had put the delseg and flush within the for loop, rather than before and after. This seems to resolve the drawing issues. However for the next 6 hours I intend to resolve the issue with the checkDelete sub not removing the drawing. It removes it from the object array, but for some reason doesn't remove it from the screen. Again, any help is most welcome, I have very little hair left as it is! 'nomainwin
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type, WinHandle1, imgfile$
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 'Default Icon
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 leftButtonUp checkaction" #1.g, "when rightButtonUp checkdelete"
'Load background image from file imgfile$="Maps\000001.jpg" GOSUB [LoadBackground]
'Resize Window so image fits completelyish
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 object(n,x)=gridX then if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
end if next ENd IF
if found = 0 AND h$ = "#1.g" THEN
objects=objects+1 object(objects,type) = Icontype object(objects,x) = gridX object(objects,y) = gridY CALL DrawObjects END IF END SUB
sub checkdelete h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize
for n = 1 to objects if object(n,x)=gridX then print object(n,x),object(n,y),gridY if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 Print "Found ? "; found exit for end if end if next
'now delete object if found if found then for i = n to objects object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,Icontype) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects trace 3 #1.g "delsegment drawing" for n = 1 to objects print "Draw ";gridX;" ";gridY;" Icontype ";Icontype; " objects:"; objects #1.g "drawbmp i";Icontype;" ";object(n,x);" ";object(n,y) 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 "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects OPEN "plan.txt" FOR INPUT AS #readFile 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 #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
Attachments:Maps.rar (117.18 KB)
|
|
|
Post by Rod on Jun 23, 2020 3:30:37 GMT -5
Not a complete list of bugs but enough to sort the drawing out.
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 cell containing a known object found=0 for n = 1 to objects if object(n,x)=gridX then
'we only need to check gridx,gridy to know if an object is assigned to the cell 'so what is or (object(n,h)=IconSize and object(n,y)=gridY-IconSize)doing? if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
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) = gridX object(objects,y) = gridY CALL DrawObjects END IF END SUB
sub checkdelete h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize
for n = 1 to objects if object(n,x)=gridX then print object(n,x),object(n,y),gridY
'we only need to check gridx,gridy to know if an object is assigned to the cell 'so what is or (object(n,h)=IconSize and object(n,y)=gridY-IconSize)doing? if object(n,y)=gridY or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 Print "Found ? "; found exit for 'n now contains the object id of the object to delete end if end if next
'now delete object if found if found then for i = n to objects 'overwrite n with all subsequent objects to erase it object(i,x)=object(i+1,x) object(i,y)=object(i+1,y) object(i,type) = object(i+1,Icontype) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects for n = 1 to objects #1.g "delsegment drawing" print "Draw ";gridX;" ";gridY;" Icontype ";Icontype; " objects:"; objects
'we should not be using Icontype we should be using the objects icontype object(n,type) #1.g "drawbmp i";Icontype;" ";object(n,x);" ";object(n,y) #1.g "flush drawing"
NEXT END SUB
|
|
|
Post by Rod on Jun 23, 2020 5:20:08 GMT -5
This works for me, there was something about the initial image drawing that was not working. I put it all in the draw sub and it works fine now.
Actually for what you are doing I would drop the grid and just drag the objects to precise x,y locations. You are storing the true x,y location anyway. So you would click to add to the screen then when you click again on a known object you allow it to be dragged with mouseMove.
'nomainwin
imgfile$="Maps\000001.jpg"
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
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 145, 15, WindowWidth, WindowHeight
OPEN WindowTitle$ for window as #1 WinHandle1=hwnd(#1) #1 "trapclose quit" #1, "resizehandler resizer"
'Start event tracking #1.g, "down ; when leftButtonUp checkaction" #1.g, "when rightButtonUp checkdelete"
GOSUB [LoadBackground] CALL LoadMapImages CALL EditWindow
'Resize Window so image fits completely bmpWide = bmpWide + 25 : bmpHigh = bmpHigh + 25 calldll #user32, "SetWindowPos",WinHandle1 as ulong,_HWND_TOP as ulong,UpperLeftX as long, UpperLeftY as long, bmpWide as long, bmpHigh as long, _SWP_SHOWWINDOW as long,re as boolean
CALL LoadObjects CALL DrawObjects
'#1, "refresh"
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 cell containing a known object found=0 for n = 1 to objects if object(n,x)=gridX then
'we only need to check gridx,gridy to know if an object is assigned to the cell 'so what is or (object(n,h)=IconSize and object(n,y)=gridY-IconSize)doing? if object(n,y)=gridY then 'or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 exit for end if
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) = gridX object(objects,y) = gridY CALL DrawObjects END IF END SUB
sub checkdelete h$,xpos,ypos gridX=int(xpos/IconSize)*IconSize gridY=int(ypos/IconSize)*IconSize
for n = 1 to objects if object(n,x)=gridX then print object(n,x),object(n,y),gridY
'we only need to check gridx,gridy to know if an object is assigned to the cell 'so what is or (object(n,h)=IconSize and object(n,y)=gridY-IconSize)doing? if object(n,y)=gridY then 'or (object(n,h)=IconSize and object(n,y)=gridY-IconSize) then found=1 Print "Found ? "; found exit for 'n now contains the object id of the object to delete end if end if next
'now delete object if found if found then 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)not Icontype object(i,type) = object(i+1,type) next objects=objects-1 end if CALL DrawObjects END SUB
SUB DrawObjects #1.g "delsegment drawing" #1.g "drawbmp image 0 0" for n = 1 to objects print "Draw ";gridX;" ";gridY;" Icontype ";Icontype; " objects:"; objects
'we should not be using Icontype we should be using the objects icontype object(n,type) #1.g "drawbmp i";object(n,type);" ";object(n,x);" ";object(n,y) #1.g "flush drawing"
NEXT 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 "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects TRACE 3 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>gboxMaxWide then 'if width of bmp greater than maximum width of gbox, add scrollbar gboxWide=gboxMaxWide #1.g "horizscrollbar on 0 ";bmpWide else 'set gbox width=image width gboxWide=bmpWide #1.g "horizscrollbar off" end if if bmpHigh>gboxMaxHigh then 'if height of bmp is greater than maximum height of gbox, add scrollbar gboxHigh=gboxMaxHigh #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 #1 "refresh"
loadbmp "image",hBitmap ' #1.g "delsegment mainSegment; discard" 'remove graphics from memory ' #1.g "down ; drawbmp image 0 0;flush mainSegment"
else notice "Unable to load image file!" end if RETURN
|
|
|
Post by Rod on Jun 23, 2020 6:18:00 GMT -5
Ok, a version without the grid that places objects where you click and drag them to. You can move them later or right click and delete them. I think it is a better fit than the grid for your high resolution mapping diagram. It isnt selecting the correct object , it selects the one above but I am out of time.
'nomainwin
imgfile$="Maps\000001.jpg"
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
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 145, 15, 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
'Resize Window so image fits completely bmpWide = bmpWide + 25 : bmpHigh = bmpHigh + 25 calldll #user32, "SetWindowPos",WinHandle1 as ulong,_HWND_TOP as ulong,UpperLeftX as long, UpperLeftY as long, bmpWide as long, bmpHigh as long, _SWP_SHOWWINDOW as long,re as boolean
CALL LoadObjects CALL DrawObjects
WAIT
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 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 objects=objects+1 object(objects,type) = Icontype object(objects,x) = xpos-10 object(objects,y) = ypos-10 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 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 '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 #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) #1.g "flush drawing" NEXT 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 "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects TRACE 3 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>gboxMaxWide then 'if width of bmp greater than maximum width of gbox, add scrollbar gboxWide=gboxMaxWide #1.g "horizscrollbar on 0 ";bmpWide else 'set gbox width=image width gboxWide=bmpWide #1.g "horizscrollbar off" end if if bmpHigh>gboxMaxHigh then 'if height of bmp is greater than maximum height of gbox, add scrollbar gboxHigh=gboxMaxHigh #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 #1 "refresh"
loadbmp "image",hBitmap ' #1.g "delsegment mainSegment; discard" 'remove graphics from memory ' #1.g "down ; drawbmp image 0 0;flush mainSegment"
else notice "Unable to load image file!" end if RETURN
|
|
Tasp
Full Member
Posts: 215
|
Post by Tasp on Jun 23, 2020 12:27:14 GMT -5
Thanks Rod. Literally 20 seconds before you posted this, I noticed the issue with that! It appears that all versions seem to suffer from not rendering the "background" map if theres no objects in the plan.txt file. So I moved the code round a bit so we make sure the map flushes correctly. The dragging around of the object is great, however it seems to do very strange things! If you open task manager, grab an object and drag it around for a few seconds the memory usage hits 1G!! Which obviously crashes LB. Moving the code to redraw the background helps with this, but for some reason you either get a "can't open a file thats already open" error? You get "attempt to access absent element" error if you drag an object around then add 2 more objects.
Debugger doesn't really help as you can't step thru and drag the mouse, and I can't see in the code where the issue lies. So I'm off to add some PRINT commands in to see whats happening. But here's the current code 'Edit Map Rod
'nomainwin
imgfile$="Maps\000001.jpg"
GLOBAL MaxIcons, IconSize, x, y, w, h, objects, Icontype, type, WinHandle1, imgfile$
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
WindowTitle$ = "MAP ID number: 000001" WindowWidth = 500 : WindowHeight = 400 ': UpperLeftX = 1 : UpperLeftY = 1 GRAPHICBOX #1.g 145, 15, 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
'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 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 objects=objects+1 object(objects,type) = Icontype object(objects,x) = xpos-10 object(objects,y) = ypos-10 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 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 '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 #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) #1.g "flush drawing" NEXT 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 "index = ";index;" objects = ";objects; " " + FileContents$ NEXT CLOSE #saveFile END SUB
SUB LoadObjects TRACE 3 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 'resize gbox to fit image #1.g "locate 0 0 ";gboxWide;" ";gboxHigh #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
|
|