Администрация форума не несёт ответственности за достоверность информации и оставляет за собой право редактировать или в особых случаях даже удалять посты без предупреждения. Спасибо за понимание.

Программирование ATMEL в BASCOM.

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » Программирование ATMEL в BASCOM. » Вопросы - ответы » недельный таймер


недельный таймер

Сообщений 1 страница 16 из 16

1

прошу помощи!!! уже мозги не соображают ... нужен таймер включения по времени и  дням недлям  , со временем работает а как сделать по дням недели ? т.е. понедельник - вкл, вторник - выкл. и т.д.
програму накидал но не работает что не так делаю?
я только учусь програмировать.....

Код:
$regfile = "m8def.dat"
$crystal = 8000000
'############################ Конфигурация_ЖКИ #################################
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db7 = Portc.2 , Db6 = Portc.5 , Db5 = Portc.3 , Db4 = Portc.4 , E = Portc.0 , Rs = Portc.1
Cursor Off
'------------------------------Порты--------------------------------------------
Config Portd = Output
Config Portb = Input
Config Portc = Output
Config Sda = Portb.7
Config Scl = Portb.6
Config Clock = User
Set Portb.2
Set Portb.3
Set Portb.4
Set Portb.5
Cn Alias Pinb.4                                             'Вниз
Cv Alias Pinb.2                                             'Вверх
Vv Alias Pinb.5                                             'Ввод
M Alias Pinb.3                                              'Меню
Uflight Alias Portd.1                                       'уф-лампа
'--------------------------------Константы--------------------------------------
Const Ds18b20_id = &H28
Const Ds1307w = &HD0                                        'бит записи
Const Ds1307r = &HD1
'---------------------------------- ПЕРЕМЕННЫЕ --------------------------------
'Общие переменные
Dim Bweekday As Byte                                        'чтение дня недели
Dim Strweekday As String * 7                                'отображение дня недели
Dim Weekday As Byte                                         'неделя
Dim J1 As Byte                                              'год
Dim M1 As Byte                                              'месяц
Dim D1 As Byte                                              'день
Dim H1 As Byte                                              'час
Dim Mi As Byte                                              'минуты
Dim Aa As Byte                                              'переменные меню
Dim Xp As Byte                                              'переменные меню
Dim Xpi As Byte                                             'переменные меню
                                          '
'Переменные для работы


Dim Uflight_on As Byte                                      'уф.лампа
Dim Uflight_off As Byte                                     'уф.лампа
Dim Ee_uflight_on As Eram Byte                              'уф.лампа
Dim Ee_uflight_off As Eram Byte                             'уф.лампа

Dim Uf As Byte                                              'уф.лампа
Dim Uf_d As Byte                                            'уф.лампа

Dim Uf1 As Byte                                             'уф.лампа
Dim Uf_1 As Byte                                            'уф.лампа
Dim Ee_uf_1 As Eram Byte                                    'уф.лампа

Dim Uf2 As Byte                                             'уф.лампа
Dim Uf_2 As Byte                                            'уф.лампа
Dim Ee_uf_2 As Eram Byte                                    'уф.лампа

Dim Uf3 As Byte                                             'уф.лампа
Dim Uf_3 As Byte                                            'уф.лампа
Dim Ee_uf_3 As Eram Byte                                    'уф.лампа

Dim Uf4 As Byte                                             'уф.лампа
Dim Uf_4 As Byte                                            'уф.лампа
Dim Ee_uf_4 As Eram Byte                                    'уф.лампа

Dim Uf5 As Byte                                             'уф.лампа
Dim Uf_5 As Byte                                            'уф.лампа
Dim Ee_uf_5 As Eram Byte                                    'уф.лампа

Dim Uf6 As Byte                                             'уф.лампа
Dim Uf_6 As Byte                                            'уф.лампа
Dim Ee_uf_6 As Eram Byte                                    'уф.лампа

Dim Uf7 As Byte                                             'уф.лампа
Dim Uf_7 As Byte                                            'уф.лампа
Dim Ee_uf_7 As Eram Byte                                    'уф.лампа



'-------------------------- Декларирование подпрограмм ------------------------

