-
Jun 18th, 2021, 05:07 PM
#1
Thread Starter
Frenzied Member
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
-
Aug 9th, 2021, 08:26 PM
#2
Fanatic Member
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
-
Aug 10th, 2021, 05:48 AM
#3
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
-
Aug 10th, 2021, 05:55 AM
#4
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|