TBZoom

[ErosOlmi]

Few lines of code to create a desktop magnifier.
Minimum thinBasic version 1.10.6 is needed: https://www.thinbasic.com/community/showthread.php?12778-thinBasic-1-10-x


Have fun to personalize it to your needs.

Ciao
Eros


uses "UI"

#MinVersion 1.10.6

begin CONTROLID
%IDC_Graphic
%ID_Timer_CopyScreen
%IDM_ZoomIn
%IDM_ZoomOut
End CONTROLID

Const sTitle as string = "thinBasic Zoom"

dim hDlg, hGraphic, hGraphicDC As Dword
dim Zoom As Single '---Current zoom factor
Dim ZoomStep as single = 0.2 '---Zoom Increment/Decrement step
dim MousePosition As POINTAPI

Function TBMain() As Long
Dialog New Pixels, 0, sTitle, -1, -1, 640, 480, %WS_OverlappedWindow To hDlg

Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
Local rc As Rect
local w, h As Long

Select Case CbMsg
Case %WM_InitDialog
Zoom = 1

Control Add Canvas, CBHNDL, %IDC_Graphic, "", 0, 0, 1, 1
Control Handle CBHNDL, %IDC_Graphic To hGraphic

Canvas_Attach CBHNDL, %IDC_Graphic, %TRUE
hGraphicDC = Canvas_GetDC

BuildAcceleratorTable(CBHNDL)

DIALOG SET TIMER CBHNDL, %ID_Timer_CopyScreen, 60' [, cbFunction]

DlgTitle(CBHNDL)

Case %WM_Command
Select Case CbCtl
Case %IDM_ZoomIn
Zoom = Min(10, Zoom + ZoomStep)
DlgTitle(CBHNDL)
CopyScreen(CBHNDL)

Case %IDM_ZoomOut
Zoom = Max(0.1, Zoom - ZoomStep)
DlgTitle(CBHNDL)
CopyScreen(CBHNDL)
End Select

Case %WM_ContextMenu
Incr Zoom
If Zoom > 10 Then Zoom = 1
DlgTitle(CBHNDL)
CopyScreen(CBHNDL)

Case %WM_Timer

select case CBWPARAM
case %ID_Timer_CopyScreen
win_getCursorPos MousePosition
win_GetWindowRect hGraphic, rc

'---Copy screen only if mouse position is outside zoom window client rect or not foregound window
If isfalse(win_PtInRect(rc, MousePosition)) or isfalse(Win_GetForegroundWindow = CBHNDL) Then
CopyScreen(CBHNDL)
end if

end Select

Case %WM_Size
Dialog Get Client CBHNDL To w, h
Control Set Size CBHNDL, %IDC_Graphic, w, h

End Select
End Function

function DlgTitle(byval hDlg as Long)
Dialog Set Text hDlg, sTitle + " " + Zoom + "X - CTRL P, CTRL M or right click in client area"
end Function

Sub CopyScreen(byval hDlg as Long)
Local hDeskTopDC As Dword
local w, h As Long

Dialog Get Client hDlg To w, h

canvas_Clear
hDeskTopDC = win_GetDC(%Null)

'---Copy and stretch screen area under mouse pointer into canvas area using zoom factor
win_StretchBlt hGraphicDC, '---Destination DC and its area
0,
0,
w,
h,
hDeskTopDC, '---Source DC and its area zoomed by current zoom factor
MousePosition.x - w/Zoom/2,
MousePosition.y - h/Zoom/2,
w/Zoom,
h/Zoom,
%SRCCopy '---Raster operation code

win_ReleaseDC(%Null, hDeskTopDC)

'---Optional square at the center of viewing area
canvas_Width 2
canvas_Box w/2-10, h/2-10, w/2+10, h/2+10, 0, %Red

'---Box around the edge
canvas_Width 2
canvas_Box 0, 0, w, h, 0, %Black

canvas_ReDraw
End Sub

'-----------------------------------------------------------
' Attach to a window some hot keys corresponding to commands
'-----------------------------------------------------------
Sub BuildAcceleratorTable(byval hDlg as long)
local ac(2) As ACCELAPI
'local hAccelerator As Dword ' for keyboard accelerator table values

'---CTRL+M for Zoom Out
ac(1).fvirt = %FVIRTKEY Or %FCONTROL
ac(1).key = %VK_M
ac(1).cmd = %IDM_ZoomOut

'---CTRL+P for Zoom In
ac(2).fvirt = %FVIRTKEY Or %FCONTROL
ac(2).key = %VK_P
ac(2).cmd = %IDM_ZoomIn

'---Attach accelerators to a window
Accel Attach hDlg, AC()' To hAccelerator
End Sub