form1.frm

外国人写的dds控制源代码。有兴趣的朋友可以看看！

If qrg < 0 Then
MsgBox ("Die eingestellte Frequenz muss gr鲞er als 0 MHz sein!!")
qrg = 0   'qrg = Format(0, "0.000000")
End If

Label1.Caption = Format(qrg, "0.000000") & " MHz"
datenwortberechnen

End Sub

Private Sub Command3_Click()
'Programm beenden
Out Val(PortAddress), 0
DELAY 1
Unload Me
End Sub

Private Sub Command4_Click()
'DDS reseten
Out Val(PortAddress), 0
DELAY 1
Out Val(PortAddress), 8

qrg = 0         'Format(0, "0.000000")
Text1.Text = 0
Label1.Caption = Format(qrg, "0.000000") & " MHz"
datenwortberechnen

End Sub


Private Sub Form_Load()
'beim laden des programms auszuf黨rende dinge
'einfach mal alle portadressen probieren und den port auf 0 setzen
HScroll1 = 5

PortAddress = &H278
'lpt port auf 0 setzen
Out Val(PortAddress), 0     'auf jeden Fall D3 (Reset) einschalten

PortAddress = &H3BC
'lpt port auf 0 setzen
Out Val(PortAddress), 0     'auf jeden Fall D3 (Reset) einschalten

'default lpt adresse beim weiteren programmablauf
PortAddress = &H378
'lpt port auf 0 setzen
Out Val(PortAddress), 0     'auf jeden Fall D3 (Reset) einschalten



'default schrittweite
delta = 0.01

'default frequenz der dds baugruppe ausgeben

qrg = 0         'Format(0, "0.000000")
Label1.Caption = Format(qrg, "0.000000") & " MHz"
Label4.Caption = Text2.Text * multfaktor & " MHZ"
datenwortberechnen

End Sub


Private Sub HScroll1_Change()
Label4.Caption = Text2.Text * multfaktor
Select Case HScroll1
Case 4
multfaktor = 4
cfr2_mult = 38
Case 5
multfaktor = 5
cfr2_mult = 46
Case 6
multfaktor = 6
cfr2_mult = 54
Case 7
multfaktor = 7
cfr2_mult = 62
Case 8
multfaktor = 8
cfr2_mult = 70
Case 9
multfaktor = 9
cfr2_mult = 78
Case 10
multfaktor = 10
cfr2_mult = 86
Case 11
multfaktor = 11
cfr2_mult = 94
Case 12
multfaktor = 12
cfr2_mult = 102
Case 13
multfaktor = 13
cfr2_mult = 110
Case 14
multfaktor = 14
cfr2_mult = 118
Case 15
multfaktor = 15
cfr2_mult = 126
Case 16
multfaktor = 16
cfr2_mult = 134
Case 17
multfaktor = 17
cfr2_mult = 142
Case 18
multfaktor = 18
cfr2_mult = 150
Case 19
multfaktor = 19
cfr2_mult = 158
Case 20
multfaktor = 20
cfr2_mult = 166

End Select

If Option12 = True Then ' kein refclk multiplier
multfaktor = 1
cfr2_mult = 6           'bin鋜 0000 0110
End If


If Text2.Text * multfaktor > 400 Then
MsgBox "Das Produkt aus dem Multiplikationsfaktor und dem RefClk darf nicht gr鲞er als 400 sein! "
Text2.Text = 0
End If

Label4.Caption = Text2.Text * multfaktor
Label10.Caption = multfaktor
End Sub

Private Sub Option12_Click()
HScroll1_Change
Label4.Caption = Text2.Text & " MHZ"
multfaktor = 1
End Sub

Private Sub Option13_Click()
HScroll1_Change
Label4.Caption = Text2.Text * multfaktor & " MHZ"
End Sub

Private Sub Option9_Click()

'lpt port 1
PortAddress = &H378
End Sub

Private Sub Option10_Click()

'lpt port 2
PortAddress = &H278
End Sub

Private Sub Option11_Click()

'lpt port 3
PortAddress = &H3BC
End Sub

Private Sub Option1_Click()

'schrittweite 1Hz
delta = 0.000001
End Sub

Private Sub Option2_Click()

'schrittweite 10Hz
delta = 0.00001
End Sub

Private Sub Option3_Click()

'schrittweite 100Hz
delta = 0.0001
End Sub

Private Sub Option4_Click()

'schrittweite 1kHz
delta = 0.001
End Sub

Private Sub Option5_Click()

'schrittweite 10kHz
delta = 0.01
End Sub

Private Sub Option6_Click()

'schrittweite 100kHz
delta = 0.1
End Sub

Private Sub Option7_Click()

'schrittweite 1MHz
delta = 1
End Sub

Private Sub Option8_Click()

'schrittweite 10MHz
delta = 10
End Sub


Sub datenwortberechnen()
'suchen der einstellungen f黵 den refclk (multiplikationsfaktor, refclk frequenz)
If Option12 = True Then ' kein refclk multiplier
multfaktor = 1
cfr2_mult = 6           'bin鋜 0000 0110
End If
If Option13 = True Then     'refclk multiplier an
HScroll1_Change
End If
refclk = Text2.Text * multfaktor
If refclk > 400 Then
MsgBox "Das Produkt aus dem Multiplikationsfaktor und dem RefClk darf nicht gr鲞er als 400 sein! Programm wird beendet", vbCritical
End
End If


'berechnung des dds datenwortes und wandlung in vier byte
Dim frg As Double
Dim freqLo As Double
Dim freqHi As Double
Dim qrg1
Dim offset
qrg1 = qrg
offset = Val(Text1.Text) / 1000
If (qrg1 + offset) > (0.4 * refclk) Then
MsgBox "Die eingestellte Frequenz darf nicht gr鲞er als 40% des Systemclocks sein!!"
qrg = 0
qrg1 = 0         'Format(0, "0.000000")
Label1.Caption = Format(qrg, "0.000000") & " MHz"
End If
'berechnung des dds datenwortes mit einer refclk von 400 MHz
frg = Round((qrg1 + offset) * (2 ^ 32 / refclk))

'umrechnung des datenwortes in die 4 auszugebenden byte
'die umrechnung liefert die hex-werte der 4 byte in ihrer dezimalen entsprechnung
'geklaute umrechnungsroutine von elexs (www.elexs.de)
freqHi = frg \ &H10000
freqLo = frg - freqHi * &H10000
freqLoL = freqLo And &HFF
freqLoH = freqLo \ &H100
freqHiL = freqHi And &HFF
freqHiH = freqHi \ &H100

'aufruf der ausgaberoutinen an den parallelport
datenuebergabe_an_ausgabe
End Sub
Sub datenuebergabe_an_ausgabe()

REALTIME        'programm bekommt hohe ausf黨rungspriorit鋞, gilt nur in der Sub

datenwort = 1          'adresse f黵 cfr2 bitpattern "0000 0001"
ausgabe

datenwort = 0
ausgabe

datenwort = 0
ausgabe

datenwort = cfr2_mult
ausgabe

'strobe
Out Val(PortAddress), 12     'strobe setzen bitpattern "0000 1100"
DELAY 0.01                   'kurzes p鋟schen
Out Val(PortAddress), 8     'strobe ausschalten bitpattern "0000 1000"


datenwort = 4         'adresse f黵 frequenz bitpattern "0000 0100"
ausgabe

datenwort = freqHiH     'h鯿hstes frequenzbyte
ausgabe

datenwort = freqHiL     'frequenzbyte
ausgabe

datenwort = freqLoH     'frequenzbyte
ausgabe

datenwort = freqLoL     'niedrigstes frequenzbyte
ausgabe

'strobe
Out Val(PortAddress), 12     'strobe setzen bitpattern "0000 1100"
DELAY 0.01                   'kurzes p鋟schen
Out Val(PortAddress), 8     'strobe ausschalten bitpattern "0000 1000"

End Sub

Sub ausgabe()
REALTIME         'programm bekommt hohe ausf黨rungspriorit鋞, gilt nur in der Sub

'ausgabe routine an den parallelport, MSB zuerst, bit 4 (reset) muss immer high sein

Dim Output As Byte
Dim i

For i = 7 To 0 Step -1      '8 bit ausgeben, mit dem h鯿hstwertigen beginnen
Output = datenwort And 2 ^ i
If Output <> 0 Then
Out Val(PortAddress), 9      'datenbit auf 1 setzen bitpattern "0000 1001"
Out Val(PortAddress), 11     'datenbit und clock auf 1 setzen bitpattern "0000 1011"
DELAY 0.01
Else
Out Val(PortAddress), 8      'datenbit auf 0 setzen bitpattern "0000 1000"
Out Val(PortAddress), 10    'datenbit auf 0, clock auf 1 setzen bitpattern "0000 1010"
DELAY 0.01
End If
Out Val(PortAddress), 8      'datenbit und clock auf 0 setzen bitpattern "0000 1000"
DELAY 0.01
Next i

End Sub

Private Sub Text2_Change()
If Text2.Text = "" Then
Text2.Text = 0
End If
If Text2.Text * multfaktor > 400 Then
MsgBox "Das Produkt aus dem Multiplikationsfaktor und dem RefClk darf nicht gr鲞er als 400 sein! "
Text2.Text = 0
End If
Label4.Caption = Text2.Text * multfaktor & " MHZ"

End Sub