f
Note
What’s new and when was the last update of this page?
November 25 2014:
Added Colorpicker
Added WordClock
'*******************************************************************************
'
'Copyright Michael Koecher aka six1 8/2010
'-> https://www.six1.net/ michael@koecher-web.de
'
'https://creativecommons.org/licenses/by-sa/3.0/de/
'Original nur von https://bascom-forum.de
'Sie darfen:
'
'* das Werk bzw. den Inhalt vervielfaltigen, verbreiten und offentlich zugänglich machen
'
'* Abwandlungen und Bearbeitungen des Werkes bzw. Inhaltes anfertigen
'
'Zu Den Folgenden Bedingungen:
'
'* Namensnennung.
'Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
'
'* Keine kommerzielle Nutzung.
'Dieses Werk darf nicht fur kommerzielle Zwecke verwendet werden.
'
'* Weitergabe unter gleichen Bedingungen.
'Wenn Sie das lizenzierte Werk bzw. den lizenzierten Inhalt bearbeiten
'oder in anderer Weise erkennbar als Grundlage fur eigenes Schaffen verwenden,
'darfen Sie die daraufhin neu entstandenen Werke bzw. Inhalte nur
'unter Verwendung von Lizenzbedingungen weitergeben, die mit denen
'dieses Lizenzvertrages identisch oder vergleichbar sind.
'
'Wobei gilt:
'
'* Verzichtserklärung
'Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie
'die ausdrückliche Einwilligung des Rechteinhabers dazu erhalten.
'
'* Sonstige Rechte
'Die Lizenz hat keinerlei Einfluss auf die folgenden Rechte:
'- Die gesetzlichen Schranken des Urheberrechts und sonstigen
'Befugnisse zur privaten Nutzung
'- Das Urheberpersonlichkeitsrecht des Rechteinhabers
'- Rechte anderer Personen, entweder am Lizenzgegenstand selber oder
'bezaglich seiner Verwendung, zum Beispiel Personlichkeitsrechte abgebildeter Personen.
'
'Hinweis
'
'Im Falle einer Verbreitung müssen Sie anderen alle Lizenzbedingungen
'mitteilen, die fur dieses Werk gelten. Am einfachsten ist es,
'einen Link auf https://creativecommons.org/licenses/by-sa/3.0/de/ einzubinden.
'
'
'*******************************************************************************
'auf Treiber IC SSD1963 geandert 26.11.2011
'10.09.2012 angepast fur Display Typ AT070TN90
'Hkipnik@aol.com
'*******************************************************************************
$regfile = "xm128a1def.dat"
$hwstack = 200
$swstack = 200
$framesize = 500
$crystal = 32000000
Config Osc = Enabled , 32mhzosc = Enabled
Config Sysclock = 32mhz '--> 32MHz
'*******************************************************************************
Config Osc = Disabled , 32mhzosc = Enabled
Osc_pllctrl = &B10_0_00100
Do
Loop Until Osc_status.1 = 1 'Check if RC2MRDY is ready '
'enable PLL
Set Osc_ctrl.4 'PLL enable
'configure the systemclock
Config Sysclock = Pll , Prescalea = 1 , Prescalebc = 1_1 'use PLL
Stop Watchdog
'*******************************************************************************
'*******************************************************************************
'Touch Interrupt
'*******************************************************************************
Const Use_touch = 1 'use Touch = 1
#if Use_touch = 1
Config Pinf.0 = Input 'Set PINF.4 as Input
'Because of the activated Pullup the PIN Level is high and there is a falling edge when switch is pressed
Config Xpin = Portf.0 , Outpull = Pullup , Sense = Falling 'enable Pull up and reaction on falling edge
Portf_int0mask = &B0000_0001 'include PIN0 in INT0 Mask
Portf_intctrl = &B0000_00_01
'Low Level INT0 Interrupt
Dim Touch_flag As Bit
Touch_flag = 0
On Portf_int0 Touch_int
Enable Portf_int0 , Lo
#endif
'*******************************************************************************
Config Priority = Static , Vector = Application , Lo = Enabled , Med = Enabled
Config Com5 = 57600 , Mode = Asynchroneous , Parity = None , Stopbits = 1 , Databits = 8
Open "COM5:" For Binary As #1
Print #1 , "Graphic 800x480"
'*******************************************************************************
$include "SSD1963_declarations.inc"
$include "SSD1963__sd-card_declarations.inc"
'*******************************************************************************
Call Sdcard_initialize()
'*******************************************************************************
'use for Demo
Dim Farbe As Word, Countx As Word, Xx1 As Word, Xx2 As Word, Yy1 As Word, Yy2 As Word, Penwidth As Byte, Box_fill As Byte, Show_border As Byte, Radius As Word
Dim Help_str As String * 10
'*******************************************************************************
'Start SSD1963
'*******************************************************************************
Call Ssd1963_init()
'*******************************************************************************
Enable Interrupts
'*** MAIN **********************************************************************
Do
Call Lcd_clear(blue)
Call Lcd_text( "Clear area" , 230 , 20 , 1 , Yellow , Blue)
Call Lcd_clear_area(100 , 100 , 200 , 200 , White)
Wait 2
Call Lcd_clear_area(1 , 1 , 200 , 200 , White)
Wait 2
Call Lcd_clear(red)
Call Lcd_text( "BMP 800x480 hallo world" , 100 , 224 , 1 , Gold , Black)
Call Lcd_text( "BMP 800x480 hallo world" , 20 , 20 , 2 , Yellow , Red)
Wait 1
Call Lcd_clear(black)
Call Lcd_draw_bmp( "frau5.bmp" , 200 , 0) '24Bit
Wait 1
Call Lcd_clear(red)
Call Lcd_draw_bmp( "tieger5.bmp" , 1 , 0) '24Bit
Call Lcd_text_trans( "24Bit Bmp" , 310 , 100 , 1 , Red , Transparent)
Wait 1
Call Lcd_clear(red)
Call Lcd_draw_bmp( "tieg8bit.bmp" , 0 , 0) '8Bit
Call Lcd_text_trans( "8Bit Bmp" , 310 , 100 , 1 , Red , Transparent)
Wait 1
Call Lcd_draw_bmp( "frau5.bmp" , 200 , 0) '24Bit
Wait 1
Call Lcd_draw_bmp( "pic18bit.bmp" , 0 , 0) '8Bit
Call Lcd_text_trans( "8Bit Bmp" , 310 , 100 , 1 , Red , Transparent)
Wait 1
Call Lcd_clear(red)
Call Lcd_draw_bmp( "pic28bit.bmp" , 0 , 0) '8Bit
Call Lcd_text_trans( "8Bit Bmp" , 310 , 100 , 1 , Red , Transparent)
Wait 3
Call Lcd_negate(0)
Call Lcd_text_trans( "negate" , 310 , 200 , 1 , Red , Transparent)
Wait 3
Call Lcd_negate(1)
Wait 3
Call Lcd_clear(red)
Call Lcd_draw_bmp( "test8bit.bmp" , 0 , 0) '8Bit
Wait 1
Call Lcd_clear(blue)
#if Use_touch = 1
Call Lcd_box(700 , 420 , 790 , 470 , Red , White , 1 , 1)
Call Lcd_box(100 , 100 , 105 , 105 , Red , White , 1 , 1)
Call Lcd_text( "Touch me" , 390 , 10 , 2 , Yellow , Black)
Call Lcd_text( "next" , 720 , 435 , 2 , Yellow , Red)
Do
If Touch_flag = 1 Then
Touchx = 0
Touchy = 0
Call Lcd_read_touch()
Select Case Touchx
Case 570 To 630 :
If Touchy > 5 And Touchy < 65 Then
Ende = 1
End If
End Select
If Ende = 1 Then
Ende = 0
Exit Do
End If
Touch_flag = 0
End If
Loop
#endif
Call Lcd_clear(black)
Call Lcd_text( "LINE" , 390 , 10 , 2 , Yellow , Black)
For Countx = 1 To 100
Farbe = Rnd(10)
Xx1 = Rnd(740)
Xx2 = Rnd(740)
Yy1 = 90 + Rnd(300)
Yy2 = 90 + Rnd(300)
Penwidth = Rnd(4)
Penwidth = Rnd(4)
Call Lcd_line(xx1 , Yy1 , Xx2 , Yy2 , Penwidth , Color_array(farbe))
Next
Wait 2
Call Lcd_clear(black)
Call Lcd_text( "BOX FILL" , 390 , 10 , 2 , Yellow , Black)
For Countx = 1 To 100
Xx1 = Rnd(740)
Xx2 = Rnd(740)
Yy1 = 90 + Rnd(300)
Yy2 = 90 + Rnd(300)
Farbe = Rnd(10)
Box_fill = Rnd(100)
If Box_fill < 50 Then Box_fill = 0
Show_border = Rnd(100)
If Show_border < 70 Then Show_border = 0
Call Lcd_box(xx1 , Yy1 , Xx2 , Yy2 , Color_array(farbe) , White , Box_fill , 1)
Next
Wait 2
Call Lcd_clear(black)
Call Lcd_text( "BOX" , 390 , 10 , 2 , Yellow , Black)
For Countx = 1 To 100
Xx1 = Rnd(740)
Xx2 = Rnd(740)
Yy1 = 90 + Rnd(300)
Yy2 = 90 + Rnd(300)
Farbe = Rnd(10)
Call Lcd_box(xx1 , Yy1 , Xx2 , Yy2 , White , Color_array(farbe) , 0 , 1)
Next
Wait 2
Call Lcd_clear(black)
Call Lcd_text( "Circle" , 370 , 10 , 2 , Yellow , Black)
For Countx = 1 To 100
Xx1 = 40 + Rnd(640)
Yy1 = 20 + Rnd(400)
Radius = Rnd(50)
Farbe = Rnd(10)
Call Lcd_drawcircle(xx1 , Yy1 , Radius , 100 , 2 , Color_array(farbe))
Next
Wait 2
Call Lcd_clear(black)
Call Lcd_text( "Circle Fill" , 370 , 10 , 2 , Yellow , Black)
For Countx = 1 To 100
Xx1 = 50 + Rnd(540)
Yy1 = 80 + Rnd(300)
Radius = Rnd(50)
Farbe = Rnd(10)
Call Lcd_fill_circle(xx1 , Yy1 , Radius , Color_array(farbe))
Next
Wait 2
Call Lcd_clear(black)
Call Lcd_text( "BMP 320x240" , 330 , 10 , 2 , Yellow , Black)
Call Lcd_draw_bmp( "sylt1.bmp" , 240 , 100)
Wait 1
Call Lcd_draw_bmp( "tieger5.bmp" , 0 , 0)
Call Lcd_setscrollarea(0 , 480 , 0)
For Countx = 0 To 479
Call Lcd_scroll(countx)
Waitms 2
Next
For Countx = 479 To 0 Step -1
Call Lcd_scroll(countx)
Waitms 2
Next
Wait 2
Call Lcd_clear(black)
Loop
End
#if Use_touch = 1
Touch_int:
Touch_flag = 1
' Print #1 , "Touch"
Return
#endif
'*******************************************************************************
$include "SSD1963__sd-card_routines.inc"
$include "SSD1963_functions.inc"
$include "Font12x16.font"
$include "font25x32.font"
'I2c LCD on Arduino Nano 16x2 display with backlight
$regfile = "M328pdef.dat" ' the used chip
$crystal = 16000000 ' frequency used
$baud = 9600 ' baud rate
Declare Sub I2c_scan
Config I2cdelay = 10
$lib "i2c_twi.lib" 'hardware i2c/TWI
Config Twi = 100000
$lib "bl_Lcd_i2c.lib" ' AN #118 library from Kent
' with this addition
' * lds r27,{backlight}
' andi _temp2,&hf7
' or _temp2,r27
'LCD-display including backlight
'0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1
'1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
'G 5 C R R E D D D D D D D D B B
'N O S W 0 1 2 3 4 5 6 7 L L
'D V N S
'PCF8574
'P7 = D7
'P6 = D6
'P5 = D5
'P4 = D4
'P3 = 1 = backlight on / 0 = backlight off
'P2 = E
'P1 = RW
'P0 = RS
Const Pcf_d4 = 4
Const Pcf_d5 = 5
Const Pcf_d6 = 6
Const Pcf_d7 = 7
Const Pcf_rs = 0
Const Pcf_rw = 1
Const Pcf_e1 = 2
Dim B As Byte
Dim A As Byte
Dim _lcd_e As Byte
Dim Backlight As Byte
Backlight_on Alias &H08
Backlight_off Alias &H00
Backlight = Backlight_on
_lcd_e = 128
Const Pcf8574_lcd = &H4E 'Defines the address of the I/O expander for LCD
Config Scl = Portc.5 'we need to provide the SCL pin name
Config Sda = Portc.4
I2cinit
'Call I2c_scan 'if you want to check if the PCF8574 is seen activate this
Wait 2
cls
home
Lcd "i2c-display" 'display this at the top line
Wait 1
Lowerline 'select the lower line
Wait 1
Lcd "Shift this." 'display this at the lower line
Wait 1
For A = 1 To 10
Shiftlcd Right 'shift the text to the right
Waitms 250 'wait a moment
Next
For A = 1 To 10
Shiftlcd Left 'shift the text to the left
Waitms 250 'wait a moment
Next
Locate 2 , 1 'set cursor position
Lcd "*" 'display this
Wait 1 'wait a moment
Shiftcursor Right 'shift the cursor
Lcd "@" 'display this
Wait 1 'wait a moment
Home Upper 'select line 1 and return home
Lcd "Replaced." 'replace the text
Wait 1 'wait a moment
Cursor Off Noblink 'hide cursor
Wait 1 'wait a moment
Cursor On Blink 'show cursor
Wait 1 'wait a moment
Display Off 'turn display off
Wait 1 'wait a moment
Display On 'turn display on
'Now lets build a special character
'the first number is the characternumber (0-7)
'The other numbers are the rowvalues
'Use the LCD tool to insert this line
Deflcdchar 2 , 32 , 10 , 32 , 14 , 17 , 17 , 17 , 14 'replace ? with number (0-7)
Deflcdchar 0 , 32 , 4 , 32 , 14 , 18 , 18 , 18 , 13 'replace ? with number (0-7)
Deflcdchar 1 , 32 , 10 , 32 , 14 , 18 , 18 , 18 , 13 'replace ? with number (0-7)
_lcd_e = 128
Cls 'select data RAM
Rem it is important that a CLS is following the deflcdchar statements because it will set the controller back in datamode
Lcd Chr(0) ; Chr(1) 'print the special character
'----------------- Now use an internal routine ------------
_temp1 = 2 'value into ACC
!rCall _write_lcd 'put it on LCD
'**************************************************************************
End
Sub I2c_scan 'check all devices on the I2c-bus
Print "Scan start"
For B = 0 To 254 Step 2 'for all odd addresses
I2cstart 'send start
I2cwbyte B 'send address
If Err = 0 Then 'we got an ack
Print "Slave at : " ; B ; " hex : " ; Hex(b) ; " bin : " ; Bin(b)
End If
I2cstop 'free bus
Next
Print "End Scan"
End Sub