[RESOLVED] [VB6] - pointers and bitmaps
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 15 of 21

Thread: [RESOLVED] [VB6] - pointers and bitmaps

Threaded View

  1. #1
    Join Date
    Apr 2009
    Posts
    605

    [RESOLVED] [VB6] - pointers and bitmaps

    i have read several toturials and the autors don't explaint the very important thing
    i understand that the pointers use BRG instead RGB. ok, but how can i compare the colors?
    Code:
    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 Type SAFEARRAYBOUND
        cElements As Long
        lLbound As Long
    End Type
    
    Private Type SAFEARRAY2D
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As Long
        Bounds(0 To 1) As SAFEARRAYBOUND
    End Type
    
    Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
    End Type
    
    Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    
    Private Sub ChangeColor(Picture As StdPicture, OldColor As Long, NewColor As Long)
        Dim pic() As Byte
        Dim sa As SAFEARRAY2D
        Dim bmp As BITMAP
        Dim r As Long, g As Long, b As Long
        Dim r2 As Long, g2 As Long, b2 As Long
       
        Dim X As Long, Y As Long
        
    
        GetObjectAPI Picture, Len(bmp), bmp
    
        With sa
            .cbElements = 1
            .cDims = 2
            .Bounds(0).lLbound = 0
            .Bounds(0).cElements = bmp.bmHeight
            .Bounds(1).lLbound = 0
            .Bounds(1).cElements = bmp.bmWidthBytes
            .pvData = bmp.bmBits
        End With
    
        CopyMemory ByVal VarPtrArray(pic), VarPtr(sa), 4
        
        
        For Y = 0 To UBound(pic, 2)
            For X = 0 To UBound(pic, 1) Step 3
                r = pic(X + 2, Y)
                g = pic(X + 1, Y)
                b = pic(X, Y)
                
                
                If RGB(b, g, r) = OldColor Then
                    
                    r2 = NewColor And 255
                    b2 = (NewColor And &HFF0000) \ 65536
                    g2 = (NewColor And 65535) \ 256
                    pic(X + 2, Y) = b2
                    pic(X + 1, Y) = g2
                    pic(X, Y) = r2
                End If
            Next X
        Next Y
        
        CopyMemory ByVal VarPtrArray(pic), 0&, 4
        
        
    End Sub
    
    Private Sub Command1_Click()
       
        'TransparentAlphaBlend Picture1.Picture, Picture2.Picture, CByte(Text1.Text)
        ChangeColor Picture1.Picture, Picture3.BackColor, Picture4.BackColor
        Picture1.Refresh
    End Sub
    my problem is here:
    Code:
     For Y = 0 To UBound(pic, 2)
            For X = 0 To UBound(pic, 1) Step 3
                r = pic(X + 2, Y)
                g = pic(X + 1, Y)
                b = pic(X, Y)
                
                
                If RGB(b, g, r) = OldColor Then
                    
                    r2 = NewColor And 255
                    b2 = (NewColor And &HFF0000) \ 65536
                    g2 = (NewColor And 65535) \ 256
                    pic(X + 2, Y) = b2
                    pic(X + 1, Y) = g2
                    pic(X, Y) = r2
                End If
            Next X
        Next Y
    because that if isn't used... and i have sure that oldcolor realy exists
    so can anyone advice me?
    (i'm trying these, because i need more speed that DIB's)
    Last edited by Cambalinho; January 3rd, 2013 at 01:27 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Azure Activities Information Page

Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center