Declare Sub Enterdatetime()                                 ' чтение ds1307
Declare Sub Getkey()                                        ' кнопки
Declare Sub Menu()                                          ' меню
Declare Sub Uf_set                                          ' уф.лампа

'-------------------------- символы---------------------------------------------
Deflcdchar 0 , 7 , 5 , 7 , 32 , 32 , 32 , 32 , 32           'градус
Deflcdchar 1 , 30 , 10 , 26 , 10 , 26 , 10 , 27 , 31        'нагрев
Deflcdchar 2 , 31 , 27 , 10 , 11 , 10 , 11 , 10 , 15        'охлаждение
Deflcdchar 3 , 32 , 4 , 21 , 14 , 27 , 14 , 21 , 4          'Солнышко
Deflcdchar 4 , 8 , 6 , 3 , 3 , 3 , 3 , 6 , 8                'Луна
Deflcdchar 6 , 10 , 17 , 4 , 17 , 4 , 21 , 21 , 4           'кормушка
Deflcdchar 7 , 32 , 8 , 5 , 14 , 20 , 2 , 32 , 32           'фильтр
Deflcdchar 5 , 32 , 2 , 26 , 4 , 11 , 8 , 32 , 32           'фильтр

'------------------------------ НАЧАЛО РАБОТЫ -------------------------------



'##################### Основной цикл программы #################################
Do
  Locate 1 , 1
 Lcd Time$ ; "."                                            'вывод часов

Bweekday = Dayofweek()
Strweekday = Lookupstr(bweekday , Weekdays)
Locate 2 , 1
Lcd Strweekday

 If M = 0 Then                                              'кнопка входа в меню
   Menu
   End If



   Gosub Uf_set

  Loop
End
'************************************ Дни недели *******************************
Weekdays:
Data "ЁoЅ."                                                 'Понед.
Data "Bїp."                                                 'Вторник
Data "Cpг."                                                 'Среда
Data "«eї."                                                 'Четверг
Data "ЁЗї."                                                 'Пятница
Data "CyІ."                                                 'Суббота
Data "Boc."                                                 'Воскр.
'##################### Чтение/запись времени в RTC #############################
Getdatetime:
 I2cstart                                                   ' Generate start code
  I2cwbyte Ds1307w                                          ' send address
  I2cwbyte 0                                                ' start address in 1307
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1307r                                          ' send address
  I2crbyte _sec , Ack
  I2crbyte _min , Ack                                       ' MINUTES
  I2crbyte _hour , Ack                                      ' Hours
  I2crbyte Weekday , Ack                                    ' Day of Week
  I2crbyte _day , Ack                                       ' Day of Month
  I2crbyte _month , Ack                                     ' Month of Year
  I2crbyte _year , Nack                                     ' Year
  I2cstop
  _sec = Makedec(_sec) : _min = Makedec(_min) : _hour = Makedec(_hour)
  _day = Makedec(_day) : _month = Makedec(_month) : _year = Makedec(_year)
Return
Setdate:
  _day = Makebcd(_day) : _month = Makebcd(_month) : _year = Makebcd(_year)
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1307w                                          ' send address
  I2cwbyte 4                                                ' starting address in 1307
  I2cwbyte _day                                             ' Send Data to SECONDS
  I2cwbyte _month                                           ' MINUTES
  I2cwbyte _year                                            ' Hours
  I2cstop
Return
Settime:
  _sec = Makebcd(_sec) : _min = Makebcd(_min) : _hour = Makebcd(_hour)
  I2cstart                                                  ' Generate start code
  I2cwbyte Ds1307w                                          ' send address
  I2cwbyte 0                                                ' starting address in 1307
  I2cwbyte _sec                                             ' Send Data to SECONDS
  I2cwbyte _min                                             ' MINUTES
  I2cwbyte _hour                                            ' Hours
  I2cstop
  Return

 '########################### Меню ввода данных #################################
'_______________________________Установка часов_________________________________
Sub Enterdatetime
Cls
   Aa = 0
   Xp = _hour
Do
   If Xp > 23 Then Xp = 0
   If Xp < 0 Then Xp = 23
   Locate 1 , 1
   Lcd "©cїaЅoієa Аacoі"
   Locate 2 , 1
   Lcd "Аac:" ; Xp
   Getkey
   H1 = Xp
