PENGUKUR SUHU DAN KELEMBABAN ATMEGA16 BASCOM AVR

$regfile = "m16def.dat"
$crystal = 11059200

Config Lcdpin = Pin , Db4 = Porta.2 , Db5 = Porta.3 , Db6 = Porta.4 , Db7 = Porta.5 , E = Porta.1 , Rs = Porta.0

Config Lcd = 16 * 2

 Cursor Off
 Cls
 Lcd "    PENGUKUR    "
 Lowerline
 Lcd "SUHU-KELEMBABAN "
 Wait 2


Deflcdchar 1 , 28 , 20 , 28 , 32 , 32 , 32 , 32 , 32 ‘      'membuat Karakter Derajat

Dim Dataword As Word
Dim Command As Byte
Dim Calc As Single
Dim Calc2 As Single
Dim Rhlinear As Single
Dim Rhlintemp As Single
Dim Tempc As Single
Dim Tempf As Single
Dim Tempf0 As Single
Dim Ctr As Byte
Dim X As Word
Dim Y As Single
Dim Z As Single
Dim Suhu As String * 10
Dim Suhuf As String * 10
Dim Kelembaban As String * 10




Const C1 = -4
Const C2 = 0.0405
Const C3 = -0.0000028
Const S = .01
Const H = .00008
Sck Alias Portb.0                                           'sck output pada port C.0
Dataout Alias Portb.1                                       'ketika memanggil dataout portc.1 menjadi output
Datain Alias Pinb.1                                         'ketika memanggil datain portc.1 menjadi input

Declare Sub Kirim()

Ddrb = &B11111111                                           'port c sebagai output
Config Pinb.0 = Output
Config Pinb.1 = Output
Wait 1
Set Dataout
For Ctr = 1 To 12
Set Sck
Waitus 2
Reset Sck
Waitus 2
Next Ctr




'================================ MULAI ALATNYA ========================================================


'=======================================================================================================

Do

Gosub Data_suhu

Waitms 100

   Locate 2 , 1
   Lcd "t:"
   Locate 2 , 3
   Lcd Suhuf ; "F"


   Locate 2 , 9
   Lcd "Rh:"
   Locate 2 , 11
   Lcd Kelembaban ; "%"

  Waitms 100


Loop



Data_suhu:                                                  'sub program untuk mengambil data suhu dan kelembaban dari sht11
Command = &B00000011
Call Kirim                                                  'memanggil fungsi kirim
Tempc = S * Dataword
Tempc = Tempc - 40

Tempf0 = Tempc * 1.8
Tempf = Tempf0 + 32
Suhu = Fusing(tempc , "#.#")
Suhuf = Fusing(tempf , "#.#")                               'mengubah Data Single Menjadi String Dengan 2 Angka Dibelakang Koma
Command = &B00000101
Call Kirim
Calc = C2 * Dataword
Calc2 = Dataword * Dataword
Calc2 = C3 * Calc2
Calc = Calc + C1
Rhlinear = Calc + Calc2
Calc = H * Dataword
Calc = Calc + S
Calc2 = Tempc - 25
Calc = Calc2 * Calc
Rhlintemp = Calc + Rhlinear
Kelembaban = Fusing(rhlintemp , "#.##")
Return

Sub Kirim()
Local Datavalue As Word
Local Databyte As Byte
Set Sck
Reset Dataout
Reset Sck
Set Sck
Set Dataout
Reset Sck
Shiftout Dataout , Sck , Command , 1
Ddrb = &B11111101
Config Pinc.1 = Input
Set Sck
Reset Sck
Waitus 10
Bitwait Pinb.1 , Reset
Shiftin Datain , Sck , Databyte , 1
Datavalue = Databyte
Ddrb = &B11111111
Config Pinb.1 = Output
Reset Dataout
Set Sck
Reset Sck
Ddrb = &B11111101
Config Pinb.1 = Input
Shiftin Datain , Sck , Databyte , 1
Shift Datavalue , Left , 8
Datavalue = Datavalue Or Databyte
Dataword = Datavalue
Ddrb = &B11111111
Config Pinb.1 = Output
Reset Dataout
Set Sck
Reset Sck
Ddrb = &B11111101
Config Pinb.1 = Input
Shiftin Datain , Sck , Databyte , 1
Ddrb = &B11111111
Config Pinb.1 = Output
Set Dataout
Set Sck
Reset Sck
End Sub