' . 4  
$regfile = "m8def.dat"
$crystal = 8000000
$lib "lcd4.lbx" : Config Lcdpin = Pin , Rs = Portb.0 , E = Portb.2 , Db4 = Portb.4 , Db5 = Portb.5 , Db6 = Portb.6 , Db7 = Portb.7 : Config Lcd = 16 * 2 : Cls : Cursor Off
Config Portd.4 = Output : Shim Alias Portd.4 : Portd = &HE0
Wait 1
Config Timer0 = Timer , Prescale = 1 : On Timer0 Pulse : Enable Timer0 : Enable Interrupts
Config Adc = Single , Prescaler = Auto , Reference = Internal : Enable Adc : Start Adc
Config Debounce = 30
Dim Y As Byte , Tik As Byte , Temp As Integer , R_provoda As Single , R_provodaeeram As Eram Single , U_provoda As Single , U(12) As Single , I(10) As Single , U_seteeram As Eram Single , U_set As Single , J As Integer , Adc_srednaya As Long

' .     ,              
Const Rr1 = 10
Const Rr2 = 1
Const Rr3 = 0.25
Const Rr4 = 11
Const Rr5 = 1

U_set = U_seteeram
R_provoda = R_provodaeeram
'R_provoda = 1.115
Do
Debounce Pind.5 , 0 , Plus , Sub
Debounce Pind.6 , 0 , Minus , Sub
Debounce Pind.7 , 0 , Kalibration , Sub

'  
Adc_srednaya = 0
For J = 1 To 1000
Temp = Getadc(1)
Adc_srednaya = Adc_srednaya + Temp
Next
Adc_srednaya = Adc_srednaya / 1000
U(1) = Adc_srednaya * 2.56
U(1) = U(1) / 1024
U(1) = U(1) * 1.11                                          '     
I(1) = U(1) / Rr1
U(2) = I(1) * Rr2
U(12) = U(1) + U(2)
I(10) = U(12) / Rr3
'---------------------
' 
Adc_srednaya = 0
For J = 1 To 1000
Temp = Getadc(0)
Adc_srednaya = Adc_srednaya + Temp
Next
Adc_srednaya = Adc_srednaya / 1000
U(5) = Adc_srednaya * 2.56
U(5) = U(5) / 1025                                          '     
I(5) = U(5) / Rr5
U(4) = I(5) * Rr4
U(10) = U(4) + U(5)
'---------------------
U_provoda = I(10) * R_provoda
U(10) = U(10) - U_provoda


'   
Cls
Locate 1 , 1
Lcd U(10)
Locate 1 , 15
Lcd " V"
Locate 2 , 1
Lcd I(10)
Locate 2 , 15
Lcd " A"
If U(10) < U_set Then Incr Y Else Decr Y
If Y = 255 Then Y = 254
If I(10) > 5 Then Y = Y - 2
Waitms 50

Loop
End

Pulse:                                                      '  
Incr Tik
If Tik => Y Then Reset Shim Else Set Shim
Return

Plus:                                                       '   +
Do
U_set = U_set + 0.05
If U_set > 20 Then U_set = 20
Cls
Locate 2 , 1
Lcd U_set
Locate 1 , 1
Lcd "  U zaryada, V"
Waitms 50
Loop Until Pind.5 = 1
U_seteeram = U_set
Waitms 50
Return

Minus:                                                      '   -
Do
U_set = U_set - 0.05
If U_set < 1 Then U_set = 1
Cls
Locate 2 , 1
Lcd U_set
Locate 1 , 1
Lcd "  U zaryada, V"
Waitms 50
Loop Until Pind.6 = 1
U_seteeram = U_set
Waitms 50
Return

Kalibration:                                                '   
Y = 0                                                       '  =0
Cls
Locate 1 , 1
Lcd " ZAMKNITE KONCI "
Locate 2 , 1
Lcd "NAZHMITE KALIBR"
Waitms 1000
Bitwait Pind.7 , Reset                                      '       

Y = 50                                                      '   
For J = 1 To 1000                                           '    1000    
Delay
Temp = Getadc(0)
Adc_srednaya = Adc_srednaya + Temp
Next
Adc_srednaya = Adc_srednaya / 1000
U(5) = Adc_srednaya * 2.56
U(5) = U(5) / 1025                                          '     
I(5) = U(5) / Rr5
U(4) = I(5) * Rr4
U(9) = U(4) + U(5)                                          '   


Adc_srednaya = 0
For J = 1 To 1000
Delay
Temp = Getadc(1)
Adc_srednaya = Adc_srednaya + Temp
Next
Adc_srednaya = Adc_srednaya / 1000
'U(1) = Adc_srednaya * 0.0025
U(1) = Adc_srednaya * 2.56
U(1) = U(1) / 1025
U(1) = U(1) * 1.11                                          '       1,11    -         !  -  
I(1) = U(1) / Rr1
U(2) = I(1) * Rr2
U(12) = U(1) + U(2)
I(9) = U(12) / Rr3

R_provoda = U(9) / I(9)                                     '       (       )
R_provodaeeram = R_provoda

'    
Cls
Locate 1 , 1
Lcd "   R_provoda=   "
Locate 2 , 1
Lcd R_provoda
Locate 2 , 13
Lcd " Ohm"
Wait 2
Return