+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: These tired old eyes... (/showthread.php?tid=741)
These tired old eyes... - OldMoses - 08-06-2022
...could use a magnifier. I had done something similar on the old forum, but wanted something more portable. It mainly consists of two SUBs, one to create a color masking image and the other to acquire the portion to be magnified and apply the mask. Right mouse click magnifies the portion the mouse is hovering over, while the mousewheel controls the magnification factor. Hotkeys are "+" and "-" to increase or decrease magnifier size, and "s" to toggle a rifle scoop type reticle. Esc to quit.
It uses the screen image for navigation, but takes the magnified content from the original loaded image.
I also zipped it with several demo images, both big and small, or comment out the _LOADIMAGE code and use one of your own. It comes enabled to Bruegel's "Triumph of Death". Not so much to be macabre, but because Bruegel is the medieval periods answer to Richard Scarry. It's just chock full of details, perfect for magnification.
The '63 Chevy P/U image is a smaller image that is stretched to fit the screen so it will be noticed that Mag factor 1 will actually shrink it. The other images are larger and shrunk to fit.
Code: (Select All)
'img& = _LOADIMAGE("aslan.jpg", 32)
'img& = _LOADIMAGE("1963_chev.jpg", 32)
img& = _LOADIMAGE("bruegelII.jpg", 32)
SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT - 80, 32)
DO UNTIL _SCREENEXISTS: LOOP
_SCREENMOVE 0, 0
'VARIABLES
DIM SHARED msk& ' reticle mask handle
DIM hratio ' height ratio: screen / image
DIM wratio ' width ratio: screen / image
DIM ratio ' ratio to shrink image to screen
DIM magsiz%
DIM magfactor%
DIM scope%%
hratio = _HEIGHT(0) / _HEIGHT(img&)
wratio = _WIDTH(0) / _WIDTH(img&)
ratio = -hratio * (hratio < wratio) - wratio * (wratio <= hratio)
magsiz% = 250
magfactor% = 2
scope%% = 0
Make_Mask magsiz%, scope%%
DO
CLS
Image_Resize 0, 0, _WIDTH(0) - 1, _HEIGHT(0) - 1, img&, 0, "l", "u" 'placeimage to fit screen upper left corner
_PRINTSTRING (0, 0), "Original size " + STR$(_WIDTH(img&)) + " x " + STR$(_HEIGHT(img&))
_PRINTSTRING (0, 16), "Ratio= " + STR$(ratio) + " Mag. factor= " + STR$(magfactor%)
k$ = INKEY$
IF k$ <> "" THEN
IF k$ = CHR$(43) THEN ' "+" to increase magnifier size
magsiz% = magsiz% + 25: vin%% = -1
END IF
IF k$ = CHR$(45) THEN ' "-" to decrease magnifier size
magsiz% = magsiz% - 25: vin%% = -1
IF magsiz% < 25 THEN magsiz% = 25
END IF
IF k$ = "s" THEN ' "s" to toggle scope reticle
scope%% = NOT scope%%: vin%% = -1
END IF
IF vin%% THEN Make_Mask magsiz%, scope%% ' if valid input then redo mask overlay
k$ = "": vin%% = 0 ' clear input & and valid input flag
END IF
ms = MBS
IF ms AND 1 THEN ' left mouse button to show magnifier
_MOUSEHIDE
Magnify magfactor%, img&, magsiz%, ratio
ELSE
_MOUSESHOW "crosshair"
END IF
IF ms AND 512 THEN ' mousewheel to change magnification factor
magfactor% = magfactor% - 1
IF magfactor% < 1 THEN magfactor% = 1
END IF
IF ms AND 1024 THEN
magfactor% = magfactor% + 1
IF magfactor% > 30 THEN magfactor% = 30
END IF
_LIMIT 30
_DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
SUB Make_Mask (s%, sc%)
cn% = _SHR(s%, 1) - 1 ' image center
IF msk& < -1 THEN _FREEIMAGE msk& ' remove old mask if any
IF sc% THEN ' if scope enabled, draw crosshairs
ret& = _NEWIMAGE(s%, s%, 32) ' define reticle image
_DEST ret& ' destination to reticle
CLS '
_CLEARCOLOR _RGB32(0, 0, 0) ' background transparent
CIRCLE (cn%, cn%), cn%, &HFFFF0000 ' circular border
CIRCLE (cn%, cn%), cn% - 1, &HFFFF0000
CIRCLE (cn%, cn%), cn% - 2, &HFFFF0000
LINE (0, cn%)-(s% - 1, cn%), &HFFFF0000 ' scope reticle
LINE (s% / 3, cn% + 1)-(s% * (2 / 3), cn% + 1), &HFFFF0000
LINE (cn% + 1, s% / 3)-(cn% + 1, s% * (2 / 3)), &HFFFF0000
LINE (cn%, 0)-(cn%, s% - 1), &HFFFF0000
END IF
msk& = _NEWIMAGE(s%, s%, 32) ' create mask image
_DEST msk&
COLOR , _RGB32(255, 0, 255) ' fill mask with purple to clear color in SUB Magnify
CLS
FCirc cn%, cn%, cn%, _RGB32(0, 0, 0) ' apply centered black circle to clearcolor in SUB Magnify
IF ret& < -1 THEN _PUTIMAGE , ret&: _FREEIMAGE ret& '
_DEST 0 '
END SUB 'Make_Mask
SUB Magnify (mf%, src&, s%, r!)
hs% = _SHR(s%, 1): hf% = hs% / mf% ' radius and mag at radius
x% = map!(_MOUSEX, 0, _WIDTH(src&) * r!, 0, _WIDTH(src&) - 1) 'map mouse position relative to image
y% = map!(_MOUSEY, 0, _HEIGHT(src&) * r!, 0, _HEIGHT(src&) - 1)
mag& = _NEWIMAGE(s%, s%, 32) ' Create magnifier lense
_PUTIMAGE , src&, mag&, (x% - hf%, y% - hf%)-(x% + hf%, y% + hf%) 'portion of src& to mag&
_DEST mag&
_CLEARCOLOR _RGB32(0, 0, 0), msk& ' set clearcolor to inner circle of mask
_PUTIMAGE , msk&, mag& ' overlay on magnifier
_CLEARCOLOR _RGB32(255, 0, 255), mag& ' clearcolor purple corners of mag& placed by mask
_PUTIMAGE (_MOUSEX - hs% - 1, _MOUSEY - hs% - 1), mag&, 0 ' place finished magnifier to screen, mouse centered
_FREEIMAGE mag&
END SUB 'Magnify
SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG) 'by Steve McNeill
DIM R AS INTEGER, RError AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
R = ABS(RR)
RError = -R
X = R
Y = 0
IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RError = RError + Y * 2 + 1
IF RError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RError = RError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB 'FCirc
SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
DIM AS INTEGER xs, ys, xp, yp, xl, yl ' ready for OPTION EXPLICIT programs
xp = xpos: yp = ypos: xl = xlim: yl = ylim ' isolate sent parameters from any changes
DIM AS SINGLE rt, xrt, yrt
xrt = (xl - xp) / _WIDTH(i) ' width of area divided by width of image
yrt = (yl - yp) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
xl = xp + xs
yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION 'map!
FUNCTION MBS% 'by Steve McNeill
STATIC StartTimer AS _FLOAT
STATIC ButtonDown AS INTEGER
'STATIC ClickCount AS INTEGER
CONST ClickLimit## = .4 'Less than 1/2 of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
SELECT CASE SGN(_MOUSEWHEEL)
CASE 1: tempMBS = tempMBS OR 512
CASE -1: tempMBS = tempMBS OR 1024
END SELECT
WEND
IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS OR 4
IF StartTimer = 0 THEN
IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(2) THEN
ButtonDown = 2: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(3) THEN
ButtonDown = 3: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
END IF
ELSE
BD = ButtonDown MOD 3
IF BD = 0 THEN BD = 3
IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit. It's a click
IF _MOUSEBUTTON(BD) = 0 THEN tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
ELSE
IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
ELSE 'We've now started the hold event
tempMBS = tempMBS OR 32 * 2 ^ ButtonDown
END IF
END IF
END IF
MBS% = tempMBS
END FUNCTION 'MBS%