Управление ШД через LPT порт

Option Explicit
 
Private Declare Function QueryPerformanceFrequencyAny Lib "kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As Any) As Long
Private Declare Function QueryPerformanceCounterAny Lib "kernel32" Alias "QueryPerformanceCounter" (lpPerformanceCount As Any) As Long
 
Dim i As Long, f As Boolean
 
Private Sub Form_Load()
    Dim SampleRate As Currency
    Dim Freq As Currency
    Dim Ct1 As Currency, Ct2 As Currency
    Dim Num As Currency, i As Long
    Dim Refr As Long
    
    Me.Show
    
    Freq = 2000                         ' Задаем частоту 2 kHz
    QueryPerformanceFrequencyAny SampleRate
    SampleRate = SampleRate * 10000     ' Узнаем частоту счетчика
    Num = SampleRate / Freq / 10000     ' Узнаем сколько тиков нужно чтобы получить период сигнала
    Refr = Freq / 5                     ' Обновление 5 Гц
    
    QueryPerformanceCounterAny Ct1      ' Получаем текущее значение счетчика
    
    Do
        QueryPerformanceCounterAny Ct2  ' Получаем текущее значение счетчика
        If Ct2 - Ct1 >= Num Then        ' Если число тиков больше
            i = i + 1
            ' ---------------------------------------
            ' Заход сюда происходит с нужной частотой
            ' ---------------------------------------
            If i Mod Refr = 0 Then       ' Обновление 
                Me.Caption = i
                DoEvents
            End If
            Ct1 = Ct2 + ((Ct2 - Ct1) - Num)
        End If
    Loop Until f
End Sub
Private Sub Form_Unload(Cancel As Integer)
    f = True
End Sub