Picture Control (VBCCRPicture)

VBCCRPicture control is an image display control used to display pictures in various formats. It provides more features and better display effects than the standard PictureBox.

Properties

Key Properties

• Picture: The displayed image
• AutoSize: Whether to automatically adjust size based on the image
• BorderStyle: Border style
• ScaleMode: Scale mode
• Stretch: Whether to stretch the image
• AutoRedraw: Whether to automatically redraw
• BackColor: Background color
• Enabled: Enable/disable the control
• MaskColor: Transparent color
• UseMaskColor: Whether to use transparent color

Methods

Main Methods

• LoadPicture(FileName As String): Load image
• SavePicture(FileName As String): Save image
• Cls(): Clear image
• PaintPicture(): Draw image
• Point(X As Single, Y As Single): Get color at specified point
• Refresh(): Refresh display
• Scale(width As Single, height As Single): Set scaling

Events

• Click(): Triggered when clicked
• DblClick(): Triggered when double-clicked
• MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
• MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
• MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
• Paint(): Triggered when repainting

Code Examples

Basic Usage

Private Sub Form_Load()
    With Picture1
        .AutoSize = True
        .BorderStyle = vbFixedSingle
        .ScaleMode = vbPixels
        Set .Picture = LoadPicture("image.jpg")
    End With
End Sub

Image Scaling

Private Sub ScalePicture(ByVal NewWidth As Long, ByVal NewHeight As Long)
    With Picture1
        .Stretch = True
        .Width = NewWidth
        .Height = NewHeight
        .Refresh
    End With
End Sub

Transparent Background Handling

Private Sub SetTransparency()
    With Picture1
        .UseMaskColor = True
        .MaskColor = RGB(255, 0, 255) ' Pink as transparent color
        Set .Picture = LoadPicture("transparent.gif")
    End With
End Sub

Common Use Cases

Image Viewer

Private Sub CreateImageViewer()
    ' Set up image viewer
    With Picture1
        .AutoSize = False
        .Stretch = True
        .BorderStyle = vbFixedSingle
        .ScaleMode = vbPixels
    End With
End Sub

Private Sub LoadImage(ByVal FilePath As String)
    On Error GoTo ErrorHandler
    
    With Picture1
        .Cls
        Set .Picture = LoadPicture(FilePath)
        
        ' Adjust size to fit window
        If .Picture.Width > Me.ScaleWidth Or .Picture.Height > Me.ScaleHeight Then
            FitToWindow
        End If
    End With
    Exit Sub
    
ErrorHandler:
    MsgBox "Cannot load image: " & Err.Description
End Sub

Private Sub FitToWindow()
    Dim ratio As Double
    Dim newWidth As Long, newHeight As Long
    
    With Picture1.Picture
        ratio = .Width / .Height
        
        If ratio > 1 Then
            newWidth = Me.ScaleWidth - 20
            newHeight = newWidth / ratio
        Else
            newHeight = Me.ScaleHeight - 20
            newWidth = newHeight * ratio
        End If
    End With
    
    Picture1.Width = newWidth
    Picture1.Height = newHeight
End Sub

Image Editor

Private Sub CreateImageEditor()
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .DrawWidth = 1
        .ForeColor = vbBlack
    End With
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    LastX = X
    LastY = Y
    IsDrawing = True
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If IsDrawing Then
        Picture1.Line (LastX, LastY)-(X, Y)
        LastX = X
        LastY = Y
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    IsDrawing = False
End Sub

Best Practices

1. Picture Loading

Private Function SafeLoadPicture(ByVal FilePath As String) As Boolean
    On Error GoTo ErrorHandler
    
    With Picture1
        .Cls
        Set .Picture = LoadPicture(FilePath)
    End With
    
    SafeLoadPicture = True
    Exit Function
    
ErrorHandler:
    Debug.Print "Picture loading error: " & Err.Description
    SafeLoadPicture = False
End Function

2. Memory Management

Private Sub ClearPictureMemory()
    Set Picture1.Picture = Nothing
    Picture1.Cls
    DoEvents
End Sub

3. Performance Optimization

Private Sub OptimizeDrawing()
    Picture1.AutoRedraw = False
    
    ' Perform drawing operations
    DrawGraphics
    
    Picture1.AutoRedraw = True
    Picture1.Refresh
End Sub

Known Issues and Solutions

1. Large Image Handling

Private Sub HandleLargeImage(ByVal FilePath As String)
    Screen.MousePointer = vbHourglass
    
    Picture1.Visible = False
    Set Picture1.Picture = LoadPicture(FilePath)
    
    ' Adjust size
    ScaleToFit
    
    Picture1.Visible = True
    Screen.MousePointer = vbDefault
End Sub

2. Flickering Issues

Private Sub PreventFlicker()
    ' Use double buffering
    Dim TempPic As StdPicture
    Set TempPic = Picture1.Picture
    
    Picture1.Visible = False
    ' Perform drawing operations
    Picture1.Visible = True
End Sub

Additional Tips

• Monitor memory usage
• Implement image caching
• Handle large files
• Provide progress feedback
• Support multiple formats
• Implement error recovery
• Optimize display performance
• Handle transparency
• Support drag and drop operations
• Clean up resources in Form_Unload

Special Uses

1. Creating Thumbnails

Private Function CreateThumbnail(ByVal SourceFile As String, _
                               ByVal MaxSize As Long) As StdPicture
    Dim ratio As Double
    Dim newWidth As Long, newHeight As Long
    
    With Picture1
        ' Load original image
        Set .Picture = LoadPicture(SourceFile)
        
        ' Calculate thumbnail size
        If .Picture.Width > .Picture.Height Then
            ratio = MaxSize / .Picture.Width
        Else
            ratio = MaxSize / .Picture.Height
        End If
        
        newWidth = .Picture.Width * ratio
        newHeight = .Picture.Height * ratio
        
        ' Create thumbnail
        .Width = newWidth
        .Height = newHeight
        .Stretch = True
        .AutoRedraw = True
        
        Set CreateThumbnail = .Image
    End With
End Function

2. Creating Image Effects

Private Sub ApplyGrayscaleEffect()
    Dim X As Long, Y As Long
    Dim pixelColor As Long
    Dim grayValue As Integer
    
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        
        For X = 0 To .ScaleWidth
            For Y = 0 To .ScaleHeight
                pixelColor = .Point(X, Y)
                grayValue = (CLng(pixelColor And &HFF) + _
                           CLng((pixelColor And &HFF00&) \ &H100&) + _
                           CLng((pixelColor And &HFF0000) \ &H10000)) \ 3
                .PSet (X, Y), RGB(grayValue, grayValue, grayValue)
            Next Y
        Next X
        
        .Refresh
    End With
End Sub

3. Creating Image Slideshow

Private Sub CreateSlideshow()
    With Picture1
        .Stretch = True
        .BorderStyle = vbNone
        .AutoSize = False
    End With
    
    ' Set up timer
    Timer1.Interval = 3000 ' 3 seconds
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Static CurrentImage As Integer
    
    ' Load next image
    LoadNextImage CurrentImage
    CurrentImage = (CurrentImage + 1) Mod ImageCount
End Sub