Question

Я начинающий в Access, поэтому мне нужна ваша помощь с этим. Я пытаюсь сделать «диаграмму Ганна» и для этого я создаю некоторые объекты по коду, но когда я это делаю, я не могу получить атрибуты события, см.

    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

Процедура события имеет следующее объявление:

    Private Sub Objeto1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Я думаю, что одним из решений является получение позиции мыши по коду, но у меня нет кода, чтобы сделать это, и, вероятно, этот код принесет абсолютную позицию мыши .

André Ervilha · Answer 1 · 31 марта 2020

после долгих раздумий я придумал решение.

Сначала я должен был создать объекты с помощью функции назначения кода publi c для событий MouseDown, MouseUp и MouveMove.

I объявил публикацию c Vars

drag: Объект получил событие MouseDown
cod_manut: Имя объекта
data_manut : Дата начала обслуживания

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 '

Функция для заполнения формы объектами Gannt:

    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 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

Мне пришлось использовать этот код, чтобы получить абсолютную позицию мыши, но было необходимо выполнить преобразование, чтобы использовать это значение
Примечание. Это значение было в пикселях, мне нужно умножить его на 15, чтобы получить в два раза.

' 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

И, наконец, я создаю объект с аргументами defalt MouseEvent для инкрементального значения X и вычисляю необходимое смещение для использования:

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

Это был последний результат:
Диаграмма Ганта
После того, как я перетаскиваю manut

Примечание: я не могу сделать файл доступным, потому что есть конфиденциальная информация.

Спасибо за все, кто прочитал и, вероятно, подумал о решение, извините за ошибки Engli sh.

Создать события мыши для элементов управления, созданных кодом

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Создать события мыши для элементов управления, созданных кодом

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов