Picturebox : Bad picture quality

the purpose of the paintpicture method ...

Picture1.PaintPicture LoadPicture(myPath), 0, 0, Picture1.Width, Picture1.Height

... is to stretch the image to full size, if the user wants to see the image in full size.

Your suggestion
Picture1.Picture = LoadPicture(myPath)
only allows to see the image in original size - but not in a bigger size
or in full size, unfortunately.

@ JackOfPH :
Thanks for the 2nd Link. The problem can be solved with
the Microsoft ijL15.dll ( ijL = Intel JPEG Library ). -Download here :

http://www.google.com/search?q=ijl15+%22Name+Last+modified+Size
364 kB



= = = = = = = = = = = = = = =
Here is my sample project :
= = = = = = = = = = = = = = =



Needs :
1 Form
1 Module (Module1)
1 Class Module (cls_All)





___________

Form1:
___________

Private Sub Form_Activate()
AutoRedraw = True
myPic = C:\WINDOWS\Desktop\myTest.jpg"
Dim c As New cls_All

E = LoadJPG(c, myPic)
If (E = vbObjectError + 1) Then Exit Sub

Me.Move 0, 0, c.Width * Screen.TwipsPerPixelX, c.Height * Screen.TwipsPerPixelY
c.PaintPicture Form1.hdc

End Sub





___________

Module1:
___________

Option Explicit

Private Enum IJLERR
  IJL_OK = 0
End Enum

Private Enum IJLIOTYPE
  IJL_JFILE_READPARAMS = 0&
  IJL_JFILE_READWHOLEIMAGE = 2&
End Enum

Private Type JPEG_CORE_PROPERTIES_VB
  UseJPEGPROPERTIES As Long
  DIBBytes As Long
  DIBWidth As Long
  DIBHeight As Long
  DIBPadBytes As Long
  DIBChannels As Long
  DIBColor As Long
  DIBSubsampling As Long
  JPGFile As Long
  JPGBytes As Long
  JPGSizeBytes As Long
  JPGWidth As Long
  JPGHeight As Long
  jprops(0 To 19999) As Byte
End Type