Loop Until Aa = 1
'--------------------------------Установка минут--------------------------------
   Aa = 0
   Xp = _min
   Do
   If Xp > 59 Then Xp = 0
   If Xp < 0 Then Xp = 59
   Locate 1 , 1
   Lcd "©cїaЅoієa Аacoі"
   Locate 2 , 8
   Lcd "јёЅ:" ; Xp
   Getkey
   Mi = Xp
   Loop Until Aa = 1
   _hour = H1
   _min = Mi
   _sec = 0
   Gosub Settime
'--------------------------------Установка дня--------------------------------
   Cls
   Aa = 0
   Xp = _day
   Do
   If Xp > 31 Then Xp = 1
   If Xp < 1 Then Xp = 31
   Locate 1 , 1
   Lcd "аeЅД."
   Locate 2 , 5
   Lcd ; Xp
   Getkey
   D1 = Xp
   Loop Until Aa = 1
'--------------------------------Установка месяц--------------------------------
   Aa = 0
   Xp = _month
   Do
   If Xp > 12 Then Xp = 03
   If Xp < 01 Then Xp = 12
   Locate 1 , 7
   Lcd "јec."
   Locate 2 , 7
   Lcd  ":"; Xp
   Getkey
   M1 = Xp
   Loop Until Aa = 1
'--------------------------------Установка года--------------------------------
   Aa = 0
   Xp = _year
   Do
   If Xp > 50 Then Xp = 13
   If Xp < 13 Then Xp = 50
   Locate 1 , 12
   Lcd "ґoг."
   Locate 2 , 10
   Lcd ":" ; Xp
   Getkey
   J1 = Xp
   Loop Until Aa = 1
   _year = J1
   _month = M1
   _day = D1
Gosub Setdate
 '--------------------- Утановка работы уф.лампа (ON) --------------------------
Cls
   Aa = 0
   Xp = Ee_uflight_on
   Do
   If Xp > 23 Then Xp = 0
   If Xp < 0 Then Xp = 23
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 1
   Lcd "Bє»:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uflight_on = Xp
   Aa = 0
   Xp = Ee_uflight_off
   Do
   If Xp > 23 Then Xp = 0
   If Xp < 0 Then Xp = 23
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 9
   Lcd "BГє»:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uflight_off = Xp
'--------------------

   Cls
   Aa = 0
   Xp = Ee_uf_1
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "ЁoЅeгe»ДЅёє:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_1 = Xp
   Cls
  Aa = 0
   Xp = Ee_uf_2
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "BїopЅёє:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_2 = Xp
   Cls
  Aa = 0
   Xp = Ee_uf_3
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "Cpeгa:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_3 = Xp
   Cls
   Aa = 0
   Xp = Ee_uf_4
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "«eїіepґ:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_4 = Xp
     Cls
   Aa = 0
   Xp = Ee_uf_5
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "ЁЗїЅёеa:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_5 = Xp
    Cls
   Aa = 0
   Xp = Ee_uf_6
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "CyІІoїa:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_6 = Xp
    Cls
   Aa = 0
   Xp = Ee_uf_7
   Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 2
   Lcd "©Є-»aјѕa"
   Locate 2 , 2
   Lcd "BocєpeceЅДe:" ; Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_7 = Xp



      End Sub
   '######################### Меню опроса кнопок ##################################
Sub Getkey()
   Waitms 500
   If Cv = 0 Then Incr Xp
   If Cn = 0 Then Decr Xp
   If Vv = 0 Then
   Aa = 1
   Else
   Aa = 0
   End If
End Sub
'-------------------------------------------------------------------------------
Sub Menu()
Aa = 0
Xp = 0
Getkey
Enterdatetime
Cls
Locate 1 , 6
Lcd "OK!"
Waitms 500
 Cls
   End Sub
   Return


 '######################## Условие работы уф.лампы ##############################
