From: Mike Williams on
"Mike D Sutton" <EDais(a)mvps.org> wrote in message
news:%23vwG5tHzGHA.4408(a)TK2MSFTNGP05.phx.gbl...

> How is loading the JPEG, saving it to disk then reloading
> it simpler than just loading the JPEG? ;)

I didn't mean it was a simple way of loading the picture, Mike. What I said
is that for a test system set to full colour it is a simple way of testing
the LoadImage API to see what quality it gives when stretching (load a jpg
into a VB autoredraw picture box and use SavePicture to save the Image as a
bmp file and then load and stretch the bmp file in one go using the
LoadImage API). That is only a test bed method which can be knocked up very
quickly for simply checking the quality of the stretch produced by LoadImage
on bitmaps, on the grounds that it would be pointless spending time writing
more complex code to perform the task on all colour depth systems if the
quality was not up to scratch anyway. My own personal opinion is that the
LoadImage stretch quality is fine, but of course this stuff is subjective
and others might disagree.

> At least when VB returns the image in a StdPicture object
> it appears to be a DIB, which should mean it has no problems
> loading the image, just . . .

Actually I'm not so sure about that Mike. If that is the case then shouldn't
the following code return the value 24 on a system running at 16 bit colour
depth? In fact it doesn't. It returns the value 16.

Dim p1 As StdPicture
Dim myBmp As BITMAP
Dim retval As Long
Set p1 = LoadPicture("c:\tulips.jpg")
retval = GetObject(p1.Handle, Len(myBmp), myBmp)
MsgBox myBmp.bmBitsPixel

> LoadImage()'s scaling uses StretchDIBits() internally
> and sets COLORONCOLOR stretch mode which is
> natively available

I don't think so Mike. Try drawing some text and a few circles on top of a
1024 x 768 full color bitmap and then stretch it to 800 x 600 using both
COLORONCOLOR (Stretch mode 3) and the LoadImage API. You'll find there is a
big difference in quality, with LoadImage performing much better than
COLORONCOLOR.

Mike Williams







From: Mike D Sutton on
> Adding to Stefan's reply... that search returns nothing, even if you let Google convert the "nt" to "net".
>
> This'n does though <g> (dropped the quotes and the reference to NT)... and, they're mostly VB6 related.... and, since
> there are at least 2 in the list from vbaccelerator.com, that's where I'd head for sample code.
>
> Results 1 - 50 of about 83 English pages for SetBrushOrgEx VB
> http://www.google.com/search?num=100&hl=en&lr=lang_en&as_qdr=all&q=SetBrushOrgEx+VB&lr=lang_en

Calling SetBrushOrgEx() isn't suddenly going to make halftone interpolation magically work on older OS.. The problem is
that StretchBlt() sometimes modifies the brush origin on the target DC during the call, so if you've previously set the
brush origin it may have been modified after the call. Since from what the OP has described has nothing to do with
using brushes on the same DC it doesn't really matter one way or the other.
FWIW,

Mike


- Microsoft Visual Basic MVP -
E-Mail: EDais(a)mvps.org
WWW: Http://EDais.mvps.org/


From: mayayana on

A followup on VBAccelerator: It turns out that
there's a project there by Steve McMahon,
vbImageProc2, that uses a custom routine
to resize. I don't know what to make of this,
as compared to StretchBlt. Any opinions,
anyone? I'm pasting it below because it's
fairly compact. The code is out of context, but
probably self-explanatory. It comes out of a DIB
class, with two arrays being created based on the
pointer to the DIB bits held in each class, and
then the resizing done to those.

(Note: I'll be doing all cropping first, so no
resizing will be to different width/height ratio,
and resizing will probably only be to smaller, in
case that matters.)

----------------

Private Function ResampleDib(ByRef cDibTo As cDIBSection) As Boolean
Dim bDibFrom() As Byte
Dim bDibTo() As Byte

