کد:
$regfile = "M8DEF.dat" : $crystal = 1000000 'morfi cerstal va micro'
'------------------by morteza rahim pour----------------------------------------------------
Config Lcdpin = Pin , Db4 = Pinb.5 , Db5 = Pinb.4 , Db6 = Pinb.3 , Db7 = Pinb.2 , E = Pinc.1 , Rs = Pinc.2
Config Lcd = 16 * 2 : Cursor Off : Cls
Config Adc = Single , Prescaler = Auto , Reference = Internal
Cls
Dim A1 As Byte
Dim A2 As Byte
Dim A3 As Byte
Dim A4 As Byte
Dim A5 As Byte
Dim A6 As Byte
Dim Flag As Byte
Dim Sw As Bit
Dim V As Word
Dim S1 As Word
Dim S2 As Word
Dim S3 As Word
Dim I As Word
Dim Vin As Single
Config Pind.2 = Input
Set Portd.2
Config Portd.7 = Output
Cls
Locate 1 , 1 : Lcd "morteza rahimpor"
Locate 2 , 1 : Lcd "+989353524193"
Wait 10
Cls
Locate 1 , 1 : Lcd " pelece.iran@ "
Locate 2 , 1 : Lcd " yahoo.com"
Wait 10
Cls
Do
If Pind.2 = 0 Then
Set Portd.7
Waitms 500
Toggle Sw
Reset Portd.7
End If
V = Getadc(5)
V = V / 4
I = Getadc(4)
If I > 200 Then
Set Portd.7
Locate 1 , 14 : Lcd "Err"
End If
If I < 200 Then
Reset Portd.7
Locate 1 , 14 : Lcd " "
End If
Gosub Nemyesh7seg
Loop
Nemyesh7seg:
If Sw = 0 Then
S1 = V / 10
S1 = S1 * 10
S1 = V - S1
S2 = V / 100
S2 = S2 * 100
S2 = V - S2
S2 = S2 / 10
S3 = V / 100
Vin = I
Vin = Vin / 100
Locate 2 , 4
Lcd Chr(5)
Locate 2 , 8
Lcd Chr(6)
Locate 1 , 13
Lcd "V"
Locate 2 , 12
Lcd Fusing(vin , "#.##") ; "A"
End If
If Sw = 1 Then
S1 = I / 10
S1 = S1 * 10
S1 = I - S1
S2 = I / 100
S2 = S2 * 100
S2 = I - S2
S2 = S2 / 10
S3 = I / 100
Vin = V
Vin = Vin / 10
Locate 2 , 8
Lcd Chr(5)
Locate 2 , 4
Lcd Chr(6)
Locate 1 , 13
Lcd "A"
Locate 2 , 12
If Vin < 10 Then Lcd Fusing(vin , "##.#") ; "V "
If Vin => 10 Then Lcd Fusing(vin , "##.#") ; "V"
End If
Flag = S3
Gosub 7seg
Gosub Add1
Flag = S2
Gosub 7seg
Gosub Add2
Flag = S1
Gosub 7seg
Gosub Add3
Return
Add1:
Gosub Char
Locate 1 , 1
Lcd Chr(a1)
Gosub Char
Locate 1 , 2
Lcd Chr(a2)
Gosub Char
Locate 1 , 3
Lcd Chr(a3)
Gosub Char
Locate 2 , 1
Lcd Chr(a4)
Gosub Char
Locate 2 , 2
Lcd Chr(a5)
Gosub Char
Locate 2 , 3
Lcd Chr(a6)
Return
Add2:
Gosub Char
Locate 1 , 5
Lcd Chr(a1)
Gosub Char
Locate 1 , 6
Lcd Chr(a2)
Gosub Char
Locate 1 , 7
Lcd Chr(a3)
Gosub Char
Locate 2 , 5
Lcd Chr(a4)
Gosub Char
Locate 2 , 6
Lcd Chr(a5)
Gosub Char
Locate 2 , 7
Lcd Chr(a6)
Return
Add3:
Gosub Char
Locate 1 , 9
Lcd Chr(a1)
Gosub Char
Locate 1 , 10
Lcd Chr(a2)
Gosub Char
Locate 1 , 11
Lcd Chr(a3)
Gosub Char
Locate 2 , 9
Lcd Chr(a4)
Gosub Char
Locate 2 , 10
Lcd Chr(a5)
Gosub Char
Locate 2 , 11
Lcd Chr(a6)
Return
Return
7seg:
Select Case Flag
Case 0:
A1 = 1 : A2 = 3 : A3 = 0 : A4 = 1 : A5 = 2 : A6 = 0
Case 1:
A1 = 3 : A2 = 0 : A3 = 5 : A4 = 2 : A5 = 1 : A6 = 2
Case 2 :
A1 = 3 : A2 = 4 : A3 = 0 : A4 = 1 : A5 = 2 : A6 = 2
Case 3:
A1 = 4 : A2 = 4 : A3 = 0 : A4 = 2 : A5 = 2 : A6 = 0
Case 4:
A1 = 1 : A2 = 2 : A3 = 0 : A4 = 5 : A5 = 5 : A6 = 0
Case 5:
A1 = 1 : A2 = 4 : A3 = 3 : A4 = 2 : A5 = 2 : A6 = 0
Case 6:
A1 = 1 : A2 = 4 : A3 = 3 : A4 = 1 : A5 = 2 : A6 = 0
Case 7:
A1 = 3 : A2 = 3 : A3 = 0 : A4 = 5 : A5 = 5 : A6 = 0
Case 8:
A1 = 1 : A2 = 4 : A3 = 0 : A4 = 1 : A5 = 2 : A6 = 0
Case 9:
A1 = 1 : A2 = 4 : A3 = 0 : A4 = 2 : A5 = 2 : A6 = 0
End Select
Return
Char:
Deflcdchar 0 , 30 , 31 , 31 , 31 , 31 , 31 , 31 , 30 ' 0(be rast)
Deflcdchar 1 , 15 , 31 , 31 , 31 , 31 , 31 , 31 , 15 ' 1(be chap)
Deflcdchar 2 , 32 , 32 , 32 , 32 , 32 , 32 , 31 , 31 ' 2(payin)
Deflcdchar 3 , 31 , 31 , 32 , 32 , 32 , 32 , 32 , 32 ' 3(bala)
Deflcdchar 4 , 31 , 31 , 32 , 32 , 32 , 32 , 31 , 31 ' 4(balapayin)
Deflcdchar 5 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32 ' 5(khali)
Deflcdchar 6 , 32 , 32 , 32 , 32 , 32 , 32 , 14 , 14 ' replace ? with number (0-7)