Sub Uf_set


    Uf_1 = 1
    Uf_2 = 2
    Uf_3 = 3
    Uf_4 = 4
    Uf_5 = 5
    Uf_6 = 6
    Uf_7 = 7
    Uf2 = Ee_uf_1
    Uf3 = Ee_uf_2
    Uf4 = Ee_uf_3
    Uf5 = Ee_uf_4
    Uf6 = Ee_uf_5
    Uf7 = Ee_uf_6
    Uf1 = Ee_uf_7


    If Weekday = 1 Then Uf = Uf1

    If Weekday = 2 Then Uf = Uf2

    If Weekday = 3 Then Uf = Uf3

    If Weekday = 4 Then Uf = Uf4

    If Weekday = 5 Then Uf = Uf5

    If Weekday = 6 Then Uf = Uf6

    If Weekday = 7 Then Uf = Uf7



    Uflight_on = Ee_uflight_on                              ' читаем время включения с ЕЕПРОМ
    Uflight_off = Ee_uflight_off                            ' читаем время выключения с ЕЕПРОМ
If Uf = 1 Then
    Uflight = 1
    Locate 2 , 6
    Lcd "*"

 If Uf = 0 Then
   Uflight = 0

     Locate 2 , 6
    Lcd "."


   End If
   End If



        End Sub

0

2

У DS1307 есть номер дня недели, от него и пляши

0

3

его и задействую ,Weekday,  но нехочет работать, то есть работает только последняя строчка   If Weekday = 7 Then Uf = Uf7 а на первую  строку не переходит

0

4

Насколько знаю, Dayofweek() возвращает так: 0=понедельник ... 6=воскресенье.

0

5

с таймером разобрался  а как изменить в меню цифры на буквы, т.е " 1 " на " Y " а "0" на " n " ?

0

6

Подробней можно? Нужна часть кода, где нужно заменить.

0

7

Код:
'--------------------- Утановка работы уф.лампа  --------------------------
Cls
Aa = 0
   Xp = Ee_uf_on
Do
   If Xp > 23 Then Xp = 0
   If Xp < 0 Then Xp = 23
   Locate 1 , 3
   Lcd "©Є: Bє»-BГє»"
   Locate 2 , 6
   Lcd Xp ; " :"
   Getkey
   Loop Until Aa = 1
   Ee_uf_on = Xp
Aa = 0
   Xp = Ee_uf_off
Do
   If Xp > 23 Then Xp = 0
   If Xp < 0 Then Xp = 23
   Locate 2 , 11
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_off = Xp
'--------------------
   Cls
Aa = 0
   Xp = Ee_uf_2
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 1 , 1
   Lcd "©Є:Ё/B/C/«/Ё/C/B"
   Locate 2 , 4
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_2 = Xp
Aa = 0
   Xp = Ee_uf_3
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 6
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_3 = Xp
Aa = 0
   Xp = Ee_uf_4
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 8
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_4 = Xp
Aa = 0
   Xp = Ee_uf_5
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 10
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_5 = Xp
Aa = 0
   Xp = Ee_uf_6
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 12
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_6 = Xp
Aa = 0
   Xp = Ee_uf_7
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 14
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_7 = Xp
Aa = 0
   Xp = Ee_uf_1
Do
   If Xp > 1 Then Xp = 0
   If Xp < 0 Then Xp = 1
   Locate 2 , 16
   Lcd Xp
   Getkey
   Loop Until Aa = 1
   Ee_uf_1 = Xp

часть из основного меню ХР =0 или 1 которые надо изменить,

0

8

Как-то так:

Код:
Dim Str As String * 1

If Xp = 0 Then
Str = " n "
else
Str = " Y "
End If

0

9

ругается на  Dim Str As String * 1 и Str = " n "

0

10

Сделай:

Код:
Dim Str As String * 3

Не учел пробелы по краям.

0

11

http://s7.uploads.ru/t/wHVav.png

всеравно ругается

0

12

Код:
Dim Str_1 As String * 3

0

13

спасибо работает , но как его минизировать чтоб не дублировать в каждую строку, памяти жрет много

0

14

Можно оформить в виде процедуры и вызывать по необходимости.

0

15

сделал отдельной подпрограммой gosub и все поместилось.
спасибо за помощь.
таймер работает без глюков.

0

16

Не за что.

0


Вы здесь » Программирование ATMEL в BASCOM. » Вопросы - ответы » недельный таймер