Среда, 07.06.2017, 12:54	Приветствую Вас Гость
cxema21.ru Главная \| Регистрация \| Вход \| RSS

BASCOM AVR - Исходники, вопросы и ответы - Страница 2 - Форум

[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]

Страница 2 из 3

Модератор форума: Advanced

Форум » Микроконтроллеры » Микроконтроллеры AVR » BASCOM AVR - Исходники, вопросы и ответы (Исходные коды, FAQ.)

BASCOM AVR - Исходники, вопросы и ответы

Advanced

Дата: Среда, 18.07.2012, 12:09 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Плавное свечение и гашение светодиода:

Code

$regfile = "m8def.dat"
$crystal = 8000000

Config Timer1 = Pwm , Pwm = 8 , Compare A Pwm = Clear Down , Compare B Pwm = Clear Down , Prescale = 1

Dim A As Byte

Do

For A = 0 To 255
Pwm1a = A
Waitms 15

For A = 255 To 0 Step -1
Pwm1a = A
Waitms 15
Next A

Loop

End

Advanced

Дата: Среда, 18.07.2012, 12:11 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Поочередное включение светодиодов:

Code

Config Portb = Output

Do

Portd.0 = 1
Waitms 500
Portd.0 = 0
Portd.1 = 1
Waitms 500
Portd.1 = 0
Portd.2 = 1
Waitms 500
Portd.2 = 0

Loop

End

Advanced

Дата: Среда, 18.07.2012, 12:12 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

"Горит не горит", нажимаем одну кнопку - светодиод светится, нажимаем другую кнопку - светодиод тушится:

Code

$regfile = "m8def.dat"
$crystal = 8000000

Config Pinb.0 = Output : Red_0 Alias Portb.0
Config Pinc.2 = Input : Кнопка_старт Alias Pinc.2
Config Pinc.3 = Input : Кнопка_стоп Alias Pinc.3

Do

If Кнопка_старт = 0 Then : Gosub Горит : End If
If Кнопка_стоп = 0 Then : Gosub Не_горит : End If

Loop

Горит:
Red_0 = 1
Goto Основная

Не_горит:
Red_0 = 0
Goto
End

Advanced

Дата: Среда, 18.07.2012, 12:14 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Полицейская сирена:

Code

$regfile = "m8def.dat"
$crystal = 1000000

Dim Frq As Word
Dim D As Word

Config Pind.0 = Output
Spkr Alias Pind.0

'----------------------------------
Do
     For Frq = 50 To 20 Step -1                    'Step -1 => Speed
        D = 51 - Frq
        Sound Spkr , D , Frq
     Next Frq
     For Frq = 20 To 50 Step 1                    'Step  1 => Speed
        D = 51 - Frq
        Sound Spkr , D , Frq
     Next Frq
Loop
'----------------------------------

'(
Do
     Sound Spkr , 420 , 60
     Sound Spkr , 620 , 40
Loop

Do
     For Frq = 1 To 80
        Set Portd.0
        Waitms 3
        Reset Portd.0
        Waitms 3
     Next Frq
     Waitms 500
Loop
')

End

Advanced

Дата: Среда, 18.07.2012, 12:14 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Мигание одного светодиода:

Code

$regfile = "m8def.dat"
$crystal = 8000000

Config Pinc.0 = Output
Led Alias Pinc.0

Do
Led = 1
Waitms 20
Led = 0
Waitms 70
Loop

End

Advanced

Дата: Среда, 18.07.2012, 12:15 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

При нажатии на кнопку на пульте (RC5) на ЖКИ дисплее (1602) проезжает паравозик:

Code

$regfile = "m8def.dat"
$crystal = 8000000
$lib "lcd4.lbx"
Config Rc5 = Pinc.0 : Enable Interrupts
Config Lcdpin = Pin , Rs = Portb.0 , E = Portb.2 , Db4 = Portb.4 , Db5 = Portb.5 , Db6 = Portb.6 , Db7 = Portb.7
Config Lcd = 16 * 2 : Cursor Off

Dim Address As Byte , Command As Byte
Deflcdchar 1 , 28 , 4 , 20 , 7 , 16 , 4 , 27 , 4
Deflcdchar 2 , 4 , 24 , 24 , 30 , 17 , 5 , 26 , 4

Cls : Lcd Chr(1) ; Chr(2)

