pattern.frm

电动平台, 控制X,Y,Z轴移动,能计数

VERSION 5.00
Begin VB.Form FrmPattern 
   Caption         =   "Snake Pattern"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7485
   ClipControls    =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5880
   ScaleWidth      =   7485
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   6840
      Top             =   5280
   End
   Begin VB.CommandButton BtnNext 
      Caption         =   "Next"
      Height          =   495
      Left            =   3840
      TabIndex        =   3
      Top             =   5280
      Width           =   1215
   End
   Begin VB.CommandButton PatternStop 
      Caption         =   "Stop"
      Height          =   495
      Left            =   2160
      TabIndex        =   2
      Top             =   5280
      Width           =   1215
   End
   Begin VB.CommandButton PatternStart 
      Caption         =   "Start"
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   5280
      Width           =   1215
   End
   Begin VB.PictureBox PatternPicture 
      AutoSize        =   -1  'True
      FillColor       =   &H0080FF80&
      FillStyle       =   0  'Solid
      ForeColor       =   &H0080FF80&
      Height          =   5055
      Left            =   240
      ScaleHeight     =   249.75
      ScaleMode       =   2  'Point
      ScaleWidth      =   351.75
      TabIndex        =   0
      Top             =   120
      Width           =   7095
   End
   Begin VB.Label LabelTime 
      Caption         =   "Label1"
      Height          =   375
      Left            =   5280
      TabIndex        =   4
      Top             =   5400
      Width           =   1215
   End
End
Attribute VB_Name = "FrmPattern"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nXSize As Double
Dim nYSize As Double
Dim nXSteps As Long
Dim nYSteps As Long
Dim nStep As Long
Dim XStartPos As Double
Dim YStartPos As Double
Private Declare Function timeGetTime& Lib "WINMM.DLL" ()

Public Sub DoPattern(Xpos As Double, Ypos As Double)
    Dim XSize As Double, YSize As Double, XSteps As Long, YSteps As Long
    Dim Xscale As Single, Yscale As Single
    Dim temp As Variant
    
    LabelTime.Visible = False
    
    XStartPos = Xpos
    YStartPos = Ypos
    
    XSize = GetSetting(App.Title, "Pattern", "xSize", 800)
    YSize = GetSetting(App.Title, "Pattern", "ySize", 600)
    XSteps = GetSetting(App.Title, "Pattern", "xSteps", 5)
    YSteps = GetSetting(App.Title, "Pattern", "ySteps", 5)
    
    Do
        temp = InputBox("Enter the step size for the X Axis", "X Size", XSize)
        If IsNumeric(temp) <> True Then Exit Sub
        XSize = CDbl(temp)
    Loop Until XSize > 10
    Do
        temp = InputBox("Enter the step size for the Y Axis", "Y Size", YSize)
        If IsNumeric(temp) <> True Then Exit Sub
        YSize = temp
    Loop Until YSize > 10
    
    Do
        temp = InputBox("Enter the Number of Steps for the X Axis", "X Steps", XSteps)
        If IsNumeric(temp) <> True Then Exit Sub
        XSteps = temp
    Loop Until XSteps > 0
    Do
        temp = InputBox("Enter the Number of Steps for the Y Axis", "Y Steps", YSteps)
        If IsNumeric(temp) <> True Then Exit Sub
        YSteps = temp
    Loop Until YSteps > 0
    
    SaveSetting App.Title, "Pattern", "xSize", XSize
    SaveSetting App.Title, "Pattern", "ySize", YSize
    SaveSetting App.Title, "Pattern", "xSteps", XSteps
    SaveSetting App.Title, "Pattern", "ySteps", YSteps
    
    Xscale = 7000 / (XSteps * XSize)
    Yscale = 5000 / (YSteps * YSize)
    If Xscale > Yscale Then
        Xscale = Yscale
    Else
        Yscale = Xscale
    End If
    
    nXSize = XSize
    nYSize = YSize
    nXSteps = XSteps
    nYSteps = YSteps
    nStep = 0
    
    PatternPicture.Width = (XSteps * XSize) * Xscale
    PatternPicture.Height = (YSteps * YSize) * Yscale
    PatternPicture.ScaleWidth = XSteps
    PatternPicture.ScaleHeight = YSteps
    PatternPicture.Visible = True
    BtnNext.Top = PatternPicture.Top + PatternPicture.Height + 100
    PatternStop.Top = BtnNext.Top
    PatternStart.Top = BtnNext.Top
    LabelTime.Top = BtnNext.Top
    Height = BtnNext.Top + BtnNext.Height + 500
    
    Visible = True
    DrawProgress
