"Rendering" images on resize 5

[Anesthaesia]

Hi,

I'm not sure if render is the right word, but I would like to know if there's a way to render/smooth a picture when the image/picture box it's displayed in is smaller than the source.

An example would be the way a dedicated picture browser displays images - using VB controls results in poor resolution when a large image is made smaller.

Any ideas ?

 

[strongm]

VB doesn't give you this level of control, unfortunately. However the API does. This demonstrates the idea. You'll need a form with a picturebox and a command button. The picturebox should be loaded with your source image. Note that, in realit, an appropriate choice of stretchmodeis necessary for different types of image. For example a source image with dark text or simple vector graphics on a light background in it is probably best to stretch with BLACKONWHITE, whilst a digitised photo is probably best stretched with COLORONCOLOR or HALFTONE

[tt]
Option Explicit

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 Enum StretchMode
BLACKONWHITE = 1
WHITEONBLACK = 2
COLORONCOLOR = 3
HALFTONE = 4
End Enum

Private Sub Command1_Click()
Dim Stretch As StretchMode


For Stretch = BLACKONWHITE To HALFTONE
SetStretchBltMode Form1.hdc, Stretch
StretchBlt Form1.hdc, 0, (Stretch - 1) * 150, 100, 100, Picture1.hdc, 0, 0, 200, 200, vbSrcCopy
Next
End Sub

Private Sub Form_Load()

Form1.AutoRedraw = False ' ensure this, as autoredraw true resets stretchmode

' Rough and ready resizing just for the sake of this example
Picture1.Left = 100 * Screen.TwipsPerPixelX
Picture1.Width = 200 * Screen.TwipsPerPixelX
Picture1.Height = 200 * Screen.TwipsPerPixelY

Form1.Height = 650 * Screen.TwipsPerPixelY
Form1.Width = 110 * Screen.TwipsPerPixelX + Picture1.Width

End Sub

 

[ADoozer]

strongm strikes again... another sweet bit of code!! (although WHITEONBLACK seems to destroy all pictures)

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Try an image that is mostly black with a little bit of white in it...

 

[Anesthaesia]

Thanks strongm,

I'll give it a try.

Cheers

 

[Anesthaesia]

I'm having a problem sizing the stretched image.

The result is what I'm looking for, but I find I end up with some of the captured screen in the resulting image.

Also, HALFTONE seems to work the best.

if I have a picture box of 5000x3000 twips, which is filled with an image, how could I get that to display in a 2500x1500twip box ?

 

[Anesthaesia]

Sorry...

I see now what it's doing.

How could I put the resized image into a picture box, instead of onto the form. I find I get a different result when I try - the colours are corrupt.

 

[ADoozer]

change:-

SetStretchBltMode Form1.hdc, Stretch
StretchBlt Form1.hdc, 0, (Stretch - 1) * 150, 100, 100, Picture1.hdc, 0, 0, 200, 200, vbSrcCopy

to this:

SetStretchBltMode Picture2.hdc, Stretch
StretchBlt Picture2.hdc, 0, (Stretch - 1) * 150, 100, 100, Picture1.hdc, 0, 0, 200, 200, vbSrcCopy

where picture2 is your new picture box!

(just in case strongms not online at the mo, its 11.30PM in the UK)

good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Sorry, I don't get that problem here. I get the same images whether I blit to the form's hDC or a picture boxes hDC

 

[Anesthaesia]

It's late...it's time for bed...

Sorry - I forgot to change the picture2's "SetStretchBltMode"

Works like a charm.

Thanks strongm ( and ADoozer ) !!

 

[strongm]

Yep, 23:39 now, and I'm just getting into my stride...

 

[Anesthaesia]

One last thing -

Is there any way to copy the resized image and store it, then paste it when you want to ?

