There may be a way to this with a stretched image control, but this
seems to work OK. New project, 2 picture boxes, 2 command buttons:
Option Explicit
Private Const HALFTONE As Long = 4
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
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, _
ByVal nStretchMode As Long) As Long
Private Sub Form_Load()
With Picture2 'source
.AutoRedraw = True
.ScaleMode = vbPixels
.Visible = False
' .AutoSize = True 'use if loading a graphic
Picture2.Print "Some Picture Box Text"
'or .Picture = LoadPicture("c:\somefolder\somegraphic.bmp")
End With
With Picture1 'dest
'I've heard this improves quality
SetStretchBltMode .hdc, HALFTONE
.AutoRedraw = True
.ScaleMode = vbPixels
.Move 0, 0, Picture2.Width, Picture2.Height
.Picture = Picture2.Picture
End With
Command1.Caption = "Zoom &In"
Command2.Caption = "Zoom &Out"
End Sub
Private Sub Command1_Click()
'zoom in by 20%
With Picture1
.Move 0, 0, .Width * 1.2, .Height * 1.2
.Cls
StretchBlt .hdc, 0, 0, .ScaleWidth, .ScaleHeight, Picture2.hdc, 0, 0,
Picture2.ScaleWidth, Picture2.ScaleHeight, vbSrcCopy
End With 'Picture1
End Sub
Private Sub Command2_Click()
'zoom out by 20%
With Picture1
.Move 0, 0, .Width * 0.8, .Height * 0.8
.Cls
StretchBlt .hdc, 0, 0, .ScaleWidth, .ScaleHeight, Picture2.hdc, 0, 0,
Picture2.ScaleWidth, Picture2.ScaleHeight, vbSrcCopy
End With 'Picture1
End Sub