Zoom question (copy from FOX's forum)

The Question is: I thy to using next SUB to Zoom out a picture, and I always get a picture trim by orignal width and height of picture in that icturebox(Front), I think TempDC and TileDC is fixed size at SelectObject API

Can I adjust Width and Height of a DC that is created by using CreateCompatibleDC API?


a testing code is derived from FOX's OffscreenDC :

Private Sub cmdZoomOut_Click()

Dim newW As Long, newH As Long
Screen.MousePointer = vbHourglass
If plus < 10 Then

plus = plus + 1
newW = W * plus
newH = H * plus

StretchBlt TempDC, 0, 0, newW, newH, TileDC, 0, 0, W, H, vbSrcCopy
'TempDc and TileDc is created using loadDC method from mCore Module
BitBlt Front.hdc, 0, 0, newW, newH, TempDC, 0, 0, vbSrcCopy
'Front is a picturebox for display

'If above 2 statements is replaced by (StretchBlt front.hdc, 0, 0, newW, newH, TileDC, 0, 0, W, H, vbSrcCopy)
'I can get result i need, but newW/newH is limited in about 3000pixels and speed is intolerable.

Front.SetFocus
Screen.MousePointer = vbDefault
End If

End Sub

Hm you should not zoom the whole picture, zoom the part that's visible instead. Say your screen is 1024x768, and you want to zoom your picture x 10, that means ~102x76 pixels are visible, and you only need to zoom this part of your image. See the idea? :)

thks ur reply, i see that.

But the problem I encounted is :
If size of the picture loaded is 600x400, I only can see 600x400
pixels even i stretched it to 6000x4000 (my screen is 1024x768),

StretchBlt TempDC, 0, 0, newW, newH, TileDC, 0, 0, W, H, vbSrcCopy

( TempDC's Width/Height cann't be stetch but picture data has be stretched)

I think DC's width/Height is fixed value after use SelectObject API(=size of loadpicture)? can I modify them?

ok, I just modified this SUB, now can get result expected

but why the picturebox 's AutoRedraw property must be set false,
so When this program lostfocus and get back, the picutre will
be invisible temporarily.

Private Sub cmdZoomOut_Click()
Dim i As Single, j As Single
Dim newW As Long, newH As Long
Screen.MousePointer = vbHourglass
If plus > 15 Then
plus = plus - 1
newW = W * plus
newH = H * plus

For i = 1 To plus
For j = 1 To plus
StretchBlt TempDC, 0, 0, newW, newH, TileDC, W * (j - 1) / plus, H * (i - 1) / plus, W, H, vbSrcCopy

BitBlt Front.hdc, W * (j - 1), H * (i - 1), W, H, TempDC, 0, 0, vbSrcErase

'Erase previous picture zoomed, when reset "plus"

Next j
Next i
plus = 1

End If

newW = W * plus
newH = H * plus

'zoom picture

For i = 1 To plus
For j = 1 To plus
StretchBlt TempDC, 0, 0, newW, newH, TileDC, W * (j - 1) / plus, H * (i - 1) / plus, W, H, vbSrcCopy

BitBlt Front.hdc, W * (j - 1), H * (i - 1), W, H, TempDC, 0, 0, vbSrcCopy

Next j
Next i

plus = plus + 1

Front.SetFocus
Screen.MousePointer = vbDefault
Exit Sub
End Sub