Re: Zadanie z bascoma

2012-10-26T22:28:02+01:00

Foto LCD

Statystyki: Napisane przez foreste — 26 paź 2012, o 22:28

Re: Zadanie z bascoma

2012-10-25T22:42:39+01:00

trzymaj jakieś stare kody może Ci pomogą... ja na szczęście uciekłem od tego języka :>

TERMOSTAT:

[syntax=basic4gl]

'*********TERMOSTAT 2011*********
'*********BY el-Kierlan**********
'*******SALAMANDRA PLAMISTA******

$regfile = "m168def.dat"
$crystal = 16000000

Config 1wire = Portd.1 ' konfiguracja portu dla DS1820

Config Portd.0 = Output

Declare Sub Odcz_temp 'deklaracja podprogramu odczytu temperatury

Dim Temperatura(2) As Byte
Dim Temp As Byte
Dim A1 As Byte
Dim A2 As Byte
Dim H As Byte
Dim T1 As Byte
$baud = 9600

T1 = 35

Do
Print "*********TERMOSTAT 2011*********"
Print "*********BY el-Kierlan**********"
Print "*******SALAMANDRA PLAMISTA******"
Waitms 500
Temp = Temperatura(1)
'Histereza
H = 2
H = H / 2
A1 = T1 - H
A2 = T1 + H

If Temp <= A1 Then

Print " Grzanie "
Portd.0 = 1
End If

If Temp >= A2 Then

Print " Temperatura osiagnieta"
Portd.0 = 0
End If

Loop

Sub Odcz_temp 'odczyt temperatury

1wreset 'incicjacja magistrali 1wire
If Err = 1 Then 'jeżeli błąd

Print "Brak czujnika DS18B20" 'to wyświetl
End If

1wreset 'inicjacja magistrali 1wire
1wwrite &HCC
1wwrite &H44

Waitms 750 'czas konwersji

1wreset
1wwrite &HCC
1wwrite &HBE

Temperatura(1) = 1wread(2)

If Temperatura(2) > 0 Then

Temperatura(1) = 256 - Temperatura(1)

End If

Temperatura(1) = Temperatura(1) / 2

End Sub
[/syntax]

ZEGAREK:

[syntax=basic4gl]

$regfile = "m8def.dat" 'informuje kompilator o pliku
'dyrektyw mikrokontrolera
$crystal = 8000000 'informuje kompilator
'o czestotliwo?ci oscylatora
'taktuj1cego mikrokontroler
Config Pinb.3 = Input 'linia PB1 jako wej?ciowa
Config Pinb.4 = Input
Config Pinb.5 = Input
Config Portd.0 = Output 'linia PB2 jako wej?ciowa
Config Lcd = 16 * 2 'konfiguracja typu wy?wietlacza
'LCD
Config Lcdpin = Pin , Db4 = Portc.3 , Db5 = Portc.2 , Db6 = Portc.1 , Db7 = Portc.0 , E = Portc.4 , Rs = Portc.5 'konfiguracja linii
'mikrokontrolera, do których
'do31czono wy?wietlacz
'LCD
Config Timer1 = Timer , Prescale = 256
'konfiguracja Timer1 jako timer
'z podzia3em preskalera przez
'256

Declare Sub Wysw_czas 'procedura wy?wietlaj1ca czas na
'LCD w formacie gg:mm:ss
On Timer1 Odmierz_1s 'przerwanie od przepe3nienia
'Timer1 o etykiecie Odmierz_1s

Dim Sekundy As Byte 'zmienna zliczaj1ca sekundy
Dim Minuty As Byte 'zmienna zliczaj1ca minuty
Dim Godziny As Byte 'zmienna zliczaj1ca godziny
Dim Nowa_w As Bit 'flaga zezwolenia aktualizacji
'czasu na LCD
Dim Wart_bcd As Byte 'zmienna pomocnicza, w której
'jest zapisywana warto?a BCD
'czasu

S1 Alias Pinb.3 'przypisanie nazwie Pinb.2
'nazwy S1
S2 Alias Pinb.4
S3 Alias Pinb.5 'przypisanie nazwie Pinb.1
'nazwy S2

Enable Interrupts 'odblokowanie globalnego systemu
'przerwan
Enable Timer1 'odblokowanie przerwania od
'przepe3nienia Timer1
Counter1 = 34286 'warto?a pocz1tkowa wpisywana do
'Timer1 (65536 - 31250 = 34286)

Set Nowa_w 'zezwolenie na wy?wietlenie
'aktualnego czasu
Set Portb.3 'do31czenie do linii PB1
'rezystora podci1gaj1cego
Set Portb.4 'do31czenie do linii PB2
Set Portb.5 'rezystora podci1gaj1cego
Do

