Results 1 to 1 of 1

Thread: TBZoom

  1. #1
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10

    TBZoom

    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
    
    Attached Images Attached Images
    Attached Files Attached Files
    Last edited by ErosOlmi; 26-03-2019 at 07:47.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •