TBZoom

[ErosOlmi]

Few lines of code to create a desktop magnifier.
Minimum thinBasic version 1.10.6 is needed: https://www.thinbasic.com/community/...inBasic-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