Cursor Off 'petla g3ówna programu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlaj1cej aktualny czas
If S3 = 0 Then
Waitms 25
Toggle Portd.0
Wait 2
Toggle Portd.0
End If
If S1 = 0 Then 'je?li przyci?niety S1, to
Waitms 25 'opó?nienie dla eliminacji drgan
'styków
If S1 = 0 Then 'sprawdzenie, czy przycisk S1
'dalej naci?niety, je?li tak, to
Incr Minuty 'zwiekszenie warto?ci minut
Sekundy = 0 'wyzerowanie zmiennej Sekundy
If Minuty = 60 Then 'je?li warto?a Minuty = 60, to
Minuty = 0 'zerowanie warto?ci Minuty
End If
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlenia aktualnego czasu
Waitms 200 'opó?nienie 200 ms
End If 'koniec instrukcji warunkowej
End If
If S2 = 0 Then 'je?li przyci?niety S2, to
Waitms 25 'opó?nienie dla eliminacji drgan
'styków
If S2 = 0 Then 'sprawdzenie czy przycisk S2
'dalej naci?niety, je?li tak, to
Incr Godziny 'zwiekszenie warto?ci Godziny
If Godziny = 24 Then 'je?li warto?a Godziny = 24, to
Godziny = 0 'wyzerowanie warto?ci Godziny
End If
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlenia aktualnego czasu
Waitms 200 'opó?nienie 200 ms
End If 'koniec instrukcji warunkowej
End If
Loop
End 'koniec programu

Sub Wysw_czas 'procedura wy?wietlaj1ca czas
If Nowa_w = 1 Then 'je?li flaga Nowa_w = 1, to
Cls 'czyszczenie LCD
Wart_bcd = Makebcd(godziny) 'zamiana warto?ci Godziny na
'warto?a w kodzie BCD
Lcd Bcd(wart_bcd) ; ":" 'wy?wietlenie warto?ci godzin
'w kodzie BCD zamienionych na
'tekst oraz znaku :
Wart_bcd = Makebcd(minuty) 'zamiana warto?ci Minuty na
'warto?a BCD
Lcd Bcd(wart_bcd) ; ":" 'wy?wietlenie warto?ci minut
'w kodzie BCD zamienionych na
'tekst oraz znaku :
Wart_bcd = Makebcd(sekundy) 'zamiana warto?ci Sekundy na
'warto?a w kodzie BCD
Lcd Bcd(wart_bcd) ; 'wy?wietlenie warto?ci sekund
'w kodzie BCD zamienionych na
'tekst
Reset Nowa_w 'zerowanie flagi Nowa_w
End If
End Sub 'koniec procedury

Odmierz_1s: 'podprogramu obs3ugi przerwania
'przepe3nienia od Timer1
Counter1 = Counter1 + 34286 'wpisanie warto?ci pocz1tkowej
'licznika
Incr Sekundy 'zwiekszenie o 1 warto?ci
'Sekundy
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
If Sekundy = 60 Then 'je?li Sekundy = 60, to
Sekundy = 0 'wyzerowanie warto?ci Sekundy
Incr Minuty 'zwiekszenie o 1 warto?ci Minuty
If Minuty = 60 Then 'je?li Minuty = 60, to
Minuty = 0 'zerowanie warto?ci Minuty
Incr Godziny 'zwiekszenie o 1 warto?ci
'Godziny
If Godziny = 24 Then 'je?li Godziny = 24, to
Godziny = 0 'zerowanie warto?ci Godziny
End If 'koniec warunków
End If
End If
Return
[/syntax]

Mojego autorstwa jakiś sterownik (uwaga to były początki) xD

[syntax=basic4gl]
$regfile = "m8def.dat"
$crystal = 8000000

Config Lcd = 16 * 2

Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Portc.3 , Db5 = Portc.2 , Db6 = Portc.1 , Db7 = Portc.0 , E = Portc.4 , Rs = Portc.5

Config Portd = Input
Portd = &B11111111
Config Portb = Output
Portb = &B11111111
Set Portd.1
Set Portd.2
Set Portd.3
Set Portd.4
S1 Alias Pind.1
S2 Alias Pind.2
S3 Alias Pind.3
S4 Alias Pind.4

Opto1 Alias Pinb.1
Opto2 Alias Pinb.2 ' termometr ds18b20

Config 1wire = Portd.0 ' termometr ds18b20

Dim Msb As Byte
Dim Lsb As Byte
Dim Calk As Byte
Dim Ulam As Byte

