• Home
 · 
• Miscellaneous
 · 
• Code shows how to use BitBlt and an offscreen Device Context to scroll a Picture in a PictureBox. T

Code shows how to use BitBlt and an offscreen Device Context to scroll a Picture in a PictureBox. T

Code shows how to use BitBlt and an offscreen Device Context to scroll a Picture in a PictureBox. This is pretty much the complete source for

API Declarations


'ALL IN A FORM, ALSO HAVE TO ADD THE FOLLOWING CONTROLS AND NAME THEM PROPERLY _
IN ORDER FOR APP TO PERFORM CORRECTLY _
Add a CommandButton and name it cmdBrowse _
Add a PictureBox and name it Picture1 _
Add a HScrollBar and name it HScroll1 _
Add a VScrollBar and name it VScroll1 _
Add a CommonDialog and name it CommonDialog1 (under _
Project/Components/Microsoft Common Dialog Control)
'*********************************************

Option Explicit

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 CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Const SRCCOPY = &HCC0020

Private lngDC As Long
Private lngOrigBMP As Long





Rate Code shows how to use BitBlt and an offscreen Device Context to scroll a Picture in a PictureBox. T

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

 Dim iPic As IPictureDisp
 Dim lPrevBMP As Long
 Dim iPicWPix As Integer, iPicHPix As Integer
 Dim iPicBoxWPix As Integer, iPicBoxHPix As Integer
    
    'setup common dialog to show only Image files
    CommonDialog1.Filter = "Image Files (*.bmp;*.jpg;*.jpeg;*.gif)|*.BMP;*.JPG;*.JPEG;*.GIF"
    
    CommonDialog1.ShowOpen
    
    If Not CommonDialog1.filename = "" Then
        
        'Load the picture to be displayed
        Set iPic = LoadPicture(CommonDialog1.filename)
 
        'retrieve the pixel coordinates of the Picture to be displayed
        iPicWPix = Int(Me.ScaleX(iPic.Width, vbHimetric, vbPixels))
        iPicHPix = Int(Me.ScaleY(iPic.Height, vbHimetric, vbPixels))
 
        'retrieve the pixel coordinates of the PictureBox where the Picture will be displayed
        iPicBoxWPix = Int(Me.ScaleX(Picture1.Width, vbTwips, vbPixels))
        iPicBoxHPix = Int(Me.ScaleY(Picture1.Height, vbTwips, vbPixels))
  
        If iPicWPix > iPicBoxWPix Then 'if the picture is larger than the picturebox
    
            HScroll1.Enabled = True
    
            HScroll1.Min = 0
            'set the max value of the hscroll bar to the difference between the picture's width and the picturebox's width
            HScroll1.Max = iPicWPix - iPicBoxWPix

        Else
    
            HScroll1.Enabled = False
    
        End If
    
        If iPicHPix > iPicBoxHPix Then
    
            VScroll1.Enabled = True
     
            VScroll1.Min = 0
    
            'set the max value of the vscroll bar to the difference between the picture's height and the picturebox's height
            VScroll1.Max = Int(Me.ScaleY(iPic.Height, vbHimetric, vbPixels)) - Int(Me.ScaleY(Picture1.Height, vbTwips, vbPixels))
 
        Else
 
            VScroll1.Enabled = False
    
        End If
 
        ' select our picture into the Device Context and retrieve the handle _
          of the last bitmap selected into the Device Context
        lPrevBMP = SelectObject(lngDC, iPic)
        
        Set iPic = Nothing
        
        'remove the previous bitmap from memory
        DeleteObject lPrevBMP
 
        ' display the picture in the picture box
        BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
        
        ' show the picture
        Picture1.Refresh
        
 End If
    
End Sub

Private Sub Form_Load()
Dim lBMP As Long

 ' assure's the picture will not be erased when picturebox is repainted
 Picture1.AutoRedraw = True
 
 VScroll1.Enabled = False
 HScroll1.Enabled = False

 ' get a Device Context to be used for BLTing
 lngDC = CreateCompatibleDC(Me.hdc)
 
 ' create a generic bitmap so we can retrieve the handle of the original bitmap created _
    with the Device Context (we need the handle later to assure that all objects are removed from memory
 lBMP = CreateCompatibleBitmap(lngDC, 1, 1)
 
 'retrieve the handle of the bitmap orignally created with the Device Context
 lngOrigBMP = SelectObject(lngDC, lBMP)
 
 
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    'free memory used
    CleanUp
    
End Sub

Private Sub HScroll1_Change()
    
    'display the picture based on the scroll bar value
    BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
    
    ' show the picture
    Picture1.Refresh
    
End Sub

Private Sub HScroll1_Scroll()
    
    'display the picture based on the scroll bar value
    BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
    
    ' show the picture
    Picture1.Refresh
    
End Sub

Private Sub VScroll1_Change()
    
    'display the picture based on the scroll bar value
    BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
    
    ' show the picture
    Picture1.Refresh
    
End Sub

Private Sub VScroll1_Scroll()
    
    'display the picture based on the scroll bar value
    BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
    
    'show the picture
    Picture1.Refresh
    
End Sub

Private Sub CleanUp()
 Dim lPrevBMP As Long
 
 'put the original bitmap back into the Device and retrieve the handle of the previous bitmap
 lPrevBMP = SelectObject(lngDC, lngOrigBMP)
 
 'remove the previous bitmap from memory
 DeleteObject lPrevBMP
 
 'free the DC (and all objects created with it) from memory
 DeleteDC lngDC

End Sub