Dim tSAFrom As SAFEARRAY2D
Dim tSATo As SAFEARRAY2D

' Get the bits in the from DIB section:
With tSAFrom
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = m_tBI.bmiHeader.biHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = BytesPerScanLine()
.pvData = m_lPtr
End With
CopyMemory ByVal VarPtrArray(bDibFrom()), VarPtr(tSAFrom), 4

' Get the bits in the to DIB section:
With tSATo
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = cDibTo.Height
.Bounds(1).lLbound = 0
.Bounds(1).cElements = cDibTo.BytesPerScanLine()
.pvData = cDibTo.DIBSectionBitsPtr
End With
CopyMemory ByVal VarPtrArray(bDibTo()), VarPtr(tSATo), 4

Dim xScale As Single
Dim yScale As Single

Dim x As Long, y As Long, xEnd As Long, xOut As Long

Dim fX As Single, fY As Single
Dim ifY As Long, ifX As Long
Dim dX As Single, dy As Single
Dim r As Long, r1 As Single, r2 As Single, r3 As Single, r4 As Single
Dim g As Long, g1 As Single, g2 As Single, g3 As Single, g4 As Single
Dim b As Long, b1 As Single, b2 As Single, b3 As Single, b4 As Single
Dim ir1 As Long, ig1 As Long, ib1 As Long
Dim ir2 As Long, ig2 As Long, ib2 As Long

xScale = (Width - 1) / cDibTo.Width
yScale = (Height - 1) / cDibTo.Height

xEnd = cDibTo.Width - 1

For y = 0 To cDibTo.Height - 1

fY = y * yScale
ifY = Int(fY)
dy = fY - ifY

For x = 0 To xEnd
fX = x * xScale
ifX = Int(fX)
dX = fX - ifX

ifX = ifX * 3
' Interpolate using the four nearest pixels in the source
b1 = bDibFrom(ifX, ifY): g1 = bDibFrom(ifX + 1, ifY): r1 =
bDibFrom(ifX + 2, ifY)
b2 = bDibFrom(ifX + 3, ifY): g2 = bDibFrom(ifX + 4, ifY): r2 =
bDibFrom(ifX + 5, ifY)
b3 = bDibFrom(ifX, ifY + 1): g3 = bDibFrom(ifX + 1, ifY + 1): r3
= bDibFrom(ifX + 2, ifY + 1)
b4 = bDibFrom(ifX + 3, ifY + 1): g4 = bDibFrom(ifX + 4, ifY +
1): r4 = bDibFrom(ifX + 5, ifY + 1)

' Interplate in x direction:
ir1 = r1 * (1 - dy) + r3 * dy: ig1 = g1 * (1 - dy) + g3 * dy:
ib1 = b1 * (1 - dy) + b3 * dy
ir2 = r2 * (1 - dy) + r4 * dy: ig2 = g2 * (1 - dy) + g4 * dy:
ib2 = b2 * (1 - dy) + b4 * dy
' Interpolate in y:
r = ir1 * (1 - dX) + ir2 * dX: g = ig1 * (1 - dX) + ig2 * dX: b
= ib1 * (1 - dX) + ib2 * dX

' Set output:
If (r < 0) Then r = 0
If (r > 255) Then r = 255
If (g < 0) Then g = 0
If (g > 255) Then g = 255
If (b < 0) Then b = 0
If (b > 255) Then
b = 255
End If
xOut = x * 3
bDibTo(xOut, y) = b
bDibTo(xOut + 1, y) = g
bDibTo(xOut + 2, y) = r

Next x

Next y

' Clear the temporary array descriptor
' (This does not appear to be necessary, but
' for safety do it anyway)
CopyMemory ByVal VarPtrArray(bDibFrom), 0&, 4
CopyMemory ByVal VarPtrArray(bDibTo), 0&, 4


End Function





From: mayayana on

