Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

[VBA] Cursor and Form location

$
0
0

Hi!

I wish that would be a form of moving together with cursor.

But between form and the cursor a long distance, which varies during movement.

On the left side of the screen - the minimum, and the right - very large.

Option Explicit

' MainModule
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
    x As Long
    y As Long
End Type

'Class
Implements IPrimitiveCommandEvents
Dim Points() As Point3d
Dim boolSet As Boolean

Private Sub IPrimitiveCommandEvents_Cleanup()

End Sub

Private Sub IPrimitiveCommandEvents_DataPoint(point As Point3d, ByVal View As View)
    Call LineStringForm.AddVertexToTable(point)
        
    If boolSet = False Then
        Points(0) = point
        ReDim Preserve Points(UBound(Points) + 1)
        CommandState.StartDynamics
        boolSet = True
    Else
        Points(UBound(Points)) = point
        ReDim Preserve Points(UBound(Points) + 1)
    End If
End Sub

Private Sub IPrimitiveCommandEvents_Dynamics(point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
    Dim myPointString As PointStringElement
    Dim oRotation As Matrix3d
    
    Points(UBound(Points)) = point
    oRotation = CommandState.AccuDrawHints.GetRotation(View)

    Set myPointString = CreatePointStringElement1(Nothing, Points, False)
    myPointString.Redraw DrawMode
    
    ' Mouse position and Form position
    Dim a As POINTAPI
    GetCursorPos a
    NowPositionForm.Left = a.x
    NowPositionForm.Top = a.y
    
    ShowStatus "Z = " & FormatNumber(Application.CursorInformation.CurrentPointRaw.Z, 2)
    
    Dim NowZ As Double, LastZ As Double, DeltaZ As Double
    
    NowZ = Application.CursorInformation.CurrentPointRaw.Z
    LastZ = Application.CursorInformation.DataPointRaw.Z
    DeltaZ = NowZ - LastZ
    
    NowPositionForm.NowZLabel.Caption = FormatNumber(NowZ, 2)
    NowPositionForm.LastZLabel.Caption = FormatNumber(LastZ, 2)
    NowPositionForm.DeltaLabel.Caption = FormatNumber(DeltaZ, 2)
    
    If DeltaZ > 0 Then
        NowPositionForm.DeltaLabel.ForeColor = RGB(75, 83, 32)
    ElseIf DeltaZ = 0 Then
        NowPositionForm.DeltaLabel.ForeColor = RGB(0, 0, 255)
    Else
        NowPositionForm.DeltaLabel.ForeColor = RGB(255, 0, 0)
    End If

End Sub

Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)

End Sub

Private Sub IPrimitiveCommandEvents_Reset()
    Unload NowPositionForm
    
    Dim myLine As LineElement
    
    ReDim Preserve Points(UBound(Points) - 1)
    
    Set myLine = CreateLineElement1(Nothing, Points)
    
    ActiveModelReference.AddElement myLine
    
    myLine.Redraw
    
    CommandState.StartDefaultCommand
End Sub

Private Sub IPrimitiveCommandEvents_Start()
    ReDim Points(0)
End Sub


[View:/cfs-file/__key/communityserver-discussions-components-files/343173/2016_2D00_09_2D00_15-at-22_2D00_54_2D00_13.mp4:940:0]


Viewing all articles
Browse latest Browse all 7260


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>