Config Timer1 = Timer , Prescale = 256
'konfiguracja Timer1 jako timer
'z podzia3em preskalera przez
'256

Declare Sub Wysw_czas 'procedura wy?wietlaj1ca czas na
'LCD w formacie gg:mm:ss
On Timer1 Odmierz_1s 'przerwanie od przepe3nienia
'Timer1 o etykiecie Odmierz_1s

Dim Sekundy As Byte 'zmienna zliczaj1ca sekundy
Dim Minuty As Byte 'zmienna zliczaj1ca minuty
Dim Godziny As Byte 'zmienna zliczaj1ca godziny
Dim Nowa_w As Bit 'flaga zezwolenia aktualizacji
'czasu na LCD
Dim Wart_bcd As Byte 'zmienna pomocnicza, w której
'jest zapisywana warto?a BCD
'czasu

Enable Interrupts 'odblokowanie globalnego systemu
'przerwan
Enable Timer1 'odblokowanie przerwania od
'przepe3nienia Timer1
Counter1 = 34286 'warto?a pocz1tkowa wpisywana do
'Timer1 (65536 - 31250 = 34286)

Set Nowa_w 'zezwolenie na wy?wietlenie
'aktualnego czasu 'rezystora podci1gaj1cego

Deflcdchar 1 , 32 , 32 , 4 , 14 , 31 , 31 , 32 , 32
Deflcdchar 2 , 32 , 32 , 31 , 31 , 14 , 4 , 32 , 32
Deflcdchar 0 , 6 , 9 , 6 , 32 , 32 , 32 , 32 , 32

Cursor Off
Cls
Locate 1 , 3
Lcd "KONFIGORACJA"
Locate 2 , 6
Lcd "ZEGARKA"
Wait 1
Cls

'--------------------------------------------------------------------------------------
Do
If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If

Cursor Off 'petla g3ówna programu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlaj1cej aktualny czas

If S2 = 0 Then 'je?li przyci?niety S1, to
Waitms 25 'opó?nienie dla eliminacji drgan
'styków
If S2 = 0 Then 'sprawdzenie, czy przycisk S1
'dalej naci?niety, je?li tak, to
Incr Minuty 'zwiekszenie warto?ci minut
Sekundy = 0 'wyzerowanie zmiennej Sekundy
If Minuty = 60 Then 'je?li warto?a Minuty = 60, to
Minuty = 0 'zerowanie warto?ci Minuty
End If
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlenia aktualnego czasu
Waitms 200 'opó?nienie 200 ms
End If 'koniec instrukcji warunkowej
End If
If S3 = 0 Then 'je?li przyci?niety S2, to
Waitms 25 'opó?nienie dla eliminacji drgan
'styków
If S3 = 0 Then 'sprawdzenie czy przycisk S2
'dalej naci?niety, je?li tak, to
Incr Godziny 'zwiekszenie warto?ci Godziny
If Godziny = 24 Then 'je?li warto?a Godziny = 24, to
Godziny = 0 'wyzerowanie warto?ci Godziny
End If
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
Call Wysw_czas 'wywo3anie procedury
'wy?wietlenia aktualnego czasu
Waitms 200 'opó?nienie 200 ms
End If 'koniec instrukcji warunkowej
End If
Loop
End 'koniec programu

Sub Wysw_czas 'procedura wy?wietlaj1ca czas
If Nowa_w = 1 Then 'je?li flaga Nowa_w = 1, to
Cls 'czyszczenie LCD
Wart_bcd = Makebcd(godziny) 'zamiana warto?ci Godziny na
'warto?a w kodzie BCD
Lcd Bcd(wart_bcd) ; ":" 'wy?wietlenie warto?ci godzin
'w kodzie BCD zamienionych na
'tekst oraz znaku :
Wart_bcd = Makebcd(minuty) 'zamiana warto?ci Minuty na
'warto?a BCD
Lcd Bcd(wart_bcd) ; ":" 'wy?wietlenie warto?ci minut
'w kodzie BCD zamienionych na
'tekst oraz znaku :
Wart_bcd = Makebcd(sekundy) 'zamiana warto?ci Sekundy na
'warto?a w kodzie BCD
Lcd Bcd(wart_bcd) ; 'wy?wietlenie warto?ci sekund
'w kodzie BCD zamienionych na
'tekst
Reset Nowa_w 'zerowanie flagi Nowa_w
End If
End Sub 'koniec procedury

