Solved

VB PictureBox Quality

Posted on 2003-10-21
28
805 Views
Last Modified: 2010-05-01
I am putting a picture in a PictureBox and stretching it using this code below, and this works great but the quality of the picture isn't as good as i want it to be. i'm using large images, but they look jagged in some places, any help  would be greatly appreciated. thanks, here's the code.


Set objPicture = LoadPicture(File1.Path & "\" & marrFilenames(0))
   
    With Picture1
        xDest = .ScaleLeft
        yDest = .ScaleTop
        cxDest = .ScaleWidth
        cyDest = .ScaleHeight
    End With
   
    With objPicture
        xSrc = 0
        ySrc = 0
        cxSrc = Picture1.ScaleX(.Width, vbHimetric, Picture1.ScaleMode)
        cySrc = Picture1.ScaleY(.Height, vbHimetric, Picture1.ScaleMode)
    End With

Picture1.PaintPicture objPicture, xDest, yDest, cxDest, cyDest, xSrc, ySrc, cxSrc, cySrc, vbSrcCopy
Picture1.Refresh

this is in the PictureBox_Rezize events, and called upon by this

Picture1.Move 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
0
Comment
Question by:jmingo
  • 12
  • 11
  • 5
28 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
take a look at StrechBlt API:

'This project needs:
'- two picture boxes
'- a button
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function PaintDesktop Lib "user32" (ByVal hdc 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 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 GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Const ScrCopy = &HCC0020
Const Yellow = &HFFFF&
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Cnt1 As Byte, Cnt2 As Byte, Point As POINTAPI
    'Set the graphic mode to persistent
    Me.AutoRedraw = True
    'API uses pixels
    Me.ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    'No borders
    Picture1.BorderStyle = 0: Picture2.BorderStyle = 0
    'Set the button's caption
    Command1.Caption = "Paint && Stretch"
    'Set the graphic mode to 'non persistent'
    Picture1.AutoRedraw = False: Picture2.AutoRedraw = False
    For Cnt1 = 0 To 100 Step 3
        For Cnt2 = 0 To 100 Step 3
            'Set the start-point's coördinates
            Point.X = Cnt1: Point.Y = Cnt2
            'Move the active point
            MoveToEx Me.hdc, Cnt1, Cnt2, Point
            'Draw a line from the active point to the given point
            LineTo Me.hdc, 200, 200
        Next Cnt2
    Next Cnt1
    For Cnt1 = 0 To 100 Step 5
        For Cnt2 = 0 To 100 Step 5
            'Draw a pixel
            SetPixel Me.hdc, Cnt1, Cnt2, Yellow
        Next Cnt2
    Next Cnt1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim XX As Long, YY As Long, A As Long
    XX = X: YY = Y
    'Set the picturebox' backcolor
    Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Dim XX As Long, YY As Long, A As Long
        XX = X: YY = Y
        'Set the picturebox' backcolor
        Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
    End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim XX As Long, YY As Long, A As Long
    XX = X: YY = Y
    'Set the picturebox' backcolor
    Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Command1_Click()
    'Set the width and height
    Picture2.Width = 100: Picture2.Height = 100
    Picture1.Width = 50: Picture1.Height = 50
    'No pictures
    Picture1.Picture = LoadPicture("")
    DoEvents
    Copy the desktop to our picturebox
    PaintDesktop Picture1.hdc
    'Stretch the picture
    StretchBlt Picture2.hdc, 0, 0, 100, 100, Picture1.hdc, 0, 0, 50, 50, ScrCopy
End Sub
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
For more advanced options to work with graphics, go to http://www.vbaccelerator.com/home/VB/Code/vbMedia/index.asp
0
 

Author Comment

by:jmingo
Comment Utility
ok i kinda see what this is doing i want the picture box to be the same size as my usercontrol.

so how can i make these functions work simply with what i already have done??
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
"simply" is not a word that could we use here. Sorry.
try not to stick to your old code : and give this a shoot :)
0
 

Author Comment

by:jmingo
Comment Utility
i'm trying with some of your code.

here's what i have so far, and it doesn't do anything.

Private Sub UserControl_Resize()

On Error GoTo ErrLine

'makes it as big as the usercontrol
Picture1.Move 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight

Exit Sub

ErrLine:
Err.Clear
Resume Next

Exit Sub

End Sub

Private Sub Picture1_Resize()

On Error GoTo ErrLine

Picture2.Width = 500: Picture2.Height = 1000
Picture1.Width = UserControl.ScaleWidth: Picture1.Height = UserControl.ScaleHeight

    Picture2.Picture = LoadPicture(File1.Path & "\" & marrFilenames(FileIndex))
    DoEvents
    StretchBlt Picture2.hdc, 0, 0, 100, 100, Picture1.hdc, 0, 0, 50, 50, ScrCopy

Exit Sub

ErrLine:
Err.Clear
Resume Next
Exit Sub

End Sub

any help?? i'll up the points if we can solve this.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
what do you  mean by:
"here's what i have so far, and it doesn't do anything."
0
 

Author Comment

by:jmingo
Comment Utility
this is the code i have. and it doesn't display anything in my pictureboxs.
0
 

Author Comment

by:jmingo
Comment Utility
ok i tried this code but it made it worst if anything..

Dim hMemDC As Long
    Dim hPic As StdPicture
    Dim hPrevPic As Long
    Dim lngSrcWidth As Long
    Dim lngSrcHeight As Long
    Dim lngDestWidth As Long
    Dim lngDestHeight As Long
   
    'Create a compatible memory device context with the Picturebox
    hMemDC = CreateCompatibleDC(Picture1.hdc)
   
    'Load the picture into memory
    Set hPic = LoadPicture(File1.Path & "\" & marrFilenames(FileIndex))
   
    'Select the picture into the memory device context
    hPrevPic = SelectObject(hMemDC, hPic.Handle)
   
    'Get the source width and height of the picture in pixels
    lngSrcWidth = Picture1.ScaleX(hPic.Width, vbHimetric, vbPixels)
    lngSrcHeight = Picture1.ScaleY(hPic.Height, vbHimetric, vbPixels)
   
    'Get the destination width and height (picturebox scalemode is in pixels)
    lngDestWidth = Picture1.ScaleWidth
    lngDestHeight = Picture1.ScaleHeight
   
    'Use the stretchblt function to copy from the memory device context to the picturebox
    StretchBlt Picture1.hdc, 0, 0, lngDestWidth, lngDestHeight, hMemDC, 0, 0, lngSrcWidth, lngSrcHeight, vbSrcCopy
   
    'Delete the memory picture in the memory device context
    DeleteObject SelectObject(hMemDC, hPrevPic)
   
    'Delete the memory device context
    DeleteDC hMemDC
0
 
LVL 10

Expert Comment

by:cool12399
Comment Utility
what you are doing will not work, and you cannot get a 'smooth zoom' without writing
your own code.

Microsoft's built in "stretch" funtionality (whether you do it through stretchblt, or simply
resize (the easy way) through the picturebox control, etc) does 'basic' stretching.

So what you have to do is either purchase a 3rd party control that 'zooms' images (in
essense, "stretching" it dynamically), or write your own code (mathematically that is a
little more sophisticated than writing in a couple sentences) -- to actually 'smoothly' stretch
the image.
0
 

Author Comment

by:jmingo
Comment Utility
ok i see what you're saying, sounds about right. i want to stay away from third party software if i can.

i will up the points if someone has examples of smoothly stretching an image mathmatically.
0
 

Author Comment

by:jmingo
Comment Utility
think using SetStretchBltMode API would help at all?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
i was thinking. Maybe it does not meet your requirements but take a look at my code and perhaphs we could work from it:
http://www.angelfire.com/realm/vb-shared/grower.htm
0
 
LVL 16

Assisted Solution

by:Richie_Simonetti
Richie_Simonetti earned 25 total points
Comment Utility
Uff, at least i understood what is your problem:
Please go to:
http://www.vbaccelerator.com/home/VB/Code/vbMedia/Image_Processing/Image_Processing_Using_DIB_Sections/VB6_Image_Processor.asp
and download the sample project, after that, open an image file and try to resample to 150% (just as an example) and see the result and tell me what you think.
0
 

Author Comment

by:jmingo
Comment Utility
the result of that is pretty good.

are you suggesting resample to the width and height of the usercontrol??

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
I don't know the final usage or where do you want to implement it, i only showing you how to resize the image trying to maintain original quality.
What would you do with the resulting image is up to you and it isoutside the scope of original question i think, isn't it?
Also, we don't need all the code from example, just everything that is used underresample menu.
0
 

Author Comment

by:jmingo
Comment Utility
i'm just trying to figure out how to incorporate the required code into mine.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
"Also, we don't need all the code from example, just everything that is used under 'resample' menu. "

0
 

Author Comment

by:jmingo
Comment Utility
yeah just trying to figure what i need out of certain class modules, forms, etc.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
that's just the case!, Good!
I think you not need forms, only class modules and maybe, some references (Sorry, i haven't vb installed anymore so i couldn't do it for you)
0
 

Author Comment

by:jmingo
Comment Utility
ok, thanks, i'll let you know how it turns out.

thanks again for you're help, hopefully it won't take me long, and it will work and i'll up the points and accept it.
0
 
LVL 10

Accepted Solution

by:
cool12399 earned 25 total points
Comment Utility
>>http://www.angelfire.com/realm/vb-shared/grower.htm
hehe, nice.. btw -- did you mean to say you were "bored" at work, as opposed to being "boring" yourself? hehe :)

>>http://www.vbaccelerator.com/home/VB/Code/vbMedia/Image_Processing/Image_Processing_Using_DIB_Sections/VB6_Image_Processor.asp
ha, cool!
never saw that before... (wish I had known before -- I wrote my own resampler, thats why I knew it was a bit
of work mathematically... interestingly enough it looks like he uses pretty much the same type of algorithm I do...
taking a quick look -- it looks like he is using 'wu pixels'... which is one of the better ways of resampling an image,
while still being pretty fast...)

anyways... yes -- that is the closest you are going to get to 'smooth' resampling without recoding it, purchasing a 3rd party
control, etc...
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
"... btw -- did you mean to say you were "bored" at work, as opposed to being "boring" yourself? hehe :)..."
Sorry for my poor english but i didn't understand you.
0
 
LVL 10

Expert Comment

by:cool12399
Comment Utility
ah, no prob... you said that you were "boring", which means *you/yourself* is not an interesting person,
as opposed to you being "bored", which means that your *work* is not interesting... :)
what is your native language?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
"...you being "bored", which means that your *work* is not interesting..."
That's the thing.
My language is spanish.
0
 

Author Comment

by:jmingo
Comment Utility
cool12399, can you send me some simplyed code that you have done for resampling, do i have to use class modules??
0
 
LVL 10

Expert Comment

by:cool12399
Comment Utility
sorry, i can't send you it because it is proprietary code... however that code
sample you saw will put you on the right track. you don't *have* to use class
modules, but if you don't wish to you'll need to program it...
0
 
LVL 10

Expert Comment

by:cool12399
Comment Utility
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:
Split points between Cool12399 and Richie_Simonetti
Please leave any comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

Cool12399
EE Cleanup Volunteer
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
Hope you never need my help again.
Cheers
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now