$nocompile
'*******************************************************************************
'* Init LCD for ST7920 Controller Serial-Mode 24.02.15/rt *
'*******************************************************************************
Sub Lcds_init(byval D_type As Byte) '1=Text / 2=Grafic
Lcds_command 3 'Init LCD with Value 3 for Command (RS=0)
Waitms 10
Lcds_command 3 'Init LCD with Value 3 for Command (RS=0)
Waitms 10
Lcds_command 3 'Init LCD with Value 3 for Command (RS=0)
Waitms 10
Lcds_command 12 'Display control
Waitms 1
Lcds_command 1 'Dislpay clear
Waitms 5
Lcds_command 6 'Entry mode
Waitms 1
Select Case D_type
Case 1
Lcds_command 36 'Set Text-Mode
Waitms 5
Lcds_command 32 'Set Text-Mode
Case 2
Lcds_command 38 'Set Grafic-Mode
Waitms 5
Lcds_command 2 'Set Grafic-Mode
End Select
End Sub
'*******************************************************************************
'* Clear Screen Command 1 = Text-Mode 2 = Grafic-Mode *
'*******************************************************************************
Sub Lcds_cls(byval D_type As Byte)
Select Case D_type
Case 1 'Clear in Text-Mode
Lcds_command 1
Zl1 = Space(20)
Zl2 = Space(20)
Zl3 = Space(20)
Zl4 = Space(20)
Waitms 100
Case 2 'Clear in Grafic-Mode
For D_pos = 0 To 1025
Ddata(d_pos) = 0
Next D_pos
Call Lcds_show()
End Select
End Sub
'*******************************************************************************
'* Hintergrundbeleuchtung EIN/AUS *
'*******************************************************************************
Sub Hbl(byval Ea As Byte)
Bl = Ea
If Ea = 0 Then Reset Lcd_hbl
If Ea = 1 Then Set Lcd_hbl
Waitms 10
End Sub
'*******************************************************************************
'* Anzeige Wert/String Zeile Y1 Position X1 *
'*******************************************************************************
Sub Lcds(byval Y1 As Byte , Byval X1 As Byte , Byval Text1 As String * 20)
If Y1 = 1 Then
Zz = Len(text1)
Mid(zl1 , X1 , Zz) = Text1
Texta = Zl1
Ch = 128 'Cursor-Position Row 1, Position 1
End If
If Y1 = 2 Then
Zz = Len(text1)
Mid(zl2 , X1 , Zz) = Text1
Texta = Zl2
Ch = 144
End If
If Y1 = 3 Then
Zz = Len(text1)
Mid(zl3 , X1 , Zz) = Text1
Texta = Zl3
Ch = 136
End If
If Y1 = 4 Then
Zz = Len(text1)
Mid(zl4 , X1 , Zz) = Text1
Texta = Zl4 'Cursor-Position Row 4, Position 1
Ch = 152
End If
Lcds_command Ch 'Set Cursor-Position
For Zi = 1 To zz
Cx = Mid(texta , Zi , 1)
Ch = Cx
Lcds_data Ch
Next Zi
End Sub
lcds_out:
Ch = Pos
Set Ch.7 'Set Bit 7 FOR Command "Set DDRAM"
Lcds_command Ch 'Set Cursor-Position
Waitus 100
Zlen = Len(text) 'LEN of Display-Text
For Zp = 1 To Zlen
Ch = Text_o(zp)
Lcds_data Ch
Next Zp
Return
Sub Lcds_command(byval Ch As Byte)
Reset Lcd_cout.1
Lcds_wdata Ch
End Sub
Sub Lcds_data(byval Ch As Byte)
Set Lcd_cout.1
Lcds_wdata Ch
End Sub
Sub Lcds_wdata(byval Ch As Byte)
Lcd_cout.7 = 1 'Sync
Lcd_cout.6 = 1 'Sync
Lcd_cout.5 = 1 'Sync
Lcd_cout.4 = 1 'Sync
Lcd_cout.3 = 1 'Sync
Lcd_cout.2 = 0 'R/W
Lcd_cout.0 = 0 'leer
Shiftout Dsdata , Dclock , Lcd_cout , 0 , 8
Lcd_dout = 0
Lcd_dout.7 = Ch.7
Lcd_dout.6 = Ch.6
Lcd_dout.5 = Ch.5
Lcd_dout.4 = Ch.4
Shiftout Dsdata , Dclock , Lcd_dout , 0 , 8
Lcd_dout = 0
Lcd_dout.7 = Ch.3
Lcd_dout.6 = Ch.2
Lcd_dout.5 = Ch.1
Lcd_dout.4 = Ch.0
Shiftout dsdata , Dclock , Lcd_dout , 0 , 8
End Sub
'*******************************************************************************
' All Grafic-Routines (c) by Heiko Kipnik
'
'*******************************************************************************
' Show BASCOM Graphic Files (BGF)
' use the Graphic converter in Uncompressed Mode
' The Sub do not support RLE compression
' Set Xs=Start Xpoint Ys=Start Ypoint
'*******************************************************************************
Sub Lcds_show_bgf(byval Xs As Byte , Byval Ys As Byte)
Local Xz As Byte , Yz As Byte , Col As Byte
Local Bnr As Byte , Xdum As Byte , Xend As Byte , Yend As Byte
Read Yend 'Read Height
Read Xend 'Read Width
Yend = Yend + Ys 'Set end point
Xend = Xend + Xs 'Set end point
Decr Xend
Decr Yend
For Yz = Ys To Yend 'Ystart to Yend
For Xz = Xs To Xend Step 8 'Step 8 Pixel for one Byte
Read Col 'Read BGF file 1Byte = 8 Pixel
Xdum = Xz 'X Start Point
For Bnr = 7 To 0 Step -1 'MSB first Set 8Bit
If Col.bnr = 0 Then 'Read pixel
Call Lcds_set_pixel(xdum , Yz , White) 'Set Pixel
Else
Call Lcds_set_pixel(xdum , Yz , Black) 'Clear Pixel
End If
Incr Xdum 'Incr X pointer
Next
Next
Next
End Sub
'*******************************************************************************
' Draw Box Xs-Ys to Xe-Ye fill=1 Fill -- Fill=0 no fill
' Color=1 Black Pixel Color=0 White Pixel
'*******************************************************************************
Sub Lcds_box(byval Xs As Byte , Byval Ys As Byte , Byval Xe As Byte , Byval Ye As Byte , Byval Fill As Byte , Byval Color As Byte)
Local Xza As Byte , Yza As Byte
If Fill = 1 Then
For Yza = Ys To Ye
For Xza = Xs To Xe
Call Lcds_set_pixel(xza , Yza , Color)
Next
Next
Else
Call Lcds_line(xs , Ys , Xe , Ys , 1 , Color)
Call Lcds_line(xs , Ye , Xe , Ye , 1 , Color)
Call Lcds_line(xs , Ys , Xs , Ye , 1 , Color)
Call Lcds_line(xe , Ys , Xe , Ye , 1 , Color)
End If
End Sub
'*******************************************************************************
' Set or Clear a Pixel to X-Y Position Colo=1 Set Pixel Colo=0 Clear Pixel
' and write Data to Display-Array
'*******************************************************************************
Sub Lcds_set_pixel(byval Xp As Byte , Byval Yp As Byte , Byval Colo As Byte)
Local B1 As Byte , Zeiger As Word , Bitnr As Byte
Decr Yp
B1 = Yp / 8
Zeiger = B1 * 128
Zeiger = Zeiger + Xp
Bitnr = Yp Mod 8
If Colo = Black Then
Ddata(zeiger).bitnr = 1
Else
Ddata(zeiger).bitnr = 0
End If
End Sub
'*******************************************************************************
' Updated the Display whith Display-Array
'*******************************************************************************
Sub Lcds_show()
O_byte = 1
O_bit = 7
For I_page = 0 To 7
For I_bit = 0 To 7
For I_byte = 0 To 127
O_byte = I_byte / 8
Iw_byte = I_byte + 1
'Text = "BitI " + Str(i_bit) + " "
'Lcda 1 , 1 , Text
'Text = "ByteI " + Str(iw_byte) + " "
'Lcda 2 , 1 , Text
'Text = "ByteO " + Str(o_byte) + " "
'Lcda 3 , 1 , Text
'Text = "BitO " + Str(o_bit) + " "
'Lcda 4 , 1 , Text
'Wait 1
O_page = I_page * 128
I_page_byte = O_page + I_byte
W_page_byte = I_page_byte + 1
'Toggle Ddata(w_page_byte).i_bit
Ddata2(o_byte).o_bit = Ddata(w_page_byte).i_bit
Decr O_bit
If O_bit = -1 Then O_bit = 7
Next I_byte
X_pos = 0
For D_pos = 0 To 15 Step + 2 'Display one row 2 x 8Bit
If I_page < 4 Then
Y_pos = I_page * 8
X_cmd = X_pos + 128
End If
If I_page > 3 Then
W_page = I_page - 4
Y_pos = W_page * 8
X_cmd = X_pos + 136 'Command Grafic 128 + 8 Position
End If
Y_pos = Y_pos + I_bit
Y_cmd = Y_pos + 128
Lcds_command Y_cmd
Lcds_command X_cmd
Lcds_data Ddata2(d_pos)
Lcds_data Ddata2(d_pos + 1)
Incr X_pos
Next D_pos
Next I_bit
Next I_page
End Sub
'*******************************************************************************
'LCD_Text String -- X -- Y Start -- Font
'*******************************************************************************
Sub Lcds_text(byval S As String , Xoffset As Byte , Yoffset As Byte , Fontset As Byte)
Local Tempstring As String * 1 , Temp As Word 'Dim local the variables
Local A As Byte , Pixels As Byte , Count As Byte , Carcount As Byte , Lus As Byte
Local Row As Byte , Block As Byte , Byteseach As Byte , Blocksize As Byte , Dummy As Byte
Local Colums As Byte , Columcount As Byte , Rowcount As Byte , Stringsize As Byte
Local Xpos As Byte , Ypos As Byte , Pixel As Word , Pixelcount As Byte
Local Offset As Word
Stringsize = Len(s) - 1 'Size of the text string -1 because we must start with 0
Select Case Fontset
Case 1 :
Block = Lookup(0 , My6_8) 'Add or remove here fontset's that you need or not,
Byteseach = Lookup(1 , My6_8)
Blocksize = Lookup(2 , My6_8)
Dummy = Lookup(3 , My6_8)
Case 2 :
Block = Lookup(0 , Font16x16)
Byteseach = Lookup(1 , Font16x16)
Blocksize = Lookup(2 , Font16x16)
Dummy = Lookup(3 , Font16x16)
'
Case 3 :
Block = Lookup(0 , My12_16)
Byteseach = Lookup(1 , My12_16)
Blocksize = Lookup(2 , My12_16)
Dummy = Lookup(3 , My12_16)
End Select
Colums = Blocksize / Block 'Calculate the numbers of colums
Row = Block * 8 'Row is always 8 pixels high = 1 byte, so working with row in steps of 8.
Row = Row - 1 'Want to start with row=0 instead of 1
Colums = Colums - 1 'Same for the colums
For Carcount = 0 To Stringsize 'Loop for the numbers of caracters that must be displayed
Temp = Carcount + 1 'Cut the text string in seperate caracters
Tempstring = Mid(s , Temp , 1)
Offset = Asc(tempstring) - 32 'Font files start with caracter 32
Offset = Offset * Blocksize
Offset = Offset + 4
Temp = Carcount * Byteseach
Temp = Temp + Xoffset
For Rowcount = 0 To Row Step 8 'Loop for numbers of rows
A = Rowcount + Yoffset
Xpos = Temp
For Columcount = 0 To Colums 'Loop for numbers of Colums
Select Case Fontset
Case 1 : Pixels = Lookup(offset , My6_8)
Case 2 : Pixels = Lookup(offset , Font16x16)
Case 3 : Pixels = Lookup(offset , My12_16)
End Select
Ypos = A
For Pixelcount = 0 To 7 'Loop for 8 pixels to be set or not
Pixel = Pixels.0 'Set the pixel (or not)
If Pixel = 0 Then
Call Lcds_set_pixel(xpos , Ypos , White)
Else
Call Lcds_set_pixel(xpos , Ypos , Black)
End If
Shift Pixels , Right 'Shift the byte 1 bit to the right so the next pixel comes availible
Incr Ypos 'Each pixel on his own spot
Next Pixelcount
Incr Offset
Incr Xpos 'Do some calculation to get the caracter on the correct Xposition
Next Columcount
Next Rowcount
Next Carcount
End Sub
'*******************************************************************************
' Draw Fill Circle X-Y Center - Radius - Color=1 set Pixel Color=0 clear pixel
'*******************************************************************************
Sub Lcds_fill_circle(byval X As Byte , Byval Y As Byte , Byval Radius As Byte , Byval Color1 As Byte)
Local Xy_radius As Integer , Zahly As Integer , Zahlx As Integer , Y1 As Integer , X1 As Integer
Local Y11 As Integer , X11 As Integer , Xy As Integer , X2 As Byte , Y2 As Byte
Xy_radius = Radius * Radius
Y1 = -radius
X1 = -radius
For Zahly = Y1 To Radius
Y11 = Zahly * Zahly
For Zahlx = X1 To Radius
X11 = Zahlx * Zahlx
Xy = X11 + Y11
If Xy <= Xy_radius Then
X2 = X + Zahlx
Y2 = Y + Zahly
Call Lcds_set_pixel(x2 , Y2 , Color1)
End If
Next
Next
End Sub
'*******************************************************************************
' Draw Circle X-Y Center - Radius - Color=1 set Pixel Color=0 clear pixel
'*******************************************************************************
Sub Lcds_circle(byval X As Byte , Byval Y As Byte , Byval Radius As Byte , Byval Color As Byte)
Local X0 As Byte , Y0 As Byte , Error As Integer
Local Xp As Byte , Yp As Byte , Xe As Byte , Ye As Byte
Error = -radius
Xp = Radius
Yp = 0
While Xp >= Yp
X0 = X + Xp : Y0 = Y + Yp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X - Xp : Y0 = Y + Yp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X + Xp : Y0 = Y - Yp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X - Xp : Y0 = Y - Yp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X + Yp : Y0 = Y + Xp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X - Yp : Y0 = Y + Xp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X + Yp : Y0 = Y - Xp
Call Lcds_set_pixel(x0 , Y0 , Color)
X0 = X - Yp : Y0 = Y - Xp
Call Lcds_set_pixel(x0 , Y0 , Color)
Error = Error + Yp
Incr Yp
Error = Error + Yp
If Error >= 0 Then
Decr Xp
Error = Error - Xp
Error = Error - Xp
End If
Wend
End Sub
'*******************************************************************************
' Draw line X - Y Start to X - Y End - Pen Width - Color=1 set Pixel Color=0 clear pixel
'*******************************************************************************
Sub Lcds_line(byval X1 As Byte , Byval Y1 As Byte , Byval X2 As Byte , Byval Y2 As Byte , Byval Pen_width As Byte , Byval Color As Byte)
Local Y As Word , X As Word , X_diff As Single , Y_diff As Single , Pos As Word
Local X_factor As Single , X_pos As Word , Y_pos As Word , Base As Word , Pen_count As Byte
Local Xpoint As Byte , Ypoint As Byte
Y_diff = Y2 - Y1
X_diff = X2 - X1
Pos = 0
X_factor = Abs(y_diff)
Y = X_factor
X_factor = Abs(x_diff)
X = X_factor
If Y > X Then
X_factor = X_diff / Y_diff
If Y1 > Y2 Then
Swap Y1 , Y2
Base = X2
Else
Base = X1
End If
For Y = Y1 To Y2
X_diff = Pos * X_factor
X_pos = X_diff
X_pos = X_pos + Base
Xpoint = X_pos
Ypoint = Y
Call Lcds_set_pixel(xpoint , Ypoint , Color)
For Pen_count = 1 To Pen_width
Call Lcds_set_pixel(xpoint , Ypoint , Color)
Incr Xpoint
Next Pen_count
Incr Pos
Next Y
Else
X_factor = Y_diff / X_diff
If X1 > X2 Then
Swap X1 , X2
Base = Y2
Else
Base = Y1
End If
For X = X1 To X2
Y_diff = Pos * X_factor
Y_pos = Y_diff
Y_pos = Y_pos + Base
Xpoint = X
Ypoint = Y_pos
Call Lcds_set_pixel(xpoint , Ypoint , Color)
For Pen_count = 1 To Pen_width
Call Lcds_set_pixel(xpoint , Ypoint , Color)
Incr Ypoint
Next Pen_count
Incr Pos
Next X
End If
End Sub