$crystal = 1000000
'für mega16


Ddrc = &B00000111
Ddrd = &B11100000
Ddra = &B00000001
Dim A As Word

Dim S As Word
Dim H As Word
Dim E As Word
Dim F As Eram Word
Dim D As Single
Dim L As Byte
Dim N As Bit
Dim X As Word
Dim Q As Bit
Dim M As Bit
Dim K As Bit
Portc = &B00000000
Config Adc = Single , Prescaler = 32 , Reference = Avcc



Start Adc



Q = 1

A = F
Goto Startfm












Do

wait 15
M = 1

K = 1
End If
If Pind.2 = 1 Then
Q = 1
K = 1
End If



 If K = 1 Then
 Porta.0 = 0
 Do
 N = 0
 If M = 1 Then A = A + 20 Else A = A -20
 Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000010
Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000000
Waitms 15
S = Getadc(2)
D = S * 5
D = D \ 1024

Loop Until D < 3.1


 Startfm:
 Portd.5 = 1
 Do

 If M = 1 Then A = A + 10 Else A = A -10

 Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000010
Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000000
Waitms 20
S = Getadc(2)
D = S * 5
D = D \ 1024
If A = &B1111111111111111 Then A = 0
 Loop Until D > 3.6                                         'Schwellspannung


 If M = 1 Then A = A - 50 Else A = A + 50
 For X = 1 To 300
  If M = 1 Then A = A + 1 Else A = A -1
 Portc = &B00000000
 Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000010
Shiftout Portc.2 , Portc.0 , A , 0 , 16
Portc = &B00000000
Waitms 20
H = Getadc(2)
If H > S Then
Portd.6 = 1
Waitms 3
Portd.6 = 0
S = H
 E = A
 End If

Next X


Portc = &B00000000
 Shiftout Portc.2 , Portc.0 , E , 0 , 16
Portc = &B00000010
Shiftout Portc.2 , Portc.0 , E , 0 , 16
Portc = &B00000000

 Shiftout Portc.2 , Portc.0 , E , 0 , 16
Portc = &B00000010
Shiftout Portc.2 , Portc.0 , E , 0 , 16
Portc = &B00000000


  Portd.6 = 1
  Waitms 200
  Portd.6 = 0
  F = E
  A = E


 End If















Portd.5 = 0
K = 0
M = 0
Q = 0
E = 0
Porta.0 = 1














Loop