• Email
  • Forum

Bargrafy


Jeśli tu nie ma na stronie to kody gotowych funkcji rysujących znajdziesz na FORUM


Poniżej filmik porównawczy

Pod nim kody tych dwóch bargrafów rozdzielone dla czytelności. Każdy z tych bargrafów może być krótszy lub przesunięty na wyświetlaczu. Po zrozumieniu ich prostej budowy można zrobić taki "w lewo, w prawo". Dopiszę w wolnej chwili.

Kod górnego z filmiku

'##  Author:      Matthias (at) Braunecker (.at)                              ##
'##  Version:     1.0                                        Date: June 2011  ##
'zestaw znaków dla  bargrafu
 Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 32
 Deflcdchar 1 , 16 , 16 , 16 , 16 , 16 , 16 , 16 , 16
 Deflcdchar 2 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24
 Deflcdchar 3 , 28 , 28 , 28 , 28 , 28 , 28 , 28 , 28
 Deflcdchar 4 , 30 , 30 , 30 , 30 , 30 , 30 , 30 , 30
 Deflcdchar 5 , 31 , 31 , 31 , 31 , 31 , 31 , 31 , 31
   Const Lcd_bar_leading = 5
   Const Lcd_bar_trailing = 0
 Deflcdchar 6 , 12 , 4 , 4 , 6 , 12 , 4 , 14 , 32           ' ł
 Cls

Declare Sub Lcd_bar(byval Percent As Byte , Byval Chars As Byte)

Dim Help As Byte                                            'przesuwa liczbę
Const Pro_cent = 68                                         ' stała tylko dla przykładu

Lcd "G" ; Chr(6) ; "os -"                                   'wyswietl napis "Głos -"
Lcd_bar Pro_cent , 15                                       'wyswietl procentową wartosc w 15 kratkach max

'*** START ***
'pro forma
Do
nop
Loop
End
'*** KONIEC ***

Sub Lcd_bar(percent As Byte , Chars As Byte)
   Local Position As Word , Offset As Byte , Index As Byte
' calculate the arrow position
   Position = Chars * 5                                     ' resolution
   Position = Position * Percent                            ' calc absolute position
   Position = Position / 100
   Offset = Position Mod 5                                  ' relative position
   Offset = Offset + 1
   Position = Position / 5                                  ' character position

   'If Percent = 100 Then Position = Position - 1

Locate 2 , 1
   ' draw leading characters
   For Index = 1 To Position
      Lcd Chr(lcd_bar_leading)
   Next
     Lcd Chr(offset)

 ' trailing characters
   Position = Position + 2
   For Index = Position To Chars
      Lcd Chr(lcd_bar_trailing)
   Next
    Help = 18
    If Percent > 10 Then Help = 17
    If Percent = 100 Then Help = 16
    Locate 2 , Help : Lcd " " ; Percent ; "%"
End Sub

Kod dolnego z filmiku

'wystarczy jeden znak
 Deflcdchar 7 , 27 , 27 , 27 , 27 , 27 , 27 , 27 , 32       ' bar
Cls

Dim Char_pos As Byte
Dim Bar_len As Word
Dim T1 As Single

Const Char_max = 20                                         'number of LCD characters (one row)

Const Vol_me = 32            'wpisana do testu - tą wartość ma pokazać'

Config Submode = New

Sub Displ
 T1 = Vol_me / 3.14
   Bar_len = Char_max - Int(t1)
Locate 2 , 1                                                'set LCD first character position
   For Char_pos = 1 To Char_max                             'number of characters
    If Char_pos <= Bar_len Then                             'print one bar
      Lcd Chr(7)                                            'print special char                                         '
    Else
      Lcd Chr(32)                                           'print spaces to fill row
    End If
   Next
End Sub


Lcd "-      Volume      +"
Call Displ

'*** START ***
'pro forma
Do
nop
Loop
End
'*** KONIEC ***

Kolejny..