Do
Getrc5(address , Command)
If Address < 255 Then
Command = Command And &B01111111
If Command = 22 Then Shiftlcd Right
If Command = 21 Then Shiftlcd Left
Waitms 100
Locate 2 , 1
Lcd "    "
Locate 2 , 1
Lcd Command
If Command = 12 Then
Display Off
Powerdown
End If
End If
Loop
End

Advanced

Дата: Среда, 18.07.2012, 12:20 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Работы с ИК датчиком TSOP:

Code

$regfile = "m8def.dat" 'используем Mega8
$crystal = 16000000 'частота кварцевого резонатора 16mHz

'Генерация частоты 36kHz
'Настраиваем Timer1

Config Timer1 = Counter , Edge = Rising , Prescale = 8 , Compare A = Toggle

' Расчитываем Compare1a
' тактовая частота (kHz) / частота TSOPa (kHz) / 2 = Compare
' 16000 / 36 / 2 = 222

Compare1a = 222

'PortB.1 - выход сигнала
'PinC.0 - считываем состояние TSOPa
'Portd.0 - сигнальный светодиод

Config Pinb.1 = Output
Config Portd.0 = Output
Config Pinc.0 = Input

Start Timer1
Do
If Pinc.0 = 0 Then
Portd.0 = 1
Else
Portd.0 = 0
End If
Loop

End

Advanced

Дата: Среда, 18.07.2012, 12:47 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Подключаем LCD L2F50 от Siemens S65 к 16меге (в bascom надо прдключить библиотеку, библиотеки подключаются командой $lib)

Code

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

$lib "LCD-EPSON_L2F50.LBX"

Config Graphlcd = Color , Controlport = Portc , Cs = 5 , Rs = 3 , Scl = 6 , Sda = 7 , Reset = 4

Const Blue = &B00000011                    ''predefined contants are making programming easier
Const Yellow = &B11111100
Const Red = &B11100000
Const Green = &B00011100
Const Black = &B00000000
Const White = &B11111111
Const Brightgreen = &B00111110
Const Darkgreen = &B00010100
Const Darkred = &B10100000
Const Darkblue = &B00000010
Const Brightblue = &B00011111
Const Orange = &B11111000
Const Violett = 199
Const Brown = 192                    '128

'Const Blue = 51                    '&B00000011
'Const Yellow = 215                    '&B11001111 '11111100
'Const Red = 210                    '&B11100000
'Const Green = 69                    '&B00011100
'Const Black = 0                    '&B00000000
'Const White = 255                    '&B1111111111111111
'Const Brightgreen = 15                    '&B00111110
'Const Darkgreen = 12                    '&B00010100
'Const Darkred = 200                    '&B10100000
'Const Darkblue = 48                    '&B00000010
'Const Brightblue = 55                    '&B00011111
'Const Orange = 212                    '&B11111000
'Const Violett = 176
'Const Brown = 128

$include "color8x8wRus.font"
$include "color16x16wRus.font"

Advanced

Дата: Среда, 18.07.2012, 12:52 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Меню для дисплея 128х64:

Code

$regfile = "m64def.dat"                    'заголовочный файл для определения типа контроллера
$crystal = 1000000
$lib "glcdks108.lib"
$sim

Config Graphlcd = 128 * 64sed , Dataport = Portb , Controlport = Portc , Ce = 4 , Ce2 = 5 , Cd = 0 , Rd = 1 , Enable = 2 , Reset = 3

Dim A As Integer

On Int4 Up                    'кнопка "UP"
On Int5 Down                    'кнопка "DOWN"
On Int6 Ok                    'кнопка "OK"
On Int7 Esc                    'кнопка "ESC"

Enable Interrupts
Enable Int4
Enable Int5
Enable Int6
Enable Int7

A = 10                    'присваиваем переменной значение
Cls

Do                    'главный цикл програамы. постоянно проверяем значение переменной А

Select Case A                    'проверили значение переменной

Case 10 : Gosub 10                    'свалили на выполнение подпрограммы
Case 20 : Gosub 20
Case 30 : Gosub 30
Case 11 : Gosub 11
Case 12 : Gosub 12
Case 13 : Gosub 13
Case 21 : Gosub 21
Case 22 : Gosub 22
Case 23 : Gosub 23
Case 31 : Gosub 31
Case 32 : Gosub 32
Case 33 : Gosub 33
Case 110 : Gosub 110
Case 120 : Gosub 120
Case 130 : Gosub 130
Case 210 : Gosub 210
Case 220 : Gosub 220
Case 230 : Gosub 230
Case 310 : Gosub 310
Case 320 : Gosub 320
Case 330 : Gosub 330

