Using BMPBUTTON to scale bitmaps

[tsh73]

Actually, view only (no resave)
Hold my beer and watch this LOL
Look on third post ;)

You select BMP - then select scale - it shows scaled BMP
(with proportions preserved)

How?
'select bitmap
'get dimensions
'ask scale (for simplicity, let it be 50 100 150)
'save blank BMP of that size
'open window with BMPBUTTON from this blank
'load target pic, henceforth scaling it

'tsh73 Sept 2023
'scaling BMP by BMP BUTTON
'this way should work up or down (spritebg works only up)
'view only (no resave)

'select bitmap
'get dimensions
'ask scale (for simplicity, let it be 50 100 150)
'save blank BMP of that size
'open window with BMPBUTTON from this blank
'load target pic, henceforth scaling it

filedialog "Open BMP", "*.bmp", fileName$
print "File selected: >";fileName$;"<"
if fileName$="" then print "User cancelled":end

call GetBmpDimensions fileName$, srcWidth, srcHeight
print "Source bitmap is ";srcWidth; "x";srcHeight

msg$="please select scale"+chr$(13)+_
   "(1-50%, 2-100%, 3-150%)"
prompt msg$; resp$
select case resp$
case "1": scale =.5
case "2": scale =1
case "3": scale =1.5
case else: scale =1: print "Wrong scale, set to 100%"
end select
print "scale selected is ";scale
'Probably should check if it exceeds DisplayWidth, DisplayHeight
trgWidth=srcWidth*scale
trgHeight=srcHeight*scale
print "Target size would be ";trgWidth; "x";trgHeight

open "aux" for graphics_nsb_fs as #aux
#aux "getbmp blank 1 1 ";trgWidth;" ";trgHeight
call try2kill "blank.bmp"       'because bmpsave does not truncate bif file while overwriting with small one
bmpsave "blank", "blank.bmp"
close #aux

BMPBUTTON  #main.bmpBtn, "blank.bmp", [dummy], UL, 1, 1
ttl$ = srcWidth; "x";srcHeight;" scaled to ";scale*100;"%"
UpperLeftX=1
UpperLeftY=1
WindowWidth = trgWidth+10
WindowHeight = trgHeight+40
open ttl$ for window_nf as #main
#main "trapclose [quit]"

loadbmp "src", fileName$
#main.bmpBtn "bitmap src"
#main.bmpBtn "disable"  'so it DOES NOT gray out, but prevents from clicking

[dummy]
wait

[quit]
close #main
end

