John G Duffy
June 19th, 2001, 04:56 PM
I am working on a project to replicate a PictureBox using StretchBlt and got most of everything working except I can not get the dimensions to work out.
My one inch square PictureBox I am copying turns out to be 1.5 x 1.5. inches after the StretchBlt.
Everything I have seen says that there are 1440 TwipsPerInch but I am now questioning that premise based on the following sample.
This sample takes a 1 inch square (as measured with a ruler) PictureBox and copies it using StretchBlt passing what I thought were one inch measurements but apparently not.
When I change the TwipsPerInch constant to 1035 it seems to work better.
Could someone please tell me what stupid thing I am doing wrong.
Start a new project, add 2 PictureBoxes and a command Button. Set AutoRedraw and AutoSize to True. Add a Picture to PictureBox1. Copy this code and run it. Picture2 should be about 1 1/2 inches wide and long. How Come?
'
INcidentally, When I set a PictureBOx on the screen to be approximately 1" square (Measured with a ruler), it is 1035 twips. So what is 1440?
option Explicit
Const SRCCOPY = &HCC0020 ' Copies image exactly
Const TwipsperInch = 1440
private Declare Function CreateCompatibleDC Lib "gdi32" (byval hdc as Long) as Long
private Declare Function SelectObject Lib "gdi32" (byval hdc as Long, byval hObject as Long) as Long
private Declare Function DeleteObject Lib "gdi32" (byval hObject as Long) as Long
private Declare Function StretchBlt Lib "gdi32" (byval hdc as Long, byval X as Long, byval Y as Long, byval nWidth as Long, byval nHght 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 DeleteDC Lib "gdi32" (byval hdc as Long) as Long
public Sub CopyPictureToTarget(Src as PictureBox, tgt as Variant, l, t, w, h)
' Do some Magic
Dim hMemoryDC as Long
Dim hOldBitMap as Long
Dim lret
' Do some Magic
hMemoryDC = CreateCompatibleDC(Src.hdc)
hOldBitMap = SelectObject(hMemoryDC, Src.Picture)
'
' Copy picture to the target hdc
lret = StretchBlt(tgt.hdc, l, t, w, h, _
hMemoryDC, 0, 0, Src.ScaleWidth, _
Src.ScaleHeight, SRCCOPY)
'
If lret = 0 then Stop
' Restore the magic
hOldBitMap = SelectObject(hMemoryDC, hOldBitMap)
' Cleanup
lret = DeleteDC(hMemoryDC)
End Sub
private Sub Command1_Click()
Dim OneInchX as Long
Dim OneInchY as Long
OneInchX = TwipsperInch / Screen.TwipsPerPixelY
OneInchY = TwipsperInch / Screen.TwipsPerPixelY
print OneInchX; " "; OneInchY
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
CopyPictureToTarget Picture1, Picture2, 0, 0, OneInchX, OneInchY
Picture2.Refresh
End Sub
John G
My one inch square PictureBox I am copying turns out to be 1.5 x 1.5. inches after the StretchBlt.
Everything I have seen says that there are 1440 TwipsPerInch but I am now questioning that premise based on the following sample.
This sample takes a 1 inch square (as measured with a ruler) PictureBox and copies it using StretchBlt passing what I thought were one inch measurements but apparently not.
When I change the TwipsPerInch constant to 1035 it seems to work better.
Could someone please tell me what stupid thing I am doing wrong.
Start a new project, add 2 PictureBoxes and a command Button. Set AutoRedraw and AutoSize to True. Add a Picture to PictureBox1. Copy this code and run it. Picture2 should be about 1 1/2 inches wide and long. How Come?
'
INcidentally, When I set a PictureBOx on the screen to be approximately 1" square (Measured with a ruler), it is 1035 twips. So what is 1440?
option Explicit
Const SRCCOPY = &HCC0020 ' Copies image exactly
Const TwipsperInch = 1440
private Declare Function CreateCompatibleDC Lib "gdi32" (byval hdc as Long) as Long
private Declare Function SelectObject Lib "gdi32" (byval hdc as Long, byval hObject as Long) as Long
private Declare Function DeleteObject Lib "gdi32" (byval hObject as Long) as Long
private Declare Function StretchBlt Lib "gdi32" (byval hdc as Long, byval X as Long, byval Y as Long, byval nWidth as Long, byval nHght 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 DeleteDC Lib "gdi32" (byval hdc as Long) as Long
public Sub CopyPictureToTarget(Src as PictureBox, tgt as Variant, l, t, w, h)
' Do some Magic
Dim hMemoryDC as Long
Dim hOldBitMap as Long
Dim lret
' Do some Magic
hMemoryDC = CreateCompatibleDC(Src.hdc)
hOldBitMap = SelectObject(hMemoryDC, Src.Picture)
'
' Copy picture to the target hdc
lret = StretchBlt(tgt.hdc, l, t, w, h, _
hMemoryDC, 0, 0, Src.ScaleWidth, _
Src.ScaleHeight, SRCCOPY)
'
If lret = 0 then Stop
' Restore the magic
hOldBitMap = SelectObject(hMemoryDC, hOldBitMap)
' Cleanup
lret = DeleteDC(hMemoryDC)
End Sub
private Sub Command1_Click()
Dim OneInchX as Long
Dim OneInchY as Long
OneInchX = TwipsperInch / Screen.TwipsPerPixelY
OneInchY = TwipsperInch / Screen.TwipsPerPixelY
print OneInchX; " "; OneInchY
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
CopyPictureToTarget Picture1, Picture2, 0, 0, OneInchX, OneInchY
Picture2.Refresh
End Sub
John G