End Select

Waitms 500

Loop

Ok:                    'обработка нажатия кнопки "OK"

If A = 11 Or A = 12 Or A = 13 Then
     A = A * 10
End If

If A = 21 Or A = 22 Or A = 23 Then
     A = A * 10
End If

If A = 31 Or A = 32 Or A = 33 Then
     A = A * 10
End If

If A = 10 Or A = 20 Or A = 30 Then
Incr A
End If

Return

Esc:                    'обработка нажатия кнопки "ESC"

If A = 11 Or A = 12 Or A = 13 Then
    A = 10
End If

If A = 21 Or A = 22 Or A = 23 Then
    A = 20
End If

If A = 31 Or A = 32 Or A = 33 Then
    A = 30
End If

If A > 100 Then
    A = A / 10
End If
Return

Down:                    'обработка нажатия кнопки "DOWN"

If A = 10 Or A = 20 Then
     A = A + 10
End If

If A = 11 Or A = 12 Then
     Incr A
End If

If A = 21 Or A = 22 Then
     Incr A
End If

If A = 31 Or A = 32 Then
     Incr A
End If

Return

Up:                    'обработка нажатия кнопки "UP"

If A = 20 Or A = 30 Then
    A = A - 10
End If

If A = 12 Or A = 13 Then
     Decr A

End If

If A = 22 Or A = 23 Then
     Decr A

End If

If A = 32 Or A = 33 Then
     Decr A
End If

Return

End

10:
Setfont Font8x8
Lcdat 1 , 1 , "   PRIMER   "
Do
Lcdat 3 , 1 , "LABEL 1" , 1
Lcdat 4 , 1 , "LABEL 2"
Lcdat 5 , 1 , "LABEL 3"
Loop
Return

20:
Setfont Font8x8
Lcdat 1 , 1 , "   PRIMER   "
Do
Lcdat 3 , 1 , "LABEL 1"
Lcdat 4 , 1 , "LABEL 2" , 1
Lcdat 5 , 1 , "LABEL 3"
Loop
Return

30:
Setfont Font8x8
Lcdat 1 , 1 , "   PRIMER   "
Do
Lcdat 3 , 1 , "LABEL 1"
Lcdat 4 , 1 , "LABEL 2"
Lcdat 5 , 1 , "LABEL 3" , 1
Loop
Return

$include "font8x8.font"

Advanced

Дата: Среда, 18.07.2012, 12:56 | Сообщение #

Подполковник

Группа: Модераторы

Сообщений: 138

Репутация: 0

Статус: Offline

Меню для LCD16x2 - кусок кода:

Code

Deflcdchar 0 , 16 , 24 , 28 , 30 , 28 , 24 , 16 , 32        'указатель курсора
Deflcdchar 5 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32        'очистить знакоместо

'НАЗНАЧЕНИЕ КНОПОК КЛАВИАТУРЫ
Cv Alias Pina.0                    'КНОПКА КУРСОР ВЕРХ
Cn Alias Pina.1                    'КНОПКА КУРСОР ВНИЗ
M Alias Pind.3                    'КНОПКА ВВОД

'меню
Cls
Locate 1 , 1
Lcd "******MENU******"
Locate 2 , 2
Lcd "Run"
Locate 3 , 2
Lcd "Zadergka cikla"
Locate 4 , 2
Lcd "Setup"
Goto _menu_pos1

_menu_pos1:
Gosub _lcd_clear1
Locate 2 , 1
Lcd Chr(0)
Do
Debounce M , 0 , _run
Debounce Cn , 0 , _menu_pos2
Debounce Cv , 0 , _menu_pos3
Loop

_menu_pos2:
Gosub _lcd_clear1
Locate 3 , 1
Lcd Chr(0)
Do
Debounce M , 0 , _zadergka_cikla
Debounce Cn , 0 , _menu_pos3
Debounce Cv , 0 , _menu_pos1
Loop

_menu_pos3:
Gosub _lcd_clear1
Locate 4 , 1
Lcd Chr(0)
Do
Debounce M , 0 , _setup
Debounce Cn , 0 , _menu_pos1
Debounce Cv , 0 , _menu_pos2
Loop

'очистка знакоместа
_lcd_clear1:
Locate 2 , 1
Lcd Chr(5)
Locate 3 , 1
Lcd Chr(5)
Locate 4 , 1
Lcd Chr(5)
Return