Private Declare Function ijlInit Lib "ijl15.dll" (jcprops As Any) As Long
Private Declare Function ijlFree Lib "ijl15.dll" (jcprops As Any) As Long
Private Declare Function ijlRead Lib "ijl15.dll" (jcprops As Any, ByVal ioType As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
       
Public Function LoadJPG(ByRef cDib As cls_All, ByVal sFile As String) As Long
    Dim ret As Variant
    Dim tJ As JPEG_CORE_PROPERTIES_VB
    Dim bFile() As Byte
    Dim lR As Long
    Dim lPtr As Long
    Dim lJPGWidth As Long, lJPGHeight As Long

lR = ijlInit(tJ)

If lR = IJL_OK Then
    bFile = StrConv(sFile, vbFromUnicode)
    ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
    bFile(UBound(bFile)) = 0
    lPtr = VarPtr(bFile(0))
    CopyMemory tJ.JPGFile, lPtr, 4
    lR = ijlRead(tJ, IJL_JFILE_READPARAMS)
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        If lR <> IJL_OK Then
            LoadJPG = vbObjectError + 1 'Can't intialize IJL-Library
        Else
            lJPGWidth = tJ.JPGWidth
            lJPGHeight = tJ.JPGHeight
             If cDib.Create(lJPGWidth, lJPGHeight) Then
              tJ.DIBWidth = lJPGWidth
               tJ.DIBPadBytes = cDib.BytesPerScanLine - lJPGWidth * 3
                tJ.DIBHeight = -lJPGHeight
                 tJ.DIBChannels = 3&
                 tJ.DIBBytes = cDib.DIBSectionBitsPtr
                lR = ijlRead(tJ, IJL_JFILE_READWHOLEIMAGE)
               If lR = IJL_OK Then LoadJPG = 0 Else LoadJPG = vbObjectError + 2
              End If
        End If
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ret = ijlFree(tJ)
    Else
    LoadJPG = vbObjectError + 1 'Can't intialize IJL-Library
End If

End Function





_____________________

Class Module (cls_All) :
_____________________

Option Explicit

Private Type RGBQUAD
 rgbBlue As Byte
 rgbGreen As Byte
 rgbRed As Byte
 rgbReserved As Byte
End Type

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 Type BITMAPINFO
 bmiHeader As BITMAPINFOHEADER
 bmiColors As RGBQUAD
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (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 Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 0 'Farbtabelle in RGB

Private Const CF_BITMAP = 2
Private Const CF_DIB = 8

Private m_hBmpOld As Long
Private m_tBI As BITMAPINFO
Private m_qual As Integer

Public m_hDIb As Long
Public m_hDC As Long
Public m_lPtr As Long

Public Function CreateDIB(ByVal lhDC As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByRef hDib As Long) As Boolean
   
 With m_tBI.bmiHeader
  .biSize = Len(m_tBI.bmiHeader)
  .biWidth = lWidth
  .biHeight = lHeight
  .biPlanes = 1
  .biBitCount = 24
  .biCompression = BI_RGB
  .biSizeImage = BytesPerScanLine * .biHeight
 End With
   
 hDib = CreateDIBSection(lhDC, m_tBI, DIB_RGB_COLORS, m_lPtr, 0, 0)
 CreateDIB = (hDib <> 0)

End Function

Public Function Create(ByVal lWidth As Long, ByVal lHeight As Long) As Boolean
ClearUp
m_hDC = CreateCompatibleDC(0)
   
    If (m_hDC <> 0) Then
        If (CreateDIB(m_hDC, lWidth, lHeight, m_hDIb)) Then
        m_hBmpOld = SelectObject(m_hDC, m_hDIb)
        Create = True
        Else
        DeleteObject m_hDC
        m_hDC = 0
        End If
    End If
End Function

Public Property Get BytesPerScanLine() As Long
    BytesPerScanLine = (m_tBI.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
End Property

Public Property Get Width() As Long
    Width = m_tBI.bmiHeader.biWidth
End Property

Public Property Get Height() As Long
    Height = m_tBI.bmiHeader.biHeight
End Property

Public Sub LoadPictureBlt(ByVal lhDC As Long, Optional ByVal lSrcLeft As Long = 0, Optional ByVal lSrcTop As Long = 0, Optional ByVal lSrcWidth As Long = -1, Optional ByVal lSrcHeight As Long = -1, Optional ByVal eRop As RasterOpConstants = vbSrcCopy)
    If lSrcWidth < 0 Then lSrcWidth = m_tBI.bmiHeader.biWidth
    If lSrcHeight < 0 Then lSrcHeight = m_tBI.bmiHeader.biHeight
    BitBlt m_hDC, 0, 0, lSrcWidth, lSrcHeight, lhDC, lSrcLeft, lSrcTop, eRop
End Sub

Public Sub PaintPicture(ByVal lhDC As Long, Optional ByVal lDestLeft As Long = 0, Optional ByVal lDestTop As Long = 0, Optional ByVal lDestWidth As Long = -1, Optional ByVal lDestHeight As Long = -1, Optional ByVal lSrcLeft As Long = 0, Optional ByVal lSrcTop As Long = 0, Optional ByVal eRop As RasterOpConstants = vbSrcCopy)
    If (lDestWidth < 0) Then lDestWidth = m_tBI.bmiHeader.biWidth
    If (lDestHeight < 0) Then lDestHeight = m_tBI.bmiHeader.biHeight
    BitBlt lhDC, lDestLeft, lDestTop, lDestWidth, lDestHeight, m_hDC, lSrcLeft, lSrcTop, eRop
End Sub

Public Property Get DIBSectionBitsPtr() As Long
    DIBSectionBitsPtr = m_lPtr
End Property

Public Sub ClearUp()
    If (m_hDC <> 0) Then
        If (m_hDIb <> 0) Then
        SelectObject m_hDC, m_hBmpOld
        DeleteObject m_hDIb
        End If
    DeleteObject m_hDC
    End If
    m_hDC = 0: m_hDIb = 0: m_hBmpOld = 0: m_lPtr = 0
End Sub

Private Sub Class_Initialize()
    m_qual = -1
End Sub

Private Sub Class_Terminate()
    ClearUp
End Sub

I am glad I could help.

:)