Odmierz_1s: 'podprogramu obs3ugi przerwania
'przepe3nienia od Timer1
Counter1 = Counter1 + 34286 'wpisanie warto?ci pocz1tkowej
'licznika
Incr Sekundy 'zwiekszenie o 1 warto?ci
'Sekundy
Set Nowa_w 'zezwolenie na wy?wietlenie
'czasu
If Sekundy = 60 Then 'je?li Sekundy = 60, to
Sekundy = 0 'wyzerowanie warto?ci Sekundy
Incr Minuty 'zwiekszenie o 1 warto?ci Minuty
If Minuty = 60 Then 'je?li Minuty = 60, to
Minuty = 0 'zerowanie warto?ci Minuty
Incr Godziny 'zwiekszenie o 1 warto?ci
'Godziny
If Godziny = 24 Then 'je?li Godziny = 24, to
Godziny = 0 'zerowanie warto?ci Godziny
End If 'koniec warunków
End If
End If
Return

'---------------------------------------------------------------------------
Menu:
Cursor Off
Cls
Do
Locate 1 , 7
Lcd "MENU"
Locate 2 , 5
Lcd Chr(2)
Locate 2 , 12
Lcd Chr(1)
Wait 1

If S2 = 0 Then
Waitms 100
If S2 = 0 Then
Goto Zegarek
End If
End If

If S3 = 0 Then
Waitms 100
If S3 = 0 Then
Goto Termometr
End If
End If
Loop

'------------------------------------------------------------------------------------------
Termometr:
Cursor Off
Cls
Do
Locate 1 , 5
Lcd "TERMOMETR"
Locate 2 , 2
Lcd "OK to continue"
Wait 1
If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Goto Temperatura
End If
End If

If S2 = 0 Then
Waitms 100
If S2 = 0 Then
Goto Sterownik
End If
End If

If S3 = 0 Then
Waitms 100
If S3 = 0 Then
Goto Zegarek
End If
End If

If S1 = 0 Then
If S1 = 0 Then
Goto Menu
End If
End If
Loop
'------------------------------------------------------------------------------------
Temperatura:
Do
Waitms 300
1wreset
1wwrite &HCC
1wwrite &H44
Waitms 750

1wreset
1wwrite &HCC
1wwrite &HBE

Lsb = 1wread(1)
Msb = 1wread(1)
Ulam = Lsb And 15

Shift Lsb , Right , 4
Lsb = Lsb And 15

Shift Msb , Left , 4
Msb = Msb And 240

Calk = Msb + Lsb

Ulam = Lookup(ulam , Tablica)

Cls
Locate 1 , 3
Lcd "Temperatura:"
Locate 2 , 6
Lcd Calk ; "." ; Ulam ; Chr(0) ; "C"

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If
Loop

Tablica:
Data 0 , 1 , 1 , 2 , 3 , 3 , 4 , 4 , 5 , 6 , 6 , 7 , 8 , 8 , 9 , 9
'-----------------------------------------------------------------------------------------
Sterownik:
Cursor Off
Cls
Do
Locate 1 , 5
Lcd "STEROWNIK"
Locate 2 , 2
Lcd "OK to continue"
Wait 1
If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Goto Wlwyl
End If
End If

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If

If S2 = 0 Then
Waitms 100
If S2 = 0 Then
Goto Zegarek
End If
End If

If S3 = 0 Then
Waitms 100
If S3 = 0 Then
Goto Termometr
End If
End If
Loop
'-----------------------------------------------------------------------------

Wlwyl:
Cursor Off
Cls
Do
Locate 1 , 6
Lcd "WL/WYL"
Locate 2 , 2
Lcd "OK to continue"
Wait 1

If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Goto Optotriak1
End If
End If

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If

Loop
'------------------------------------------------------------------------------

Optotriak1:
Cursor Off
Cls
Do
Locate 1 , 7
Lcd "OPTO1"
Locate 2 , 2
Lcd "OK to continue"
Wait 1

If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Cls
Locate 1 , 7
Lcd "OPTO1"
Locate 2 , 6
Lcd "WL/WYL"
Waitms 500
Toggle Opto1
End If
End If

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Sterownik
End If
End If

If S2 = 0 Then
Waitms 100
If S2 = 0 Then
Goto Optotriak2
End If
End If
Loop
'------------------------------------------------------------------------------

Optotriak2:
Cursor Off
Cls
Do
Locate 1 , 7
Lcd "OPTO2"
Locate 2 , 2
Lcd "OK to continue"
Wait 1

If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Cls
Locate 1 , 7
Lcd "OPTO2"
Locate 2 , 6
Lcd "WL/WYL"
Waitms 500
Toggle Opto2
End If
End If

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Sterownik
End If
End If

