VB PictureBox Quality

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

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

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??

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

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.

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

this is the code i have. and it doesn't display anything in my pictureboxs.

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

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.

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.

think using SetStretchBltMode API would help at all?

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

the result of that is pretty good.

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

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.

i'm just trying to figure out how to incorporate the required code into mine.

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

yeah just trying to figure what i need out of certain class modules, forms, etc.

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)

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.

"... 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.

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?

"...you being "bored", which means that your *work* is not interesting..."
That's the thing.
My language is spanish.

cool12399, can you send me some simplyed code that you have done for resampling, do i have to use class modules??

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...

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

Hope you never need my help again.
Cheers