'--------------------------------------------------------
sub GetBmpDimensions fileName$, byref width, byref height
   open fileName$ for input as #gbd
   temp$ = input$(#gbd, 24)
   close #gbd
   width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256
   height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256
end sub

function fileExists(path$, filename$)
   dim info$(10, 10)
   files path$, filename$, info$()
   fileExists = val(info$(0, 0)) 'non zero is true
end function

'if we'd rather delete file but do not care much if delete fails
sub try2kill fileName$
   on error goto [skip]    'problem is non[existent file breaks it
   if fileExists(DefaultDir$, fileName$ ) then
       kill fileName$
   end if
[skip]
end sub


[Rod]

Another example using Anatoly's technique.

nomainwin

'first off create shell bmp sizes we will need
open "bmp scaling" for graphics as #g
#g "trapclose [quit]"
#g "down ; place 10 10 ; box 110 110 ; place 40 65 ;\100%"
#g "getbmp bmp100 10 10 100 100" '100%
bmpsave "bmp100","bmp100.bmp"
#g "getbmp bmp50 10 10 50 50" '50%
bmpsave "bmp50","bmp50.bmp"
#g "getbmp bmp200 10 10 200 200" '200%
bmpsave "bmp200","bmp200.bmp"
close #g

'open the normal window and place shell bmpbuttons
WindowWidth=600
bmpbutton #w.50,"bmp50.bmp",[bmp50],UL,10,10
bmpbutton #w.100,"bmp100.bmp",[bmp100],UL,70,10
bmpbutton #w.200,"bmp200.bmp",[bmp200],UL,200,10
open "bmp scaling" for window as #w
#w "trapclose [quitw]"

'now fill shell bmpbuttons with desired scaled graphics 100% to 50% and 200%
'using bmpbutton bitmap command
#w.50 "bitmap bmp100"
#w.200 "bitmap bmp100"
wait

[quit]
close #g
end

[quitw]
close #w
end

[tsh73]

Live and learn.
It was shown on LB forum (!) that LB could save scaled image from BMPBUTTON using native means.

'put a graphicbox under BMPBUTTON
'getbmp will capture picture on it
'you can save it if you wish

That means JB could to it, too.

'tsh73 Sept 2023
'scaling BMP by BMP BUTTON
'this way should work up or down (spritebg works only up)
'view only (no resave)
'+ Oct 2023
' !!! now, with help from emy of LB forum
' (https://libertybasiccom.proboards.com/thread/2424/zoom-out)
' it can grabscaled picture / resave !!!

'select bitmap
'get dimensions
'ask scale (for simplicity, let it be 50 100 150)
'save blank BMP of that size
'open window with BMPBUTTON from this blank
'load target pic, henceforth scaling it
'+ Oct 2023
'put a graphicbox under BMPBUTTON
'getbmp will capture picture on it
'you can save it if you wish

filedialog "Open BMP", "*.bmp", fileName$
print "File selected: >";fileName$;"<"
if fileName$="" then print "User cancelled":end

call GetBmpDimensions fileName$, srcWidth, srcHeight
print "Source bitmap is ";srcWidth; "x";srcHeight

'now get max scale
maxScale = min(_
int((DisplayWidth-10)/srcWidth*100), _
int((DisplayHeight-40)/srcHeight*100))

msg$="please select scale"+chr$(13)+_
   "(10 - ";maxScale;"% (max is limited to display size))"
prompt msg$; resp$
scale0 = val(resp$)

if (scale0 <10) or (scale0 > maxScale) then
scale = 1: print "Wrong scale, set to 100%"
else
scale = scale0/100
end if
print "scale selected is ";scale

trgWidth=int(srcWidth*scale)
trgHeight=int(srcHeight*scale)
print "Target size would be ";trgWidth; "x";trgHeight

open "aux" for graphics_nsb_fs as #aux
#aux "getbmp blank 1 1 ";trgWidth;" ";trgHeight
call try2kill "blank.bmp"       'because bmpsave does not truncate big file while overwriting with small one
bmpsave "blank", "blank.bmp"
close #aux

BMPBUTTON  #main.bmpBtn, "blank.bmp", [dummy], UL, 1, 1
'create graphicbox undeneath to grab scaled image
graphicbox  #main.gr, 0, 0, trgWidth, trgHeight
ttl$ = srcWidth; "x";srcHeight;" scaled to ";scale*100;"%"
UpperLeftX=1
UpperLeftY=1
WindowWidth = trgWidth+10
WindowHeight = trgHeight+40
open ttl$ for window_nf as #main
#main "trapclose [quit]"

loadbmp "src", fileName$
#main.bmpBtn "bitmap src"
#main.bmpBtn "disable"  'so it DOES NOT gray out, but prevents from clicking

#main.gr "getbmp scaled 0 0 ";trgWidth;" ";trgHeight

ans$="yes"
msg$= "Save scaled?"+chr$(13)+"Save scaled picture? (press ESC for 'No')"
prompt msg$; ans$

if ans$ = "yes" then
call try2kill "scaled.bmp"
bmpsave "scaled", "scaled.bmp"
print "Scaled picture saved as 'scaled.bmp'"
end if

print
print "-=* program finished *=-"

[dummy]
wait

[quit]
close #main
end

'--------------------------------------------------------
sub GetBmpDimensions fileName$, byref width, byref height
   open fileName$ for input as #gbd
   temp$ = input$(#gbd, 24)
   close #gbd
   width = asc(mid$(temp$, 19, 1))+asc(mid$(temp$, 20, 1))*256
   height = asc(mid$(temp$, 23, 1))+asc(mid$(temp$, 24, 1))*256
end sub

function fileExists(path$, filename$)
   dim info$(10, 10)
   files path$, filename$, info$()
   fileExists = val(info$(0, 0)) 'non zero is true
end function

'if we'd rather delete file but do not care much if delete fails
sub try2kill fileName$
   on error goto [skip]    'problem is non[existent file breaks it
   if fileExists(DefaultDir$, fileName$ ) then
       kill fileName$
   end if
[skip]
end sub