I want the source to appear on a different form, but if I display the source form, copy the image, then hide the source form, and paste the resized image, the target is empty, because the top form clears the picture when it closes (as it's not a true picture)

 

[ADoozer]

yes, but im sure strongm could explain it a lot better than i can!!

but you can set the source and destination

instead of

SetStretchBltMode Picture2.hdc, Stretch
StretchBlt Picture2.hdc, 0, (Stretch - 1) * 150, 100, 100, Picture1.hdc, 0, 0, 200, 200, vbSrcCopy

use something like

SetStretchBltMode form2.Picture1.hdc, Stretch
StretchBlt form2.Picture1.hdc, 0, (Stretch - 1) * 150, 100, 100, Picture1.hdc, 0, 0, 200, 200, vbSrcCopy

or do you mean that when a form goes over the picture, the picture doesnt redraw??? (in which case i believe adding a form2.picture1.refresh will solve this)

hope that helps!
good luck!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

You sure you want the solution to this...

 

[ADoozer]

i wouldnt mind seeing it...

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Ok, you asked for it...you'll need a form with a single picturebox and a command button:
[tt]
Option Explicit

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 Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long


Private Type POINTAPI
x As Long
y As Long
End Type

Private Enum StretchMode
BLACKONWHITE = 1
WHITEONBLACK = 2
COLORONCOLOR = 3
HALFTONE = 4
End Enum

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type PicBmp
Size As Long
Type As Long
hBMP As Long
hPal As Long
Reserved As Long
End Type

Private Const MetricToTwips = 1.77271

Private Sub Command1_Click()
' Example uses LoadPicture as source of image, and places the returned, suitably sized result into Picture1
' The Picture property of another Picturebox would be an equally suitable source
Picture1.Picture = ScaleIt(COLORONCOLOR, LoadPicture("c:\tinyhorde.jpg&quot, 0.5) ' You'll need to change the filename in LoadPicture to your own source file
End Sub

' Given a StdPicture, return a new StdPicture scaled in size by ResizeScale
' Pure API version. Uses no VB controls at all
Private Function ScaleIt(Stretch As StretchMode, srcPicture As StdPicture, ResizeScale As Single) As StdPicture

Dim hBMP As Long
Dim srcBMP As Long
Dim srcDC As Long
Dim memDC As Long
Dim hOriginalDestBMP As Long
Dim hOriginalSrcBMP As Long
' Dim oldMapMode As Long
' Dim ConvertPoint(0) As POINTAPI
Dim ScaleFactor As Double

ScaleFactor = MetricToTwips * Screen.TwipsPerPixelX ' Need this because our DCs will be in himetric, but stretchblt works in pixels

' Create a memory DCs
memDC = CreateCompatibleDC(GetDC(0)) ' screen compatible
srcDC = CreateCompatibleDC(GetDC(0)) 'screen compatible
hBMP = CreateCompatibleBitmap(GetDC(0), srcPicture.Width * ResizeScale / ScaleFactor, srcPicture.Height * ResizeScale / ScaleFactor) ' Make sure we work in right scale units

' Select a (currently blank) bitmap compatible with our source into destination memory device context
hOriginalDestBMP = SelectObject(memDC, hBMP)
' Select bitmap from source OLEPicture into what will be our source DC
hOriginalSrcBMP = SelectObject(srcDC, srcPicture.Handle)

' Do our stretchblt into the memory DC, and thus into our compatible bitmap, from our source DC
SetStretchBltMode memDC, Stretch
StretchBlt memDC, 0, 0, srcPicture.Width * ResizeScale / ScaleFactor, srcPicture.Height * ResizeScale / ScaleFactor, srcDC, 0, 0, srcPicture.Width / ScaleFactor, srcPicture.Height / ScaleFactor, vbSrcCopy

' Select back in the original bitmap, and return handle to current bitmap (which now contains our blitted image)
hBMP = SelectObject(memDC, hOriginalDestBMP)

' Clean up memory DCs
DeleteDC memDC
DeleteDC srcDC

Set ScaleIt = BitmapToPicture(hBMP) ' convert bitmap referenced by hBMP into an OLEPicture (StdPicture)
End Function


Private Function BitmapToPicture(ByVal hBMP As Long) As StdPicture
Dim oNewPic As Picture
Dim tPicConv As PicBmp
Dim IGuid As GUID

With tPicConv
.Size = Len(tPicConv)
.Type = vbPicTypeBitmap
.hBMP = hBMP
End With

With IGuid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
Set BitmapToPicture = oNewPic
End Function

 

[Hypetia]

strongm, a

for you for an excellent demostration of SetStretchBltMode API.

 

[ADoozer]

strongm: damb that was simpler than i was expecting (Dan Appleman makes it sound reeeaaaalllyyy dificult)

I want to award a star but this forum has gone star crazy the last few days......... o go on then heres a star .

A damn good code example again!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org

 

[strongm]

Dan has products to sell...

 

[ADoozer]

hmmm... yeah, i never looked at it that way!!

in that case im looking forward to chapter 14 "Processes and Threads", should be a doddle

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @

http://www.wotsit.org