dotNETportal.cz

Zkuste si příklad:

Na Form1 vložte Button1, Label1, TextBox1, Label2, TextBox2, do aplikace přidejte Timer1 - ostatní obstará následující kód

Public Class Form1
  Dim Start As Double

  ''' <summary>
  ''' Příklad měření času
  ''' </summary>
  ''' <remarks>
  ''' Na Form1 vložte Button1, Label1, TextBox1, Label2, TextBox2
  ''' do aplikace přidejte Timer1
  ''' ostatní obstará násl. kód
  ''' </remarks>
  Private Sub Form1_Load(ByVal sender As System.Object, _
       ByVal e As System.EventArgs) Handles MyBase.Load
    Dim Pismo As Font = New System.Drawing.Font("Microsoft Sans Serif", 12.0)
    Me.Text = " Měření času"
    Me.ClientSize = New System.Drawing.Size(302, 86)
    '------------
    Me.Button1.AutoSize = True
    Me.Button1.Font = Pismo
    Me.Button1.Location = New System.Drawing.Point(198, 12)
    Me.Button1.Size = New System.Drawing.Size(96, 30)
    Me.Button1.Text = "Reset"
    '-------------
    Me.Label1.AutoSize = True
    Me.Label1.Font = Pismo
    Me.Label1.Location = New System.Drawing.Point(7, 17)
    Me.Label1.Name = "Label1"
    Me.Label1.Size = New System.Drawing.Size(56, 20)
    Me.Label1.Text = "Start:  "
    '-------------
    Me.TextBox1.Font = Pismo
    Me.TextBox1.Location = New System.Drawing.Point(63, 14)
    Me.TextBox1.Name = "TextBox1"
    Me.TextBox1.Size = New System.Drawing.Size(128, 26)
    Me.TextBox1.TextAlign = System.Windows.Forms.HorizontalAlignment.Center
    '---------------
    Me.Label2.AutoSize = True
    Me.Label2.Font = Pismo
    Me.Label2.Location = New System.Drawing.Point(7, 53)
    Me.Label2.Name = "Label2"
    Me.Label2.Size = New System.Drawing.Size(135, 20)
    Me.Label2.Text = "Od startu uběhlo: "
    '-------------
    Me.TextBox2.Font = Pismo
    Me.TextBox2.Location = New System.Drawing.Point(149, 50)
    Me.TextBox2.Name = "TextBox2"
    Me.TextBox2.Size = New System.Drawing.Size(145, 26)
    '-------------
    Start = Environment.TickCount()
    Me.TextBox1.Text = Now.ToString("HH:mm:ss.fff")
    Me.Timer1.Start()
    ' pro ladění - mmusí vrátit 1:05:02.125
    ' TextBox1.Text = cas(3902125) 
  End Sub

  Private Function cas(ByVal i As Integer) As String
    Dim cs As String ' budoucí obsah pro TextBox
    Dim ss As String = i Mod 1000 ' milisekundy
    i = i \ 1000
    Dim h As String = CStr(i \ 3600) ' hodiny
    Dim m As String = CStr((i Mod 3600) \ 60) ' minuty
    Dim s As String = CStr(i Mod 60) ' sekundy
    If Len(m) = 1 Then m = "0" & m
    If Len(s) = 1 Then s = "0" & s
    cs = h & ":" & m & ":" & s & "." & ss
    Return cs
  End Function

  Private Sub Button1_Click(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles Button1.Click
    Start = Environment.TickCount()
    TextBox1.Text = Now.ToString("HH:mm:ss.fff")
  End Sub

  Private Sub Timer1_Tick(ByVal sender As System.Object, _
     ByVal e As System.EventArgs) Handles Timer1.Tick
    Me.Text = " Systémový čas: " & Now.ToString("HH:mm:ss.fff")
    TextBox2.Text = " " & cas(Environment.TickCount() - Start)
  End Sub

End Class

Vezměte si z příkladu co potřebujete, pokud se hodí. Po 40 minutách jsem zaznamenal rozdíl 1 milisekundy - můžete měřit rychlost neutrin :-))

Tak to jsem přehlédl, pardon. Ale na stejném principu to jde udělat i ve VB6.

K zachycení okamžiku startu se místo "Environment.TickCount()" použije Timer. Pro použití formátovací funkce z příkladu pro .NET je nutné hodnotu uběhlého času vynásobit 1000, protože Timer vrací sekundy a s desetinnými místy. Je proto třeba parametr definovat jako Double místo Integer a upravit syntaxi pro VB6 (rozdělit definici a naplnění hodnotou do samostatných řádků). Také formátovací řetšzec je trochu jiný.

Funguje to stejně jako v příkladu pro .NET

  Option Explicit
  Dim Start As Double

  Private Sub Form_Load()
    Start = Timer
    Text1 = " " & cas(Timer)
    '  pro ladění - mmusí vrátit 1:05:02.125
    ' Text1 = cas(3902.125)
    Timer1.Enabled = True
  End Sub

  Private Sub Command1_Click()
    Start = Timer
    Text1 = " " & cas(Timer)
  End Sub

   Private Function cas(ByVal i As Double) As String
      i = i * 1000
      Dim ss As String  ' milisekundy
      ss = i Mod 1000
      i = i \ 1000
      Dim h As String ' hodiny
      h = CStr(i \ 3600)
      Dim m As String ' minuty
      m = CStr((i Mod 3600) \ 60)
      Dim s As String ' sekundy
      s = CStr(i Mod 60)
      If Len(m) = 1 Then m = "0" & m
      If Len(s) = 1 Then s = "0" & s
      cas = h & ":" & m & ":" & s & "." & ss
  End Function

  Private Sub Timer1_Timer()
     Me.Caption = " Systémový čas: " & Format(Now, "Hh:Nn:Ss")
    Text2 = " " & cas(Timer - Start)
  End Sub