> > How is loading the JPEG, saving it to disk then reloading
> > it simpler than just loading the JPEG? ;)
>
> I didn't mean it was a simple way of loading the picture, Mike. What I
said
> is that for a test system set to full colour it is a simple way of testing
> the LoadImage API to see what quality it gives when stretching (load a jpg
> into a VB autoredraw picture box and use SavePicture to save the Image as
a
> bmp file and then load and stretch the bmp file in one go using the
> LoadImage API). That is only a test bed method which can be knocked up
very
> quickly for simply checking the quality of the stretch produced by
LoadImage
> on bitmaps, on the grounds that it would be pointless spending time
writing
> more complex code to perform the task on all colour depth systems if the
> quality was not up to scratch anyway. My own personal opinion is that the
> LoadImage stretch quality is fine, but of course this stuff is subjective
> and others might disagree.
>
> > At least when VB returns the image in a StdPicture object
> > it appears to be a DIB, which should mean it has no problems
> > loading the image, just . . .
>
> Actually I'm not so sure about that Mike. If that is the case then
shouldn't
> the following code return the value 24 on a system running at 16 bit
colour
> depth? In fact it doesn't. It returns the value 16.
>
> Dim p1 As StdPicture
> Dim myBmp As BITMAP
> Dim retval As Long
> Set p1 = LoadPicture("c:\tulips.jpg")
> retval = GetObject(p1.Handle, Len(myBmp), myBmp)
> MsgBox myBmp.bmBitsPixel
>
> > LoadImage()'s scaling uses StretchDIBits() internally
> > and sets COLORONCOLOR stretch mode which is
> > natively available
>
> I don't think so Mike. Try drawing some text and a few circles on top of a
> 1024 x 768 full color bitmap and then stretch it to 800 x 600 using both
> COLORONCOLOR (Stretch mode 3) and the LoadImage API. You'll find there is
a
> big difference in quality, with LoadImage performing much better than
> COLORONCOLOR.
>
That's an interesting idea. LoadImage is coming from
User32, although that does have a dependency on GDI32.

The difficulty to my mind is that I'm not sure I'm capable
of really judging the quality difference if StretchBlt is
reasonably good. There might be shades of quality that
wouldn't show up onscreen but would show up in a print.
I can try StretchBlt, LoadImage, and Steve McMahon's
routine to see how they all compare, but I suspect I'm
probably going to just end up bug-eyed and confused.


From: Mike D Sutton on
> Actually I'm not so sure about that Mike. If that is the case then shouldn't the following code return the value 24 on
> a system running at 16 bit colour depth? In fact it doesn't. It returns the value 16.
<snip>

Under XP I'm getting a 24-bit DIB regardless of the display depth, WinME is capping it at the display depth however it's
still returning a DIB so the size restrictions of a DDB do not apply which is the point I was making. Whether this
means it's going through a DDB to get there, or the display driver simply decides to down-sample from DIB to DIB I
couldn't say for sure.

> I don't think so Mike. Try drawing some text and a few circles on top of a 1024 x 768 full color bitmap and then
> stretch it to 800 x 600 using both COLORONCOLOR (Stretch mode 3) and the LoadImage API. You'll find there is a big
> difference in quality, with LoadImage performing much better than COLORONCOLOR.

I'm getting pixel-for-pixel exactly the same image using LoadImage as with COLORONCOLOR stretch mode, here's a demo app
to demo that:

