From: Mike Williams on 30 Aug 2006 19:32 "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 30 Aug 2006 19:32 > 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 30 Aug 2006 22:24 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 30 Aug 2006 22:35 > > 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 31 Aug 2006 09:15
> 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 |