Zoom In/Out

[emy]

Hello,
I am using LBproV4.5.1
I would like to know how to make a zoom in and zoom out.
To do manually it takes to much time.
Reduce an image w=620 and h=840 to w=120 and h=165 (no need so precise values)
The purpose is to have large bmpButton. (see attachment)
Reducing about five time, it's easy to guess what the bigger bmp will looks like.  
Thanks for help.
Regards.

STRM1.bmp (1017.55 KB)

[Rod]

You can harness the power of the blitter very easily. There are tutorials on the LBPE I use stretchBlt here which stretches, mirrors or flips any bmp to any size.

So I create large bmps and capture them, you might just load and draw the bmps. Then I use stretchBlt to capture the large bmp area of the screen and redraw it much reduced in a different place mimicking a button. The code then watches for mousedown and redraws the selected bmp in its large form.

Everything you want to do can be achieved with this magical line of code "call StretchBlt,sDC,bx,by,40,100,sDC,590,10,200,500"

nomainwin

       ' open the dll file used for TransparentBlt
       ' not required in this demo
       open "msimg32.dll" for dll as #m

       WindowWidth  = 816
       WindowHeight = 640
       UpperLeftX   = (DisplayWidth-WindowWidth)/2
       UpperLeftY   = (DisplayHeight-WindowHeight)/2
       graphicbox #1.g, 5,5,800,600
       open "Blitter" for graphics_nf_nsb as #1
       #1   "trapclose [quit]"
       #1.g "font arial 36"

       'sDC is our screen buffer, (DC handle to the graphicsbox)
       sDC=GetDC(hwnd(#1.g))

       'set up sample bmps, capture and draw resized
       #1.g "down; fill black ; color white ; backcolor red"
       bx=10
       by=10
       for x = 1 to 9
           if bx>110 then bx=10 : by=by+140
           #1.g "place 590 10 ; boxfilled 790 510"
           #1.g "place 690 240 ;\";x
           #1.g "getbmp bmp";x;" 590 10 200 500"
           call StretchBlt,sDC,bx,by,40,100,sDC,590,10,200,500
           bx=bx+50
       next x

       'now we have our mini bmp array we start looking for mouse input
       #1.g "when leftButtonDown [choose]"
       wait

       [choose]
       'which part of the button array was clicked?
       bx=MouseX : by = MouseY
       if bx>10 and bx<50 and by>10 and by<110 then bp=1
       if bx>60 and bx<100 and by>10 and by<110 then bp=2
       if bx>110 and bx<150 and by>10 and by<110 then bp=3
       if bx>10 and bx<50 and by>150 and by<290 then bp=4
       if bx>60 and bx<100 and by>150 and by<290 then bp=5
       if bx>110 and bx<150 and by>150 and by<290 then bp=6
       if bx>10 and bx<50 and by>290 and by<430 then bp=7
       if bx>60 and bx<100 and by>290 and by<430 then bp=8
       if bx>110 and bx<150 and by>290 and by<430 then bp=9
       ' so now draw the large bmp
       #1.g "drawbmp bmp";bp;" 590 10"
       'here you would action the users choice
       wait


       [quit]
       call ReleaseDC hwnd(#1), sDC
       close #1
       close #m

       end


'=============================Window and DC functions=================================
Function GetDC(hWnd)
   CallDLL #user32, "GetDC",_
       hWnd As ulong,_  'window or control handle
       GetDC As ulong   'returns device context
   End Function

Sub ReleaseDC hWnd, hDC
   CallDLL#user32,"ReleaseDC",_
       hWnd As ulong,_  'window or control handle
       hDC As ulong,_   'handle of DC to delete
       result As Long
   End Sub

Function CreateCompatibleDC(hDC)
   CallDLL #gdi32,"CreateCompatibleDC",_
       hDC As ulong,_               'window DC
       CreateCompatibleDC As ulong  'memory DC
   End Function

Sub DeleteDC hDC
   CallDLL #gdi32, "DeleteDC",_
   hDC As ulong,_   'memory DC to delete
   r As Boolean
   End Sub

Sub StretchBlt hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2
   CallDLL #gdi32, "SetStretchBltMode",_
       hDCdest As ulong,_       'device context
       _COLORONCOLOR As Long,_ 'color reduction mode
       RESULT As Long
   CallDLL #gdi32, "StretchBlt",_
       hDCdest As ulong,_   'destination
       x As Long,_         'destination x pos
       y As Long,_         'destination y pos
       w As Long,_         'destination width desired
       h As Long,_         'destination height desired
       hDCsrc As ulong,_    'source
       x2 As Long,_        'x location to start from source
       y2 As Long,_        'y location to start from source
       w2 As Long,_        'width desired from source
       h2 As Long,_        'height desired from source
       _SRCCOPY As long,_ 'dwRasterOperation
       RESULT As Boolean
   End Sub

Sub TransparentBlt hDCdest,x,y,w,h,hDCsrc,x2,y2,w2,h2,crTransparent
   calldll #m, "TransparentBlt",_
       hDCdest As uLong,_  'destination
       x As Long,_         'destination x pos
       y As Long,_         'destination y pos
       w As Long,_         'destination width desired
       h As Long,_         'destination height desired
       hDCsrc As uLong,_    'source
       x2 As Long,_        'x location to start from source
       y2 As Long,_        'y location to start from source
       w2 As Long,_        'width desired from source
       h2 As Long,_        'height desired from source
       crTransparent as ulong,_ 'color to make transparent 0=Black
       result as boolean
   end sub


Function SelectObject(hDC,hObject)
   CallDLL #gdi32,"SelectObject",_
       hDC As ulong,_        'memory device context
       hObject As long,_    'handle of object
       SelectObject As long 'returns previously selected object
   End Function





[tsh73]

Interesting thing, you don't need any resizing code for that.
Create one bitmap of desired size(w=120 and h=165, whatever)
Put on a form several BMPBUTTONs with this bitmap
After opening form, use command "bitmap" of BMPBUTTON to change picture
You load big pictures and put them in small BMPBUTTON
It will resize automatically, no code needed.

(sometimes best code is the code you do not write )

[Rod]

I always assumed bmp button adopted the size of a bmp. I will need to experiment with this new resize capability. But does that mean you have to manually create the bmps or can that be done programmatically? I suppose it could be done programmatically provided you have one bmp of the correct size. Will need to play.

[tsh73]

see
justbasiccom.proboards.com/thread/1042/using-bmpbutton-scale-bitmaps

[Rod]

Ok, had time to play, one or two things to set up and files to create to have shell bmp buttons of the correct size but after that it's an easy way to scale graphics. Another Anatoly keeper.


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


[emy]

Hello.
Thanks Anatoly for Your answer and advice. I will take a look to link.
About code I agree with Your last phrase.

Thanks Rod for Your answer and code, that will help me.
I will take a look as well to LBPE.

Following explain what I would like to do with reference to the first attachement.
I made an application "StitChartEditor.bas" that I can create bmp w=620 and h=840, and each one will have a different name.
I made another application "Structures.bas" which is a kind of book with pages. Each pages has 24 bmpbutton (w=120 and h=165), when I click on one of them, it open a window with the corresponding bmp w=620 and h=840.
Actually Iuse Windows to reduce the bmp w=620 and h=840 and save screen. to adjust I use Paint. It takes time.
That is why I would like to make a third application that I can zoom a bmp w=620 and h=840 to bmp=120 and h=165 with a different name that I can put on a page of the "Structures.bas". No need adjustments.
Sorry for my English, hope what I wrote is understandable.
Thanks, regards.

[tsh73]

Here's code I made
Put these two programs in a new folder
- first one will create 20 BMP files 01.bmp, 02.bmp, ... 20.bmp
w=620 and h=840
These are things for second program to play with
(if you have folder with some files, just copy some bitmaps
I just added some old drawings for a screenshot
)

Second program makes a grid of BMPBUTTONS (I set 2x3, you can change it)
fills them with bitmaps from a folder (scaled down to w=120 and h=165 )
and on click, shows selected bitmap 100% in the right half of a window.
If divides list of bitmaps into pages (cols x rows size) and allows to go back and forth.
Looks like this:


Bitmap generator (for those don't having bitmaps to play with):
'generate some bitmaps
nomainwin
N=20
'source images
w=620: h=840

UpperLeftX=1
UpperLeftY=1
WindowWidth = w+10
WindowHeight = h+40

open ttl$ for graphics_nsb as #main
#main "trapclose [quit]"

#main "down"
#main "font 200"    'change only font size. To something BIG
#main "\"
#main "posxy dummy lineH"

for i = 1 to N
   #main "cls"
   i$=right$(str$(100+i), 2)
   #main "stringwidth? i$ lineW"
   x=(w-lineW)/2
   y=(h-lineH)/2
   #main "place ";x;" ";y+0.75*lineH  '+... is trial and error
   #main "\";i$

   #main "getbmp bmp 1 1 ";w;" ";h
   bmpsave "bmp", i$;".bmp"
next

notice "Bitmaps created";chr$(13); _
   N;" bitmaps named 01.bmp, 02.bmp, ...";chr$(13); _
   "are created in current directory."

[quit]
close #main
end

Bitmap browser:
'Bitmap browser. Along
'https://libertybasiccom.proboards.com/thread/2424/zoom-out
'tsh73 Oct 2023

   nomainwin

gosub [createBlank]

   WindowWidth = 944
   WindowHeight = 915

   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)

global CRLF$, list$, page, pageSize, numCols, numRows
'things are global so I can use then inside bmpbutton handler (singe handler for all bmpbuttons)
CRLF$=chr$(13)+chr$(10)

   statictext #main.stTotalBMP, "There are ## BMP files in current directory", 14, 6, 264, 25
   button #main.btnList, "list", [btnListClick], UL, 286, 6, 80, 25
   button #main.btnExplorer, "show in Explorer", [btnExplorerClick], UL, 374, 6, 136, 25
   statictext #main.lblPageNum, "page # of #", 70, 31, 90, 20
   button #main.btnPrev, "<<", [btnPrevClick], UL, 14, 31, 48, 25
   button #main.btnNext, ">>", [btnNextClick], UL, 170, 31, 48, 25
   ' bmpbutton #main.bmpbutton8, "C:\Program Files\Just BASIC v2.0\bmp\BLUEBTTN.BMP", [bmpbutton8Click], UL, 230, 26

'name is row col, from 0
numCols=2:numRows=3
'sorry we cannot create controls in a loop
   bmpbutton #main.00, "blank.bmp", bmpClick, UL, 14, 66
   bmpbutton #main.01, "blank.bmp", bmpClick, UL, 158, 66
   bmpbutton #main.10, "blank.bmp", bmpClick, UL, 14, 251
   bmpbutton #main.11, "blank.bmp", bmpClick, UL, 158, 251
   bmpbutton #main.20, "blank.bmp", bmpClick, UL, 14, 436
   bmpbutton #main.21, "blank.bmp", bmpClick, UL, 158, 436

   graphicbox #main.gr, 302, 41, 620, 840
   open "bitmap Browser" for window_nf as #main
   print #main.gr,"down; fill white; flush"
   print #main, "trapclose [quit.main]"

   print #main, "font ms_sans_serif 10"

gosub [readFolder]
page=1
gosub [fillPage]

   wait

[quit.main]
   Close #main
   END

sub bmpClick handle$
'notice handle$
'buttonName$="#main.";r;c
c=val(right$(handle$,1))
r=val(left$(right$(handle$,2),1))
'notice r;" ";c
i = (page-1)*pageSize+r*numCols+c +1
fileName$ = word$(list$,i,CRLF$)
if fileName$="" then 'load blank
fileName$="blank.bmp"
end if
loadbmp "src", fileName$
#main.gr "cls"
#main.gr "drawbmp src 1 1"
#main.gr "flush"
end sub


[btnListClick]    'Perform action for the button named 'btnList'
if textOPen then
#text "!setfocus"
else
UpperLeftX=1
UpperLeftY=1
WindowWidth = 200
WindowHeight = 500
open "BMP file list" for text as #text
#text "!trapclose [closeText]"
#text list$

textOPen =1
end if
   wait

[closeText]
close #text
textOPen =0
wait

[btnExplorerClick]    'Perform action for the button named 'btnExplorer'
   run "explorer.exe ";DefaultDir$
   wait


[btnPrevClick]    'Perform action for the button named 'btnPrev'
   if page>1 then
page=page-1
gosub [fillPage]
end if
   wait


[btnNextClick]    'Perform action for the button named 'btnNext'
   if page<numPages then
page=page+1
gosub [fillPage]
end if
   wait

'-------------------------------
[readFolder]
dim info$(1,1)
files DefaultDir$, "*.bmp", info$()
fNum = val(info$(0, 0))
#main.stTotalBMP, "There are ";fNum;" BMP files in current directory"

list$=""
for i = 1 to fNum
'could filter off blank.bmp
list$=list$+info$(i, 0)+CRLF$
next

return

[fillPage]
'numCols=2:numRows=3
'fNum
'page
pageSize = numCols*numRows
numPages = fNum/pageSize
if int(numPages)<>numPages then
numPages=int(numPages)+1
else
numPages=int(numPages)
end if
#main.lblPageNum, "page ";page;" of #";numPages

cursor HOURGLASS
for c = 0 to numCols-1
for r=0 to numRows-1
i = (page-1)*pageSize+r*numCols+c +1
fileName$ = word$(list$,i,CRLF$)
if fileName$="" then 'load blank
fileName$="blank.bmp"
end if
loadbmp "src", fileName$
'use handle variable to process bmpbuttons in a loop
buttonName$="#main.";r;c
#buttonName$ "bitmap src"
next
next
cursor NORMAL
return


[createBlank]
UpperLeftX=1
UpperLeftY=1
w=620: h=840
WindowWidth = w+10
WindowHeight = h+40

open "dummy" for graphics_nsb as #main

#main "down"
w=120: h=165
#main "cls"
   #main "getbmp bmp 1 1 ";w;" ";h
   bmpsave "bmp", "blank.bmp"
close #main
return


[emy]

Hello Anatoly,
Yes Super, it exactly what I was looking for.
But Your code create 20 bmp at a time, which is good.
I was looking for one at a time.
I will try to work with Your code for only one bmp w=620 and h=840 and only onew=120 and h=165.
Thanks a lot.

[tsh73]

Just put second program into folder with your w=620 and h=840 pictures
No need to run program creating 20 files, at all

[emy]

Hello,
Use the bmp first post.


'================================================
' zoomOutEE.bas
'================================================
' https://libertybasiccom.proboards.com/thread/2424/zoom-out
' tsh73 Oct 2023
'================================================
   gosub [createBlank]
 Nomainwin
   WindowWidth  = 932
   WindowHeight = 895
   UpperLeftX   =  50
   UpperLeftY   =  50
  '................................................
   button #main.bt1, "Save Snap", [SaveSnap], UL, 110, 600, 80, 40
   statictext #main.st1, " ", 105, 660, 120, 25
   bmpbutton #main.00, "blank.bmp", bmpClick, UL, 30, 40
   graphicbox #main.gb1, 295, 10, 620, 840
   graphicbox #main.gb2,   0,  0, 932, 895   '<--- To save Reduced bmp
  '................................................
   open "Zoom-Out" for window_nf as #main
   #main, "trapclose [quit.main]"
  '................................................
   #main.gb1,"down; fill buttonface; flush"
   #main.gb2,"down; fill buttonface; flush"
  '................................................
   fileName$ = "Str76.bmp"  '<--- Any bmp w=620 - h=840
   loadbmp "src", fileName$
   buttonName$ = "#main.00"
   #buttonName$ "bitmap src"
  '................................................
   loadbmp "src", fileName$
   #main.gb1 "cls"
   #main.gb1 "drawbmp src 0 0"
   #main.gb1 "flush"
   unloadbmp "src"
wait
'-------------------------------------------------
[quit.main]
   Close #main
END
'-------------------------------------------------
[createBlank]
   UpperLeftX = 1
   UpperLeftY = 1
   w = 620 : h = 840
   WindowWidth  = w + 10
   WindowHeight = h + 40
   open "dummy" for graphics_nsb as #main
   #main "down"
   w = 135 : h = 175  '<--- Size of reduced bmp - (original:w=120:h=165)
   #main "cls"
   #main "getbmp bmp 0 0 ";w;" ";h
   bmpsave "bmp", "blank.bmp"
   unloadbmp "bmp"
   close #main
return
'-------------------------------------------------
[SaveSnap]
   #main.gb2 "getbmp img 30 40 ";140;" ";180
   bmpsave   "img", "tempo.bmp"  'Name of the saved snap
   call waitMilliseconds 1000
   #main.st1, " Done! bmp saved"
   call waitMilliseconds 3000
   #main.st1, " "
   unloadbmp "img"
wait
'-------------------------------------------------
sub bmpClick handle$
  'For bmpbutton
end sub
'-------------------------------------------------
sub waitMilliseconds ms
   timer ms, [stopWaiting]
   wait
   [stopWaiting]
   timer 0
end sub
'-------------------------------------------------


[tsh73]

Ohhhh!
Clever trick!
You put graphicbox _under_ bmpbutton
and GETBMP captures that bmp button.

I never thought of it, really nice thing to know

[emy]

Yes, few years ago I found this case.
According to the program and purpose it can be useful.
All applications I made (about Knitting) the program use (manipulate) many bmp.
I would like to post one of them, but the size is to big with, several directories with bmp.
I have no web side.

[Rod]

Do you turn the pattern into instructions for a knitting machine?

[emy]

No, it's a manual with instructions how to use Hand Knitting machine.
It is like a book that explain how to knit pattern sample.
From simple to more elaborate knit.
It's a complete knitting course.