'***
Private Declare Function CreateCompatibleDC Lib "GDI32.dll" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "GDI32.dll" (ByVal hDC As Long, ByRef pBitmapInfo As BitmapInfoHeader,
ByVal un As Long, ByRef lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "GDI32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long,
ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BitmapInfoHeader, ByVal wUsage As Long) As Long
Private Declare Function TextOut Lib "GDI32.dll" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long,
ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function Ellipse Lib "GDI32.dll" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As
Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "GDI32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As
Long) As Long
Private Declare Function SelectObject Lib "GDI32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "GDI32.dll" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "GDI32.dll" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long,
ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Long, ByVal
fdwUnderline As Long, ByVal fdwStrikeOut As Long, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal
fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function LoadImage Lib "User32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpszName As String,
ByVal uType As Long, ByVal cxDesirded As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
Private Declare Function SetStretchBltMode Lib "GDI32.dll" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "GDI32.dll" (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 BitBlt Lib "GDI32.dll" (ByVal hDestDC 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 dwRop As Long) As
Long

Private Type BitmapInfoHeader ' 40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Private Sub Form_Load()
Dim BMInfo As BitmapInfoHeader
Dim hDC As Long, hBMP As Long, hOldBMP As Long
Dim DataPtr As Long
Dim hFont As Long, hOldFont As Long
Dim hPen As Long, hOldPen As Long
Dim TempPic As StdPicture

Const BI_RGB As Long = &H0
Const DIB_RGB_COLORS As Long = &H0
Const DemoText As String = "Hello, world!"
Const PS_SOLID As Long = &H0
Const PicPath As String = "C:\temp.bmp"
Const IMAGE_BITMAP As Long = &H0
Const LR_LOADFROMFILE As Long = &H10
Const COLORONCOLOR As Long = &H3
Const HALFTONE As Long = &H4
Const FW_BOLD As Long = 700

With BMInfo
.biSize = Len(BMInfo)
.biWidth = 800
.biHeight = 600
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
End With

hDC = CreateCompatibleDC(0&)
hBMP = CreateDIBSection(hDC, BMInfo, DIB_RGB_COLORS, DataPtr, 0, 0)
hOldBMP = SelectObject(hDC, hBMP)

hPen = CreatePen(PS_SOLID, 40, vbRed)
hOldPen = SelectObject(hDC, hPen)
Call Ellipse(hDC, 100, 100, 700, 500)
Call SelectObject(hDC, hOldPen)
Call DeleteObject(hPen)

hFont = CreateFont(50, 0, 0, 0, FW_BOLD, 0, 0, 0, 0, 0, 0, 0, 0, "Arial")
hOldFont = SelectObject(hDC, hFont)
Call TextOut(hDC, 50, 50, DemoText, Len(DemoText))
Call SelectObject(hDC, hOldFont)
Call DeleteObject(hFont)

Set TempPic = GDIToPicture(hBMP, False)
Call SavePicture(TempPic, PicPath)
Set TempPic = Nothing

Me.AutoRedraw = True ' Eugh..
Call SetStretchBltMode(Me.hDC, COLORONCOLOR)
Call StretchBlt(Me.hDC, 0, 0, 100, 100, hDC, 0, 0, BMInfo.biWidth, BMInfo.biHeight, vbSrcCopy)
Call StretchBlt(Me.hDC, 0, 100, 100, 100, hDC, 0, 0, BMInfo.biWidth, BMInfo.biHeight, vbSrcCopy)
Call SetStretchBltMode(Me.hDC, HALFTONE)
Call StretchBlt(Me.hDC, 100, 0, 100, 100, hDC, 0, 0, BMInfo.biWidth, BMInfo.biHeight, vbSrcCopy)
Call StretchBlt(Me.hDC, 100, 100, 100, 100, hDC, 0, 0, BMInfo.biWidth, BMInfo.biHeight, vbSrcCopy)

Call SelectObject(hDC, hOldBMP)
Call DeleteObject(hBMP)

hBMP = LoadImage(App.hInstance, PicPath, IMAGE_BITMAP, 100, 100, LR_LOADFROMFILE)
hOldBMP = SelectObject(hDC, hBMP)
Call BitBlt(Me.hDC, 200, 0, 100, 100, hDC, 0, 0, vbSrcCopy)
Call BitBlt(Me.hDC, 0, 100, 100, 100, hDC, 0, 0, vbSrcInvert)
Call BitBlt(Me.hDC, 100, 100, 100, 100, hDC, 0, 0, vbSrcInvert)
C