Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 862
  • Last Modified:

VB PictureBox Quality

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
jmingo
Asked:
jmingo
  • 12
  • 11
  • 5
2 Solutions
 
Richie_SimonettiIT OperationsCommented:
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
 
Richie_SimonettiIT OperationsCommented:
For more advanced options to work with graphics, go to http://www.vbaccelerator.com/home/VB/Code/vbMedia/index.asp
0
 
jmingoAuthor Commented:
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Richie_SimonettiIT OperationsCommented:
"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
 
jmingoAuthor Commented:
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
 
Richie_SimonettiIT OperationsCommented:
what do you  mean by:
"here's what i have so far, and it doesn't do anything."
0
 
jmingoAuthor Commented:
this is the code i have. and it doesn't display anything in my pictureboxs.
0
 
jmingoAuthor Commented:
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
 
cool12399Commented:
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
 
jmingoAuthor Commented:
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
 
jmingoAuthor Commented:
think using SetStretchBltMode API would help at all?
0
 
Richie_SimonettiIT OperationsCommented:
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
 
Richie_SimonettiIT OperationsCommented:
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
 
jmingoAuthor Commented:
the result of that is pretty good.

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

0
 
Richie_SimonettiIT OperationsCommented:
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
 
jmingoAuthor Commented:
i'm just trying to figure out how to incorporate the required code into mine.
0
 
Richie_SimonettiIT OperationsCommented:
"Also, we don't need all the code from example, just everything that is used under 'resample' menu. "

0
 
jmingoAuthor Commented:
yeah just trying to figure what i need out of certain class modules, forms, etc.
0
 
Richie_SimonettiIT OperationsCommented:
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
 
jmingoAuthor Commented:
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
 
cool12399Commented:
>>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
 
Richie_SimonettiIT OperationsCommented:
"... 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
 
cool12399Commented:
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
 
Richie_SimonettiIT OperationsCommented:
"...you being "bored", which means that your *work* is not interesting..."
That's the thing.
My language is spanish.
0
 
jmingoAuthor Commented:
cool12399, can you send me some simplyed code that you have done for resampling, do i have to use class modules??
0
 
cool12399Commented:
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
 
cool12399Commented:
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
 
Richie_SimonettiIT OperationsCommented:
Hope you never need my help again.
Cheers
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 12
  • 11
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now