If S3 = 0 Then
Waitms 100
If S3 = 0 Then
Goto Optotriak1
End If
End If

Loop
'-------------------------------------------------------------------------------
Zegarek:
Cursor Off
Cls
Do
Locate 1 , 6
Lcd "ZEGAREK"
Locate 2 , 2
Lcd "OK to continue"
Wait 1

If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If

If S4 = 0 Then
Waitms 100
If S4 = 0 Then
Goto Czas
End If
End If

If S2 = 0 Then
Waitms 100
If S2 = 0 Then
Goto Sterownik
End If
End If

If S3 = 0 Then
Waitms 100
If S3 = 0 Then
Goto Termometr
End If
End If

Loop
'--------------------------------------------------------------------------------

Czas:

Do
Call Wysw_czas
Wait 1
If S1 = 0 Then
Waitms 100
If S1 = 0 Then
Goto Menu
End If
End If

Loop
'----------------------------
[/syntax]

aha i sorry za brak komentarzy (teraz się dowiesz jak bardzo są one ważne)...

Statystyki: Napisane przez kierlan — 25 paź 2012, o 22:42

Re: Zadanie z bascoma

2012-10-24T19:40:54+01:00

Kolejna fotka .

Statystyki: Napisane przez foreste — 24 paź 2012, o 19:40

Re: Zadanie z bascoma

2012-10-24T19:14:31+01:00

heheeh No już nie chciałem marudzić z " kot-em "

Statystyki: Napisane przez SunRiver — 24 paź 2012, o 19:14

Re: Zadanie z bascoma

2012-10-24T18:54:44+01:00

Czyli można marudzić na ten "kot"
cls powinieneś wyrzucić z pętli bo to powoduje lub będzie powodować miganie wyniku. Można tak:
[syntax=basic4gl]if licz<10 then
lcd "0"
end if
lcd licz[/syntax]
A nie możesz się zdecydować i używać Buzer = 0, Buzer = 1
No i ten Wait 1 to kiedyś się na tobie zemści

Statystyki: Napisane przez Krauser — 24 paź 2012, o 18:54

Re: Zadanie z bascoma

2012-10-24T18:30:32+01:00

echhh... no trochę się postarałeś , ale popraw to bo niema wcięć w kodzie
czyli jest nieczytelny , 2 porób komentarze w kodzie

zapodaj też schemat podłączeń , fotkę układu filmik obrazujący działanie

zrób to porządnie

Statystyki: Napisane przez SunRiver — 24 paź 2012, o 18:30

Zadanie z bascoma

2012-10-25T22:26:28+01:00

Witam przestawiam licznik 0-99 który po wyskoczeniu 0 , 45 , 99 wydaje dźwięk 1 sekundowy
i wyświetlający wynik na ekranie lcd 2x16 hd4870 blue.
kod
[syntax=basic4gl]
`Konfiguracja procesora i częstotliwość taktowania
$regfile = "M8adef.dat"
$crystal = 1000000

` Konfiguracja lcd okładzie hd 4870 lub zgodnym
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Portc.5 , Db5 = Portc.4 , Db6 = Portc.3 , Db7 = Portc.2 , E = Portb.2 , Rs = Portb.0

`Konfiguracja portów procesora i timera
Config Portd .0 = Output
Buzer Alias Portd.0
Config Timer0 = Timer , Prescale = 1024

` Konfiguracja timera iprzerwania
On Timer0 Przerwanie
Dim Licz As Byte
Enable Interrupts
Enable Timer0
Do
Loop
End

` Zdarzenie włączenia buzera na liczbie 99
Przerwanie:
Incr Licz
If Licz > 99 Then
Licz = 0
End If

` Zdarzenie włączenia buzera na liczbie 0
If Licz = 0 Then
Buzer = 0
Wait 1
Else
Set Buzer
End If

` Zdarzenie włączenia buzera na liczbie 45
If Licz = 45 Then
Buzer = 0
Wait 1
Else
Set Buzer
End If

`Wyświetlenie licznika na lcd
Cursor Off
Cls
Lcd Licz:
Return[/syntax]

<zrobiłem ci wcięcia w 2ch ifach .... popraw to naucz się korzystać z tego dobrodziejstwa i porób komentarze w kodzie --- SunRiver>

Statystyki: Napisane przez foreste — 24 paź 2012, o 18:24

ATNEL tech-forum

Re: Zadanie z bascoma

Re: Zadanie z bascoma

Re: Zadanie z bascoma

Re: Zadanie z bascoma

Re: Zadanie z bascoma

Re: Zadanie z bascoma

Zadanie z bascoma