Microsoft Visual Basic: Zoomin tool - anyone built a VB5/6 equivalent?

"Bob O`Bob" <filterbob...yahoogroups.com> wrote in message
news:ulM0Zxb6HHA.484...TK2MSFTNGP06.phx.gbl...
> Many of you are probably at least passing-familiar with the "Zoomin"
> applet that shipped with Visual Studio at least as far back as 1998.
> I have a need for a custom version of something very much like that, as an
> aid to limited-vision users. And I'd make it available free, in case that
> helps inspire anyone.
> I am hopeful that someone has done most of the work to give me a starting
> point that's pretty close to zoomin, and I'll take it from there.
> I don't need to tweak it a whole lot, mostly just need to change the
> click/drag behaviors.
>
> If I have to start from scratch it may take a lot longer, but I'm sure I
> would still be happy to give the product away. Maybe not the source,
> then, since I might do a "quick & dirty" that works but is ugly inside.
>
> Bob
> --

I've never used the tool you describe... but, I use the Windows Magnifier
all the time. Initially, it docks against the top of the screen, but you can
pull it down and size it any way you want. Magnification settings are 1-9x.
I have a shortcut on my "Quick Launch" bar.

Here's one written in VB... with 1-100x magnification... since I've never
used Zoomin, I'm not sure what it's capabilities are... but this one seems
to be able to get pixel info, screen location and a few others...

WinZoom (Best Windows Magnifing Application)
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=66417&lngWId=1
--
Ken Halter - MS-MVP-VB - Please keep all discussions in the groups..
In Loving Memory - http://www.vbsight.com/Remembrance.htm

Hi Bob ...

Mike Sutton posted this some time ago. Needs a pixbox and a timer w/default
names. Watch for line wraps.

Option Explicit

'Mike Sutton - msnews

'Returns the position of the mouse pointer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As
Long

'Draws the 'magnified' view to the screen.
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As
Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

'Returns the handle (hWnd) of the Desktop window
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'Returns the DC location from a window handle
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

'Sets the window to being 'Always on-top'
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long,
ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal
cy As Long, ByVal wFlags As Long) As Long

'Used with the GetCursorPos() call
Private Type POINTAPI
x As Long
y As Long
End Type

'StretchBlt() constant
Const SrcCopy = &HCC0020

'SetWindowPos() constants
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

'The number of times to scale up from the oringial
Const Zoom = 2

'The number of pixels (Square) to zoom
Const PicBoxScale = 200

Private Sub Form_Load()

'Make the window always on top
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS

'Set up the GUI
With Picture1
.Width = (Zoom * PicBoxScale) * Screen.TwipsPerPixelX
.Height = (Zoom * PicBoxScale) * Screen.TwipsPerPixelY
.Left = 0
.Top = 0
.AutoRedraw = True
.ScaleMode = 3
.BackColor = 0
Me.Width = .Width + 90
Me.Height = .Height + 380
Me.Caption = "Maginifier"
End With

'Start the timer to refresh the
'screen 20 times a second
Timer1.Interval = 50
Timer1.Enabled = True

End Sub

Private Sub Form_Resize()

Picture1.Width = (Zoom * PicBoxScale) * Screen.TwipsPerPixelX
Picture1.Height = (Zoom * PicBoxScale) * Screen.TwipsPerPixelY
Picture1.Left = 0
Picture1.Top = 0

End Sub

Private Sub Timer1_Timer()

Dim CursorPos As POINTAPI
Dim BlitCoord As POINTAPI
Dim OffsetX As Integer
Dim OffsetY As Integer

'Get the position of the mouse pointer
Call GetCursorPos(CursorPos)

'Offsets for checking the position of the blit
OffsetX = (Picture1.ScaleWidth / Zoom)
OffsetY = (Picture1.ScaleHeight / Zoom)

'Set the blit coordinates so that only the screen region is captured
' (Otherwise it would attempt to blit from off the edge of the scrren)
BlitCoord.x = CheckVal(CursorPos.x - (OffsetX / 2), 0, (Screen.Width /
Screen.TwipsPerPixelX) - OffsetX)
BlitCoord.y = CheckVal(CursorPos.y - (OffsetY / 2), 0, (Screen.Height /
Screen.TwipsPerPixelY) - OffsetY)

'Capture the screen and display on the form
Call StretchBlt(Picture1.hdc, _
0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
GetDC(GetDesktopWindow()), _
BlitCoord.x, _
BlitCoord.y, _
Picture1.ScaleWidth / Zoom, _
Picture1.ScaleHeight / Zoom, _
vbSrcCopy)

'Refresh the picture box
Call Picture1.Refresh
End Sub

Function CheckVal(inVal As Long, inMin As Long, inMax As Long) As Long
'Function to make sure a variable is within a certan range.
If inVal < inMin Then
CheckVal = inMin
ElseIf inVal > inMax Then
CheckVal = inMax
Else
CheckVal = inVal
End If
End Function
Randy Birch
MS MVP, Visual Basic
http://vbnet.mvps.org/

Please respond to the newsgroups so all can benefit.

"Bob O`Bob" <filterbob...yahoogroups.com> wrote in message
news:ulM0Zxb6HHA.484...TK2MSFTNGP06.phx.gbl...
Many of you are probably at least passing-familiar with the "Zoomin" applet
that shipped with Visual Studio at least as far back as 1998.

I have a need for a custom version of something very much like that, as an
aid to limited-vision users. And I'd make it available free, in case that
helps inspire anyone.

I am hopeful that someone has done most of the work to give me a starting
point that's pretty close to zoomin, and I'll take it from there.

I don't need to tweak it a whole lot, mostly just need to change the
click/drag behaviors.

If I have to start from scratch it may take a lot longer, but I'm sure I
would still be happy to give the product away. Maybe not the source, then,
since I might do a "quick & dirty" that works but is ugly inside.

Bob
--