Results 1 to 4 of 4

Thread: Paint filling/drawing on an Access form?

  1. #1

    Thread Starter
    Frenzied Member wengang's Avatar
    Join Date
    Mar 2000
    Location
    Beijing, China
    Posts
    1,553

    Paint filling/drawing on an Access form?

    Hi all. I'm still working on an Access form app (the only thing I have access to in my office). I'm wondering if anybody has ever drawn on an Access form, either on the form itself or on a control. In particular, I want to point this functionality at a a specific x,y coordinate on image control and do a paint fill with zero tolerance (filling in an area around x,y). For an example, picture an image of a star placed on an Access form. The star is drawn in paint all with a single color. I want to put the cursor somewhere on that star and paint fill it programmatically with whatever color. (It's just an example).

    I know this is easy in VB, but I need (if possible) to do it in Access.

    Has anybody done anything like this? Is it possible?

    Thanks.
    Wen Gang, Programmer
    VB6, QB, HTML, ASP, VBScript, Visual C++, Java

  2. #2
    Fanatic Member
    Join Date
    Feb 2013
    Posts
    985

    Re: Paint filling/drawing on an Access form?

    Windows API can overlay color onto something i guess but how will you find the boundaries of a random image?

    Maybe use MSPaint as a control and make that work

    a simple 'cheat' i would consider is having pre colored images that you load into the control OR using a mask to make the color transparent and having a control behind it that you can change colors on.
    Yes!!!
    Working from home is so much better than working in an office...
    Nothing can beat the combined stress of getting your work done on time whilst
    1. one toddler keeps pressing your AVR's power button
    2. one baby keeps crying for milk
    3. one child keeps running in and out of the house screaming and shouting
    4. one wife keeps nagging you to stop playing on the pc and do some real work.. house chores
    5. working at 1 O'clock in the morning because nobody is awake at that time
    6. being grossly underpaid for all your hard work


  3. #3
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,723

    Re: Paint filling/drawing on an Access form?

    I'll assume your MS Access Form contains a picture of "a star" that you assigned to its Picture property at design time.

    This VB6 code should be readily altered for Access VBA. Mostly Long types that need changing to the pointer type that was added in later versions of VBA. For the most part that'll be in Declare Function statements.

    As far as I can recall GDI handles are still Long in VBA.

    Looking it over, there may not be anything requiring changes for VBA.

    Code:
    Option Explicit
    
    Private Const WIN32_TRUE As Long = 1
    
    Private Declare Function BitBlt Lib "gdi32" ( _
        ByVal hDCDest As Long, _
        ByVal XDest As Long, _
        ByVal YDest As Long, _
        ByVal nWidth As Long, _
        ByVal nHeight As Long, _
        ByVal hdcSrc As Long, _
        ByVal XSrc As Long, _
        ByVal YSrc As Long, _
        Optional ByVal dwRop As RasterOpConstants = vbSrcCopy) As Long
    
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal Width As Long, _
        ByVal Height As Long) As Long
    
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
    
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
    
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    
    Private Enum FloodFillTypes
        FLOODFILLBORDER = 0
        FLOODFILLSURFACE = 1
    End Enum
    
    Private Declare Function ExtFloodFill Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal crColor As Long, _
        ByVal wFillType As FloodFillTypes) As Long
    
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    
    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 GetObject Lib "gdi32" Alias "GetObjectW" ( _
        ByVal hObject As Long, _
        ByVal nCount As Long, _
        ByRef Obj As Any) As Long
    
    Private Declare Function GetPixel Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal X As Long, _
        ByVal Y As Long) As Long
    
    Private Enum HRESULT
        S_OK = 0
    End Enum
    
    Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
    
    Private Declare Function IIDFromString Lib "Ole32" ( _
        ByVal lpszIID As Long, _
        ByRef GUID As GUID) As HRESULT
    
    Private Type PICTDESC_BITMAP
        cbSizeOfStruct As Long
        picType As PictureTypeConstants
        hBM As Long
        hpal As Long
    End Type
    
    Private Declare Function OleCreatePictureIndirect Lib "Oleaut32" ( _
        ByRef PICTDESC_BITMAP As PICTDESC_BITMAP, _
        ByRef GUID As GUID, _
        ByVal fOwn As Long, _
        ByRef pvObj As Object) As HRESULT
    
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    
    Private Declare Function SelectObject Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal hObject As Long) As Long
    
    Private Colors As Variant
    Private NextColor As Long
    
    Private Sub FillPicture( _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal Color As Long)
        'Note: X, Y are in pixels.
        Dim hDCForm As Long
        Dim hDCMem As Long
        Dim BITMAP As BITMAP
        Dim hBM As Long
        Dim hBMOrig As Long
        Dim hBROrig As Long
        Dim IID_IPicture As GUID
        Dim PICTDESC_BITMAP As PICTDESC_BITMAP
        Dim NewPicture As IPicture
    
        If Picture.Type <> vbPicTypeBitmap Then Err.Raise 5
    
        hDCForm = GetDC(Me.hWnd) 'VB6 can just use Me.hDC for this.
        hDCMem = CreateCompatibleDC(hDCForm)
        GetObject Picture.Handle, LenB(BITMAP), BITMAP
        With BITMAP
            hBM = CreateCompatibleBitmap(hDCForm, .bmWidth, .bmHeight)
            hBMOrig = SelectObject(hDCMem, hBM)
            BitBlt hDCMem, 0, 0, .bmWidth, .bmHeight, hDCForm, 0, 0
        End With
        hBROrig = SelectObject(hDCMem, CreateSolidBrush(Color))
        ExtFloodFill hDCMem, X, Y, GetPixel(hDCMem, X, Y), FLOODFILLSURFACE
        DeleteObject SelectObject(hDCMem, hBROrig)
        SelectObject hDCMem, hBMOrig
        DeleteDC hDCMem
        ReleaseDC Me.hWnd, hDCForm
        With PICTDESC_BITMAP
            .cbSizeOfStruct = LenB(PICTDESC_BITMAP)
            .picType = vbPicTypeBitmap
            .hBM = hBM
        End With
        IIDFromString StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture
        If OleCreatePictureIndirect(PICTDESC_BITMAP, _
                                    IID_IPicture, _
                                    WIN32_TRUE, _
                                    NewPicture) = S_OK Then
            Set Picture = NewPicture
        Else
            DeleteObject hBM
        End If
    End Sub
    
    Private Sub Command1_Click()
        Dim BITMAP As BITMAP
    
        'We'll fill from the center, so get the dimensions of Picture:
        GetObject Picture.Handle, LenB(BITMAP), BITMAP
        With BITMAP
            FillPicture .bmWidth \ 2, .bmHeight \ 2, Colors(NextColor)
        End With
        NextColor = (NextColor + 1) Mod 8
    End Sub
    
    Private Sub Form_Load()
        Colors = Array(vbBlue, vbRed, vbYellow, vbMagenta, vbCyan, vbBlack, vbWhite, vbGreen)
    End Sub
    Basically FillPicture() takes the Form's Picture property and a flood point and a new color.

    Then it copies the Picture's bitmap into a new bitmap, floodfills out from the color of the provided (X, Y) point pixel, then returns the new bitmap wrapped as a new IPicture/StdPicture object.
    Last edited by dilettante; Aug 10th, 2021 at 06:30 PM. Reason: modified code, removed unintended implied generality

  4. #4
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,723

    Re: Paint filling/drawing on an Access form?

    Sorry, but note:

    The assumption is that your "star" has an interior that was painted all the exact same color. The fill only changes the color of pixels adjacent to and flooding out from the provided (X, Y) pixel with the exact same color.

    The code is easily altered to fill outward to a bordering color you provide by changing to use of the FLOODFILLBORDER option. You'll have to add a parameter for this border color, since the (X, Y) pixel's color no longer matters.
    Last edited by dilettante; Aug 10th, 2021 at 06:32 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
  •  



Click Here to Expand Forum to Full Width