Floating Image Code Sample

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal Hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Dim WithEvents objFloatingImage As Bitmap
Dim blnMouseDown As Boolean

'Left and top coordinates of the floating image
Dim lngTop As Long, lngLeft As Long
Dim lngStartX As Long, lngStartY As Long



Private Sub Form_Load()
    Set objFloatingImage = New Bitmap
    lngTop = 50
    lngLeft = 50
    
    blnMouseDown = False
End Sub

Private Sub Form_Resize()
    'Resize BitmapViewer control on form resize
    On Error Resume Next
    BitmapViewer1.Height = Me.ScaleHeight - 48
    BitmapViewer1.Width = Me.ScaleWidth - 16
End Sub


Private Sub CommandLoadBackgroundImage_Click()
    'Load image from file
    If FileDialog1.ShowOpen Then
        On Error Resume Next
        BitmapViewer1.Bitmap.LoadFromFile FileDialog1.FileName
        If Err.Number <> 0 Then
            MsgBox "Error arrised during loading image."
            Exit Sub
        End If
    End If
End Sub

Private Sub CommandLoadFloatingImage_Click()
    'Load image from file
    If FileDialog1.ShowOpen Then
        On Error Resume Next
        objFloatingImage.LoadFromFile FileDialog1.FileName
        If Err.Number <> 0 Then
            MsgBox "Error arrised during loading image."
            Exit Sub
        End If
    End If
End Sub

Private Sub BitmapViewer1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    'Check whether images are loaded. If not, do nothing
    If BitmapViewer1.Bitmap.IsLoaded And objFloatingImage.IsLoaded Then
        blnMouseDown = True
        'Set start coordinate
        lngStartX = x
        lngStartY = y
    End If
End Sub

Private Sub BitmapViewer1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    If blnMouseDown Then
        Dim lngBitmapX As Long, lngBitmapY As Long
        Dim lngBitmapStartX As Long, lngBitmapStartY As Long
        BitmapViewer1.ControlToBitmapCoords x, y, lngBitmapX, lngBitmapY
        BitmapViewer1.ControlToBitmapCoords lngStartX, lngStartY, lngBitmapStartX, lngBitmapStartY
        lngLeft = lngLeft + lngBitmapX - lngBitmapStartX
        lngTop = lngTop + lngBitmapY - lngBitmapStartY
        lngStartX = x
        lngStartY = y
        'FastRefresh method will fire DoubleBufferPaint event. Here we can
        'redraw the floating image
        BitmapViewer1.FastRefresh
    End If
End Sub

Private Sub BitmapViewer1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    If blnMouseDown Then
        blnMouseDown = False
    End If
End Sub

Private Sub BitmapViewer1_DoubleBufferPaint(ByVal Hdc As stdole.OLE_HANDLE)
    'Check whether images are loaded. If not, do nothing
    If BitmapViewer1.Bitmap.IsLoaded And objFloatingImage.IsLoaded Then
    
        'Set clip area
        Dim lngClipTop As Long, lngClipLeft As Long, lngClipRight As Long, lngClipBottom As Long
        BitmapViewer1.BitmapToControlCoords 0, 0, lngClipLeft, lngClipTop
        BitmapViewer1.BitmapToControlCoords BitmapViewer1.Bitmap.Data.Width, BitmapViewer1.Bitmap.Data.Height, lngClipRight, lngClipBottom
    
        Dim hRgn As Long
        hRgn = CreateRectRgn(lngClipLeft, lngClipTop, lngClipRight, lngClipBottom)
    
        SelectClipRgn Hdc, hRgn
        
        Dim lngControlTopLeftX As Long, lngControlTopLeftY As Long
        Dim lngControlBottomRightX As Long, lngControlBottomRightY As Long
        BitmapViewer1.BitmapToControlCoords lngLeft, lngTop, lngControlTopLeftX, lngControlTopLeftY
        BitmapViewer1.BitmapToControlCoords lngLeft + objFloatingImage.Data.Width, _
            lngTop + objFloatingImage.Data.Height, lngControlBottomRightX, lngControlBottomRightY
        
        objFloatingImage.DrawOnHdc Hdc, lngControlTopLeftX, lngControlTopLeftY, _
            lngControlBottomRightX - lngControlTopLeftX, _
            lngControlBottomRightY - lngControlTopLeftY, , , , , CombineModeAlpha
    
        'Free GDI resource
        DeleteObject hRgn
    End If
End Sub

Private Sub objFloatingImage_AfterChange(ByVal changeDescription As String, ByVal changeID As Long)
    BitmapViewer1.Refresh
End Sub