VERSION 5.00 Begin VB.Form SetRef Caption = "Définir la référence" ClientHeight = 1800 ClientLeft = 60 ClientTop = 345 ClientWidth = 11070 ClipControls = 0 'False ControlBox = 0 'False LinkTopic = "Form2" ScaleHeight = 1800 ScaleMode = 0 'User ScaleWidth = 100 StartUpPosition = 3 'Windows Default Visible = 0 'False Begin VB.CommandButton BtCancel Caption = "Annuler" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 8880 TabIndex = 8 Top = 1320 Width = 975 End Begin VB.PictureBox PsetTTrim AutoRedraw = -1 'True BackColor = &H00FF8080& BorderStyle = 0 'None ForeColor = &H00FFFFFF& Height = 255 Left = 120 ScaleHeight = 255 ScaleMode = 0 'User ScaleWidth = 25.343 TabIndex = 5 Top = 960 Width = 10815 End Begin VB.CommandButton BtFixRef Caption = "Appliquer" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 9960 TabIndex = 2 Top = 1320 Width = 975 End Begin VB.PictureBox PsetT AutoRedraw = -1 'True BackColor = &H00C00000& BorderStyle = 0 'None DrawMode = 7 'Invert DrawWidth = 4 ForeColor = &H00C0C0FF& Height = 255 Left = 120 ScaleHeight = 4.498 ScaleMode = 0 'User ScaleWidth = 10 TabIndex = 0 Top = 360 Width = 10815 End Begin VB.Label LbTurns Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "0.0" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 1920 TabIndex = 10 Top = 1360 Width = 390 End Begin VB.Label Label5 Alignment = 2 'Center AutoSize = -1 'True Caption = "0" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 5424 TabIndex = 9 Top = 720 Width = 120 End Begin VB.Label Label4 Alignment = 2 'Center AutoSize = -1 'True Caption = "+10 mm" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 10305 TabIndex = 7 Top = 720 Width = 660 End Begin VB.Label Label3 Alignment = 2 'Center AutoSize = -1 'True Caption = "160 mm" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 10335 TabIndex = 6 Top = 120 Width = 660 End Begin VB.Label Label2 Alignment = 2 'Center AutoSize = -1 'True Caption = "-10 mm" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 120 TabIndex = 4 Top = 720 Width = 630 End Begin VB.Label Label1 Alignment = 2 'Center AutoSize = -1 'True Caption = "0 mm" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 120 TabIndex = 3 Top = 120 Width = 450 End Begin VB.Label LbPosRef Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "0.000" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 8040 TabIndex = 1 Top = 1360 Width = 690 End End Attribute VB_Name = "SetRef" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim FTop As Single Dim FLeft As Single Public CarLoc As Single Public CarNow As Single Dim Cpos As Single Dim Prev As Single Public Sub FollowRPT(P As Single) If P = Prev Then Exit Sub SetCarriage P End Sub Public Sub SetCarriage(P As Single) PsetT.Line (Prev, 0)-(Prev, 255) 'Once to erase Prev = P PsetT.Line (Prev, 0)-(Prev, 255) 'Once to redraw LbPosRef.Caption = Format(Prev, "0.0##") End Sub Private Sub BtCancel_Click() Me.Hide End Sub Private Sub BtFixRef_Click() RefOffset = Cpos Me.Hide End Sub Private Sub Form_Load() ' CenterForm Me Me.Top = Val(GetIniString(INIFILE, "FormsLoc", "SetRefTop")) Me.Left = Val(GetIniString(INIFILE, "FormsLoc", "SetRefLeft")) FTop = Me.Top FLeft = Me.Left PsetT.ScaleWidth = TOTALTRAVEL PsetTTrim.ScaleWidth = 20 '+ - 1 cm PsetTTrim.Line (10, 0)-(10, 255) 'Show middle Cpos = RefOffset LbPosRef.Caption = Format(Cpos, "0.0##") End Sub Private Sub PsetT_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) #If Nohard Then Debug.Print "PsetT "; X; Y #End If MoveTAbs X Cpos = X LbPosRef.Caption = Format(Cpos, "0.0##") SetCarriage Cpos End Sub Private Sub PsetTTrim_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim T As Single T = X - PsetTTrim.ScaleWidth / 2 If Shift Then T = T / 10 'Very small steps if shift hold down If Cpos + T >= 0 Then Cpos = Cpos + T Else Cpos = 0 'Not past ENDT End If MoveTAbs Cpos LbPosRef.Caption = Format(Cpos, "0.0##") SetCarriage Cpos End Sub Public Sub WaitMe() If SilentRun Then CarNow = CarLoc SetCarriage CarNow Exit Sub End If While CarLoc <> CarNow ' Sleep 10 '1000 / (Rpm + 1) 'Simulate speed ' Wait 1000 / (Rpm + 1) 'Simulate speed Wait 1 'DO NOT simulate speed, go fast If CarLoc > CarNow Then CarNow = CarNow + 0.1 If CarLoc < CarNow Then CarNow = CarNow - 0.1 If Abs(CarLoc - CarNow) < 0.1 Then CarNow = CarLoc SetCarriage CarNow Wend Cpos = CarNow End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Debug.Print "MouseMove" If FTop <> Me.Top Or FLeft <> Me.Left Then WriteIniString INIFILE, "FormsLoc", "SetRefTop", Str(Me.Top) WriteIniString INIFILE, "FormsLoc", "SetRefLeft", Str(Me.Left) FTop = Me.Top FLeft = Me.Left End If End Sub