Create Mouse Events for controls created by code - vba

Question

I am a beguinner in Access so I need your help with this.
I am try making a "Gannt Chart" and to do that I create some objects by code, but when I do that I can't get the atributes of the event, see
Option Compare Database
Function teste()
MsgBox ("Foi")
End Function
Function gannt()
Dim shpBox As Rectangle
DoCmd.OpenForm "Formulário3", acDesign
Set shpBox = Application.CreateControl("Formulário3", acRectangle, acDetail, "", "", 500, 500, 2000, 500)
shpBox.name = "Objeto1"
shpBox.Visible = True
shpBox.onMouseDown = "=teste()"
DoCmd.OpenForm "Formulário3", acNormal
End Function
The procedure of event has this declaration:
Private Sub Objeto1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
I think that one of solution is getting a mouse position by code, but I don't have a code to do this and probabily this code will bring an absolute position of the mouse.

Answer 1

after thinking a lot I came up with a solution.
First I had create the objects by code assigment public functions to events of MouseDown, MouseUp and MouveMove.
I've declared the public Vars
drag: The object received MouseDown Event
cod_manut: Name of the object
data_manut: Date of the start of maintenance
Option Compare Database
Option Explicit
Public drag(500) As Long
Public cod_manut(500) As Integer
Public data_manut(500, 2) As Date
Public valorX As Long '
Public valorY As Long '
Public clickX As Long '
Public clickY As Long '
Public offset As Long '
Function to populate the Form with the Gannt Objects:
Function gant()
Dim shpBox As Rectangle
Dim inicio As Integer
Dim distancia As Integer
Dim i As Integer
Dim d As Date
Dim aux As Integer
Dim entrada As Integer
Dim largura As Integer
Dim tabela As Recordset
Dim sql As String * 2048
sql = "SELECT [Programadas + status].Código, [Programadas + status].Entrada, [Programadas + status].Saida " _
& "FROM [Programadas + status] " _
& "WHERE ((([Programadas + status].Entrada) < #12/31/2020#) And (([Programadas + status].Saida) >= #1/1/2020#) And (([Programadas + status].Local) = 'SOD')) " _
& "ORDER BY [Programadas + status].Entrada, [Programadas + status].Saida;"
Set tabela = CurrentDb.OpenRecordset(sql)
i = 100
While (Not tabela.EOF)
cod_manut(i) = tabela.Fields("Código").value
d = tabela.Fields("Entrada").value
If (d < #1/1/2020#) Then
d = #1/1/2020#
End If
data_manut(i, 0) = d
d = tabela.Fields("Saida").value
If (d > #12/31/2020#) Then
d = #12/31/2020#
End If
data_manut(i, 1) = d
i = i + 1
tabela.MoveNext
Wend
DoCmd.OpenForm "Formulário4", acDesign
inicio = 1350
distancia = 408
'Set shpBox = Forms!Formulário4!Caixa0
For i = 100 To 173
aux = DateDiff("d", #1/1/2020#, data_manut(i, 0))
entrada = (aux \ 7) * 510 + (aux Mod 7) * 72
aux = DateDiff("d", data_manut(i, 0), data_manut(i, 1))
largura = aux * 72
Set shpBox = Application.CreateControl("Formulário4", acRectangle, acDetail, "", "", entrada, inicio + distancia * (i - 100), largura, 300)
shpBox.name = Replace(Str(i), " ", "")
shpBox.BackColor = 13998939
shpBox.BackStyle = 1
shpBox.Visible = True
shpBox.onMouseDown = Replace("=funcA(""" & Str(i) & """)", " ", "")
shpBox.onMouseUp = Replace("=funcB(""" & Str(i) & """)", " ", "")
shpBox.OnMouseMove = Replace("=funcC(""" & Str(i) & """)", " ", "")
Next i
DoCmd.OpenForm "Formulário4", acNormal
End Function
Function Events
Function funcA(id As String)
Dim b As Integer
Dim i As Integer
Dim nome As String
For i = 0 To 200
nome = (Forms!Formulário4.Controls(i).name)
If nome = id Then
Exit For
End If
Next
b = Get_Cursor_Pos()
clickX = ((valorX - offset) * 15) - Forms!Formulário4.Controls(i).Left
'clickY = (valorX - offset) * 15
drag(i) = True
End Function
Function funcB(id As String)
Dim b As Integer
Dim i As Integer
Dim nome As String
b = Get_Cursor_Pos()
For i = 0 To 200
nome = (Forms!Formulário4.Controls(i).name)
If nome = id Then
Exit For
End If
Next
drag(i) = False
End Function
Function funcC(id As String)
Dim aux As Integer
Dim i As Integer
Dim posX As Integer
Dim posX2 As Integer
Dim nome As String
Dim inicio As Integer
Dim fim As Integer
Dim X As Integer
Dim Y As Integer
inicio = 0
fim = 28720 - 1180
aux = Get_Cursor_Pos()
X = (valorX - offset) * 15
Y = (valorX - offset) * 15
For i = 0 To 200
nome = (Forms!Formulário4.Controls(i).name)
If nome = id Then
Exit For
End If
Next
aux = 0
If drag(i) = True Then 'And Button = acLeftButton Then
'If Shift = acShiftMask Then
posX2 = X - clickX
If Abs(posX2 - posX) > 72 Then
posX = ((posX2 - posX) \ 72) * 72 + posX + 3
posX = posX + (posX \ 504) * 6
End If
'Else
' posX = X - clickX
'End If
If posX < inicio Then
posX = inicio
ElseIf (posX + Forms!Formulário4.Controls(i).Width) > fim Then
posX = fim - Forms!Formulário4.Controls(i).Width
End If
Forms!Formulário4.Controls(i).Left = posX
Forms!Formulário4.mouse1.Caption = ((posX \ 510)) * 7 + (posX - ((posX \ 510) * 510) - 3) \ 72
Forms!Formulário4.Mouse2.Caption = (posX \ 510) + 1
End If
End Function
I had to use this code to get the absolute mouse position, but was necessary do the conversion to use this value
Note.: This value was in pixel, I need to multiply to 15 to get it in twips.
' Access the GetCursorPos function in user32.dll
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' Access the GetCursorPos function in user32.dll
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
' GetCursorPos requires a variable declared as a custom data type
' that will hold two integers, one for x value and one for y value
Type POINTAPI
X_Pos As Long
Y_Pos As Long
End Type
' Main routine to dimension variables, retrieve cursor position,
' and display coordinates
Function Get_Cursor_Pos()
' Dimension the variable that will hold the x and y cursor positions
Dim Hold As POINTAPI
' Place the cursor positions in variable Hold
GetCursorPos Hold
' Display the cursor position coordinates
valorX = Hold.X_Pos ' \ 15 ' Transform to twips
valorY = Hold.Y_Pos ' \ 15 ' Transform to twips
End Function
And finally I create an object with the defalt arguments of the MouseEvent to the the incremental value of the X and calculate the necessary offset to use:
Private Sub calibracao_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim aux As Integer
aux = Get_Cursor_Pos()
offset = valorX - (X \ 15) ' To Twips
Forms!Formulário4!mouse1.Caption = X ' Twips
Forms!Formulário4.Mouse2.Caption = (valorX - offset) * 15 ' - offset
End Sub
This was the final result:
Gannt Chart
After I drag the manut
Note: I can not make to the file available, because there are confidentially informations.
Thanks for everone that have read and probabily think about a solution, excuse me for some English mistakes.