me>
Config Submode = New

Dim Ramp_val(8) As Byte , N As Byte , Volume As Byte

Declare Sub Draw_ramp_bargraph(byval Passed_value As Byte , Byval Line_ As Byte)

Sub Ramp_bar_charset
Deflcdchar 0 , 32 , 32 , 32 , 32 , 32 , 32 , 32 , 31
Deflcdchar 1 , 32 , 32 , 32 , 32 , 32 , 32 , 31 , 31
Deflcdchar 2 , 32 , 32 , 32 , 32 , 32 , 31 , 31 , 31
Deflcdchar 3 , 32 , 32 , 32 , 32 , 31 , 31 , 31 , 31
Deflcdchar 4 , 32 , 32 , 32 , 31 , 31 , 31 , 31 , 31
Deflcdchar 5 , 32 , 32 , 31 , 31 , 31 , 31 , 31 , 31
Deflcdchar 6 , 32 , 31 , 31 , 31 , 31 , 31 , 31 , 31
Deflcdchar 7 , 31 , 31 , 31 , 31 , 31 , 31 , 31 , 31
End Sub

Sub Draw_ramp_bargraph(byval Passed_value As Byte , Byval Line_ As Byte)
 'value max = 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 = 36
   Local Value As Byte
    Value = Passed_value

 Locate 1 , 10
  If Value < 10 Then Lcd " " ; Value Else Lcd Value
   Lcd " DEMO"
 Locate Line_ , 1                                           

For N = 1 To 8
 If Value > N Then
  Ramp_val(n) = N - 1
  Value = Value - N
 Else
  If Value > 0 Then
    Ramp_val(n) = Value - 1
    Value = 0
   Else
    Ramp_val(n) = 32
  End If
 End If
  Lcd Chr(ramp_val(n))
Next

End Sub

Call Ramp_bar_charset

'*** START ***
Do


  Call Draw_ramp_bargraph(volume , 1)

  Incr Volume
   If Volume = 37 Then
    Volume = 0
    Waitms 500
   End If

 Waitms 300
Loop
End

Nokia 3310/5110

Taki dodatek do popularnego ostatnio kodu


[Rozmiar: 40079 bajtów]

Declare Sub Rysuj_bargraf(byval Wiersz As Byte , Byval Wartosc As Word)       'umieśc z reszta deklaracji

'tak uzywaj
Call Rysuj_bargraf(1 , Temperatura)                         'w nawiasie numer wiersza




Rysuj_bargraf(byval Wiersz As Byte , Byval Wartosc As Word)
'rysuje bargraf otoczony ramką
Select Case Wiersz
 Case 1 : Offset = 0
 Case 2 : Offset = 85
 Case 3 : Offset = 169
 Case 4 : Offset = 253
 Case 5 : Offset = 337
 Case 6 : Offset = 421
End Select

Lcd_cache(offset) = &HFF                                    'pierwsza zamykająca belka
Incr Offset
Lcd_cache(offstet) = &H81                                   'odstep
Incr Offset
_start = Offset
_end = _start + 82
Licznik_3 = 0
'jesli licznik w petli niższy od temperatury to wypełnia bargraf, potem do konca rysuje puste
For Lcdcacheidx_3 = _start To _end
    If Licznik_3 <= Wartosc Then Bargraf_znak = &HBD Else Bargraf_znak = &H81
     Lcd_cache(lcdcacheidx_3) = Bargraf_znak
     Incr Licznik_3
Next
Lcd_cache(_end + 1) = &H81                                  'odstep
Lcd_cache(_end + 2) = &HFF                                  'ostatnia zamykająca belka

End Sub

Taki na cały wyświetlacz ;)

Jak się bawić to na dwa LCD ;)

Taki do bateryjki

Z serii "Rowery elektryczne"

Kody gotowych funkcji rysujących znajdziesz na FORUM

Email

Jeśli mogę w czymś pomóc, napisz.