End Sub
Private Sub DrawCurrent(XBlock As Long, Yline As Long)
    Ylines = (nStep) \ nXSteps
    XBlock = (nStep) - (Ylines * nXSteps)

    PatternPicture.ForeColor = RGB(255, 0, 0)
    PatternPicture.FillColor = RGB(255, 0, 0)
    
    If (Ylines Mod 2) = 1 Then
        PatternPicture.Line (PatternPicture.ScaleWidth - (XBlock), 1 + Ylines) _
        -(PatternPicture.ScaleWidth - (XBlock + 1), Ylines), , B
    Else
        PatternPicture.Line (XBlock, (1 + Ylines))-(XBlock + 1, Ylines), , B
    End If
End Sub
Private Sub DrawProgress()
    Dim Ylines As Long
    Dim XBlocks As Long
    
    Ylines = nStep \ nXSteps
    XBlocks = nStep - (Ylines * nXSteps)
    
    If nStep = 1 Then
        PatternPicture.Cls
    End If
    
    If nStep Then
        PatternPicture.ForeColor = RGB(0, 255, 0)
        PatternPicture.FillColor = RGB(0, 255, 0)
        If Ylines Then
            PatternPicture.Line (0, 0)-(PatternPicture.ScaleWidth, Ylines), , B
        End If
        If XBlocks = 0 Then
            If nStep = (nXSteps * nYSteps) Then
                TestControl.MoveStageTo XStartPos, YStartPos
                nStep = 0
                Exit Sub
            Else
                TestControl.MoveStageBy 0, nYSize
            End If
        Else
            If (Ylines Mod 2) = 1 Then
                TestControl.MoveStageBy -nXSize, 0
                PatternPicture.Line (PatternPicture.ScaleWidth, 1 + Ylines) _
                -(PatternPicture.ScaleWidth - (XBlocks), Ylines), , B
            Else
                TestControl.MoveStageBy nXSize, 0
                PatternPicture.Line (0, (1 + Ylines))-(XBlocks, Ylines), , B
            End If
        End If
        DrawCurrent XBlocks, Ylines
    Else
        DrawCurrent XBlocks, Ylines
    End If
End Sub
Private Sub NextPoint()
    Timer1.Enabled = False
    If TestControl.IsStageMoving Then
        Timer1.Enabled = True
        Exit Sub
    End If
    
    
    If nStep = 0 Then
        PatternStart.Enabled = True
        Exit Sub
    End If
    
    nStep = nStep + 1
    DrawProgress
    Timer1.Enabled = True
End Sub
Private Sub BtnNext_Click()
    Do
        DoEvents
    Loop While TestControl.IsStageMoving
    
    nStep = nStep + 1
    DrawProgress
End Sub

Private Sub PatternStart_Click()
    Dim Moving As Integer
    
    PatternStart.Enabled = False
    Timer1.Enabled = False
    Timer1.Interval = 50
    Do
        DoEvents
    Loop While TestControl.IsStageMoving
    
    nStep = nStep + 1
    start = timeGetTime
    DrawProgress
    Timer1.Enabled = True

End Sub

Private Sub PatternStop_Click()
    nStep = 0
    Timer1.Enabled = False
    Visible = False
    Unload FrmPattern
End Sub

Private Sub Timer1_Timer()
    NextPoint
End Sub