کد:
$regfile = "m8def.dat"
$crystal = 1000000
Config Timer2 = Timer , Async = On , Prescale = 128
On Timer2 Ant : Enable Interrupts : Enable Timer2 :
Config Timer1 = Counter , , Edge = Falling , Prescale = 1
On Timer1 Ali : Enable Timer1
'**********************************************************
Config Adc = Single , Prescaler = Auto , Reference = Internal
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Portb.0 , Db5 = Portb.1 , Db6 = Portb.2 , Db7 = Portb.3 , Rs = Portb.4 , E = Portb.5
'**********************************************************
Deflcdchar 1 , 16 , 32 , 15 , 16 , 16 , 16 , 15 , 32
Deflcdchar 2 , 4 , 10 , 17 , 31 , 31 , 31 , 14 , 32
Deflcdchar 3 , 17 , 17 , 2 , 4 , 4 , 8 , 9 , 17
'**********************************************************
Config Pinc.3 = Output
Config Pinc.4 = Output
Config Pinc.5 = Output
Config Pind.3 = Input : Portd.3 = 1
Config Pind.5 = Input : Portd.5 = 1
Config Pind.6 = Input : Portd.6 = 1
Menu Alias Pind.6
Up Alias Pind.3
Down Alias Pind.5
Minimal Alias Portc.3
Maximal Alias Portc.4
Admissible Alias Portc.5
'**********************************************************
Dim Adc_value As Word
Dim Adc_value2 As Word
Dim Adc_final As Single
Dim Adc_final2 As Single
Dim X(4) As Single , I As Byte
Dim X2(4) As Single , J As Byte
Dim Adc_compare As Byte
Dim Adc_compare2 As Byte
Dim Eram_up As Eram Byte
Dim Eram_down As Eram Byte
Dim Eram_up1 As Byte
Dim Eram_down1 As Byte
Dim L As Long
Dim B As Byte
Dim W As Word
Dim Omega As Single
Dim M As Single
Dim S As String * 16
Eram_up1 = Eram_up
Eram_down1 = Eram_down
If Eram_up1 = 255 Or Eram_up1 = 0 Then
Eram_up = 85
End If
If Eram_down1 = 255 Or Eram_down1 = 0 Then
Eram_down = 5
End If
'********************************************************
Declare Sub No_key
Declare Sub Menuo
Declare Sub Max_change
Declare Sub Min_change
'*****************main*******************************
Cls : Cursor Off Noblink
Begin:
Do
For I = 1 To 4
Adc_value = Getadc(1)
Adc_final = Adc_value / 3.996
Adc_final = Round(adc_final)
X(i) = Adc_final
Waitms 225
Next
Adc_final = X(1) + X(2)
Adc_final = Adc_final + X(3) : Adc_final = Adc_final + X(4)
Adc_final = Adc_final / 4
Adc_final = Round(adc_final)
Adc_compare = Adc_final
If Adc_compare > Eram_up1 Then
Home : Lcd " TEMP EXCEED! " : Lowerline
Lcd " " ; Adc_final ; Chr(1) ;
Sound Portc.0 , 60 , 100
Maximal = 1 : Minimal = 0 : Admissible = 0
Elseif Adc_compare < Eram_down1 Then
Home : Lcd " TEMP EXCEED! " : Lowerline
Lcd " " ; Adc_final ; Chr(1) ;
Sound Portc.0 , 60 , 100
Maximal = 0 : Minimal = 1 : Admissible = 0
Else
Home
Lcd "ADMISSIBLE VALUE: "
Lowerline : Lcd " " ; Adc_final ; Chr(1) ;
Maximal = 0 : Minimal = 0 : Admissible = 1
End If
'*************************************************
Start Timer2
Do
Loop
Ant:
Stop Timer1 :
W = Timer1
Timer1 = 0
Start Timer1
L = B * 65536 : L = L + W : B = 0
Locate 2 , 10
Lcd "F:"
If L < 1000 Then :
Locate 2 , 10
Lcd L ; " "
Else :
M = L / 1000 : S = Fusing(m , "#.###") : Locate 2 , 10 : Lcd S ; " K"
End If
Lcd "Hz " : M = L * 6.283185307179586476925286766559
If M < 1000 Then :
S = Fusing(m , "#.###") : Locate 2 , 10 : Lcd S ; " "
Else :
M = M / 1000 : S = Fusing(m , "#.###") : Locate 2 , 10 : Lcd S ; " K"
End If
Lcd "R/S " "
Return
Ali:
B = B + 1
Return
'*************************************************
If Menu = 0 Then
Call No_key
Call Menuo
End If
Loop
'***********************SUBROUTINE******************************
Sub Menuo
Cls : Home
Do
Eram_up1 = Eram_up
Eram_down1 = Eram_down
Upperline : Lcd " up: " ; " down: "
Lowerline : Lcd " " ; Eram_up1 ; " " ; Eram_down1
If Up = 0 Then
Call No_key
Call Max_change
Elseif Down = 0 Then
Call No_key
Call Min_change
Elseif Menu = 0 Then
Call No_key
Goto Begin
End If
Loop
End Sub
'***********************************************************
Sub Max_change
Do
Locate 1 , 1 : Lcd "set max value "
Lowerline : Lcd " " ; Eram_up1 ; " "
If Up = 0 Then
Call No_key
Incr Eram_up1
Eram_up = Eram_up1
Lowerline : Lcd " " ; Eram_up1 ; " "
Elseif Down = 0 Then
Call No_key
Decr Eram_up1
Eram_up = Eram_up1
Lowerline : Lcd " " ; Eram_up1 ; " "
End If
If Menu = 0 Then
Call No_key
Exit Sub
End If
Loop
End Sub
'***********************************************************
Sub Min_change
Do
Locate 1 , 1 : Lcd "set Min Value "
Lowerline : Lcd " " ; Eram_down1 ; " "
If Up = 0 Then
Call No_key
Incr Eram_down1
Eram_down = Eram_down1
Lowerline : Lcd " " ; Eram_down1 ; " "
Elseif Down = 0 Then
Call No_key
Decr Eram_down1
Eram_down = Eram_down1
Lowerline : Lcd " " ; Eram_down1 ; " "
End If
If Menu = 0 Then
Call No_key
Exit Sub
End If
Loop
End Sub
Sub No_key
Do
Loop Until Pind.3 = 1 And Pind.5 = 1 And Pind.6 = 1
Waitms 30
End Sub
End
توجه: این یک موضوع قدیمی است که آخرین پست ارسالی آن مربوط به 4497 روز قبل است . لطفا فقط پاسخ ها ، سوالات و درخواست های 100 درصد مرتبط را به آن ارسال کنید و برای درخواست ها و سوالات جدید موضوع جدیدی را ایجاد کنید
مدار کنترل دما و رطوبت وایرلیس
نوشته اصلی توسط kavir
مجوز های ارسال و ویرایش
پاسخ با نقل قول