Volume controle

Controle the device volume from within your VB20xx application.
Tested with Friendlyarm Mini2440 running on win CE6.0 and Visual Basic 2008.

 Public Class Form1

    Public Declare Function waveOutSetVolume Lib "coredll.dll" (ByVal hwo As IntPtr, ByVal dwVolume As Long) As Integer
    Public Declare Function waveOutGetVolume Lib "coredll.dll" (ByVal hwo As IntPtr, ByRef pdwVolume As Long) As Integer


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        waveOutSetVolume(0, 40000) 'Sets the volume to 40000
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim i As Long
        waveOutGetVolume(0, i)
        Debug.WriteLine("Current volume setting: " & i)
    End Sub
End Class
I2C Eeprom programmer

What is it?
It’s an Eeprom programmer controlled by Bascom Avr and is capable of programming in circuit Eeprom’s up to 512Kb. Standard Intel Hex8 file is required.
Extended Linear Address Records for Eeprom’s bigger then 16bits addresses is not (yet) supported, but easy to implant.
I wrote it primary for my other application note RC2 sound / voice playback to upload the sound files to the i2c Eeprom.
Special thanks to Mark from Mcselec how has added in the vb6 an asm to intelhex routine so Atmel studio is not needed anymore.

Required tools
For the Pc side there’s an upload program that sends the Intel Hex file to the AVR.
Program is written in VB6-Sp6, source code is also available.

The code
Code is written and tested in Bascom 1.11.9.0.001 license.
Download the Bascom source code here

 

'--------------------------------------------------------------------
'                       I2C Eeprom programmer
'Upload your Eeprom files through serial connection in the I2c Eeprom
'       No extended address supported, so max 512K Eeprom
'     By Evert Dekker 2008 i2cprogrammer@Evertdekker dotje com
'                Created with Bascom-Avr: 1.11.9.0.100
'--------------------------------------------------------------------

$regfile = "m128def.DAT"
$crystal = 16000000
$baud = 19200
$hwstack = 70
$swstack = 70
$framesize = 60

$lib "I2C_TWI.LBX"                                          'Setting up i2c hardware bus
Config Twi = 400000                                         'Hardware i2c bus speed
Config Scl = Portd.0                                        'TWI (i2c) ports on the Mega128
Config Sda = Portd.1
Const Addressw = &B10100000                                 'slave write address eeprom
Const Addressr = &B10100001                                 'slave read address eeprom


Dim Startbyte As Byte , Instring As String * 45 , Complete As Bit
Dim Temp As Byte , Temps As String * 3
Dim Bytecount As Byte , Addresshigh As Byte , Addresslow As Byte , Recordtype As Byte , Databyte(16) As Byte , Checksm As Byte
Dim Lus As Byte , Pos As Byte , Checksum_calc As Byte , Checksum_error As Bit

Enable Urxc
Enable Interrupts
On Urxc Bytereceived_isr


'=== Main  ===
Do
If Complete = 1 Then                                        'Wait until the buffer is filled with one line
  Gosub Process_buffer                                      'Process the buffer
  Gosub Calculate_checksum                                  'Calculate the cheksum
     If Recordtype = &H01 Then                              'EOF finished, send a ACK and return
      Print "Y";
     Else
       If Checksum_error = 0 Then                           'If there's no error continue
         Select Case Recordtype                             'do something with the recordtype
            Case &H00                                       'Data byte
                Gosub Prog_eeprom                           'Recordtype &H00 = databyte, so lets programm the Eeprom
            Case &H02                                       'Extended Linear Address Records, not (yet) supported
               nop
         End Select
       Print "Y";                                           'Checksum ok, send a ACK
      Else
       Print "Z";                                           'Checksum error send a Nack
     End If
    End If
  Complete = 0 : Instring = ""                              'Reset the variable
End If
Loop
End


'=== Subroutines ===
Prog_eeprom:
    I2cstart                                                'start condition
    I2cwbyte Addressw                                       'slave address
    I2cwbyte Addresshigh                                    'Highaddress of EEPROM
    I2cwbyte Addresslow                                     'Lowaddress of EEPROM
       For Lus = 1 To Bytecount
         I2cwbyte Databyte(lus)                             'value to write
       Next Lus
    I2cstop                                                 'stop condition
    Waitms 10                                               'wait for 10 milliseconds
Return


Process_buffer:
Temps = Mid(instring , 1 , 2) : Bytecount = Hexval(temps)   'Read the numbers of bytes
Temps = Mid(instring , 3 , 2) : Addresshigh = Hexval(temps) 'Read the high adress
Temps = Mid(instring , 5 , 2) : Addresslow = Hexval(temps)  'Read the low adress
Temps = Mid(instring , 7 , 2) : Recordtype = Hexval(temps)  'Read the recordtype
For Lus = 1 To Bytecount                                    'Process the number of data bytes
      Pos = Lus * 2
      Pos = Pos + 7
      Temps = Mid(instring , Pos , 2) : Databyte(lus) = Hexval(temps)       'Read the databytes
Next Lus
Pos = Pos + 2                                               'read the last byte
Temps = Mid(instring , Pos , 2) : Checksm = Hexval(temps)   'Read checksum
Return


Calculate_checksum:
Temp = 0                                                    'Add up all the databytes
Temp = Temp + Bytecount
Temp = Temp + Addresshigh
Temp = Temp + Addresslow
Temp = Temp + Recordtype
   For Lus = 1 To Bytecount
    Temp = Temp + Databyte(lus)
   Next Lus
Checksum_calc = 256 - Temp                                  'taking its two's complement
   If Checksum_calc <> Checksm Then                         'Compare it with the readed value
    Checksum_error = 1
   Else
    Checksum_error = 0
   End If
Return

Bytereceived_isr:
Temp = Udr                                                  'get the binary value that came across
If Temp = &H0D Then                                         'Received CR = end of line, line complete
 If Len(instring) < 8 Then                                  'To short, startover again
   Complete = 0
   Instring = ""
 Else
   Complete = 1                                             'String is complete set the flag
 End If
End If

If Startbyte = &H3A Then                                    'we have previously received the start byte and this is now data
  If Temp > &H0F Then                                       'Add incoming data to buffer
     Instring = Instring + Chr(temp)
    If Len(instring) > 45 Then Instring = ""                'String is to long, reset and startover again
 End If
End If

If Temp = &H3A Then                                         'if we received an : then its the beginning of an new line.
   Startbyte = Temp
   Complete = 0
   Instring = ""
End If
Return
RC2 Decoder sound / voice playback

What is it?

It’s an very simple, only 2 resistors and 1 condensator, sound playback. And it sounds amazing good, check the TheFinalResult.mp3 file.This is based on an article by Mariano Barron in the Circuit Cellar #180 July 2005. Due the copyright I can’t publish the article here. You can buy your copy at the Circuit Cellar website.
The software we need to encode the WAV files is free available from the Circuit cellar ftp server, in this file there is also a short description how it works.With the Rc Sound Encoder software we compress the WAV to RC2 coding. This coding will be stored in eeprom and played back with this simple “Soundcard” Every sample requires only 1 bit, so for 1 second 44,1kHz sound we need 2726 Bytes storage space. It’s not much but for most MCU too much to store in the flash or internal eeprom. Therefore we store the sound samples in an external i2c eeprom.

Hardware

Schematic

Schematic is very simple. I’m using a Mega128 running on 16MHz. I2c eeprom (24c256) is connected with the hardware i2c (scl/sda). Software i2c will not work, this is to slow, maybe it will work with 22050hz samples but I didn’t try that.In the upper right corner we have the Rc2 decoder and optional an low pass filter and a simple amplifier.

Timing
Even the timer isr calculation is simple Crystal/prescaler/sample rate = 16000000/1/44100 = 362 = &H016A .
If you like to use an other sample rate or crystal you need to recalculate the timer.

Diy
The document RC2-Howto.pdf describes how to make your own Eeprom file with your sound or speech, this document can be found in the Zip file. The zip contains also the used WAV files, the ready to run demo Eeprom hex file and some ASM files.

Limitation
In all the routines are 16bits addressing used, therefore it’s not possible to use Eeprom’s larger then 512KB. If you change the routines you can use more then one 512KB i2c eeprom (you can hook up 4 to 1 i2c bus), but the RC-coder software uses also 16bits addresses and that’s something that we cannot change.

Required tools

 

The code
Code is written and tested in Bascom 1.11.9.0.001 license.

'------------------------------------------------------------------
'                      R2C Decoder voice playback
'     Playback sound and voice with very simple hardware 2xR 1xC
'        By Evert Dekker 2008 R2CDecoder@Evertdekker dotje com
'                   Created with Bascom-Avr: 1.11.9.0.100
'------------------------------------------------------------------

$regfile = "m128def.DAT"
$crystal = 16000000
$baud = 19200
$hwstack = 50
$swstack = 50
$framesize = 40

$lib "I2C_TWI.LBX"                                          'Setting up i2c hardware bus
Config Twi = 400000                                         'Hardware i2c bus speed
Config Scl = Portd.0                                        'TWI (i2c) ports on the Mega128
Config Sda = Portd.1
Const Addressw = &B10100000                                 'slave write address eeprom
Const Addressr = &B10100001                                 'slave read address eeprom


Vp1 Alias Porta.1                                           'Voice pin 1
Vp2 Alias Porta.2                                           'Voice pin 2
Config Porta.1 = Output
Config Porta.2 = Output


Config Timer1 = Timer , Prescale = 1 , Compare A = Set , Clear Timer = 1       'Setting up the timer
Compare1a = &H016A                                          'Timer1 comparator
Enable Interrupts
Enable Compare1a
On Compare1a Timer1_int
Stop Timer1                                                 'Stop the timer, not yet needed


'==== Declaration
Declare Sub Read_eeprom_word(byval Adress As Word , Valueword As Word)
Declare Sub Playsample(byval Sample As Byte)
Declare Sub Read_eeprom_index

Dim Samples As Word , Start_byte(10) As Word , Lenght(10) As Word       'If you have more then 10 voices programmed, then incr this here.
Dim Bytetodo As Word , Outbyte As Byte
Dim Temp As Byte , Tempw As Word , Lus As Byte
Dim Bitcount As Byte , Tempadress2 As Byte

'=== Main ===
Do
Read_eeprom_index                                           'Read the eeprom index because we need to know number of samples, startadress and lenght
Print Samples ; " Samples present in the eeprom"
For Lus = 1 To Samples
 Print Lus ; "e sample start at eeprom adress: &H" ; Hex(start_byte(lus)) ; " is &H" ; Hex(lenght(lus)) ; " bytes long."
Next For
Wait 3

For Lus = 1 To Samples
 Playsample Lus
Wait 1
Next Lus

Loop
End



'=== Sub routines ===
Sub Playsample(byval Sample As Byte)
Bytetodo = Lenght(sample)                                   'Number of bytes to be processed
Tempw = Start_byte(sample) * 2                              'Index is in word, need now bytes so *2
I2cstart                                                    'Generate start
I2cwbyte Addressw
Tempadress2 = High(tempw)                                   'High(adress)
I2cwbyte Tempadress2                                        'highbyte adress of EEPROM
Tempadress2 = Low(tempw)
I2cwbyte Tempadress2                                        'lowbyte adress of EEPROM
I2cstart                                                    'repeated start
I2cwbyte Addressr
Start Timer1                                                'Start the timer and therefore the playback
Do
If Bitcount = 7 Then                                        '1 byte processed
   I2crbyte Outbyte , Ack                                   'Read byte from eeprom
    Decr Bytetodo                                           '1 byte less todo
    Bitcount = 0                                            'Reset bits processed
End If
Loop Until Bytetodo = 0                                     'Do until all the bytes from the sample are processed
Stop Timer1                                                 'Ready stop the timer
I2crbyte Temp , Nack                                        'read extra byte with Nack to finish the i2c bus
I2cstop                                                     'Stop i2c
Vp2 = 0 : Vp1 = 0                                           'Silence the voice pins
End Sub



Timer1_int:
Vp2 = Vp1                                                   'Voice pin2 is the previous setting of voice pin1
If Bitcount > 0 Then Shift Outbyte , Right , 1              'shift the bits out
Vp1 = Outbyte.0                                             'Set voice pin1
Incr Bitcount                                               'Next bit
Return



Sub Read_eeprom_index                                       'Find the start adresse of each Voice. Adress is stored as word
      Read_eeprom_word 0 , Samples                          '1e Byte in the eeprom contens the number of programmed samples and is the low byte of the first sample
      Temp = Low(samples) : Temp = Temp -1                  '
      For Lus = 0 To Temp                                   'Loop the number of Samples found
          Tempw = Lus * 2                                   'Reading words, so steps 2
          Read_eeprom_word Tempw , Start_byte(lus + 1)      'Read the start adres of the samples
          Tempw = Start_byte(lus + 1)
          Tempw = Tempw * 2                                 'Reading words, so steps 2
          Read_eeprom_word Tempw , Lenght(lus + 1)          'Read the lenght of the sample from the eeprom
          Rotate Lenght(lus + 1) , Left , 8                 'Msb and Lsb are inverted so swap them
      Next Lus
End Sub




Sub Read_eeprom_word(byval Adress As Word , Valueword As Word)
   Local Tempadress As Byte , Valueh As Byte , Valuel As Byte,
   I2cstart                                                 'generate start
   I2cwbyte Addressw                                        'slave adsress
   Tempadress = High(adress)
   I2cwbyte Tempadress                                      'highbyte adress of EEPROM
   Tempadress = Low(adress)
   I2cwbyte Tempadress                                      'lowbyte adress of EEPROM
   I2cstart                                                 'repeated start
   I2cwbyte Addressr                                        'slave address (read)
   I2crbyte Valuel , Ack                                    'read byte
   I2crbyte Valueh , Nack
   I2cstop                                                  'generate stop
   Valueword = Makeint(valuel , Valueh)
End Sub

 

Manchester coding

For wireless communication you need Manchester coding. Manchester code provides simple encoding with no long period without a level transition. This helps clock recovery.
Here ‘s is a simple sample for a transmitter and receiver written in Bascom-avr.
1 will be coded as 01
0 will be coded as 10
00 and 11 are invalid
For the receiving part in VB6 check here .

Declare Function Make_manchester(byval Temp As Byte) As Word
Declare Function Decode_manchester(byval Tempw As Word ) As Byte



'== Demo prog ==
Dim Lus As Byte
Do
For Lus = 0 To 255
   Tempword = Make_manchester(lus)
   Print Decode_manchester(tempword)
Next Lus
Loop
End

 

'Subroutines
Sub Make_manchester(byval Temp As Byte) As Word
Local Bit_number As Byte
Local Manchester As Word
Bit_number = 8
Do
Shift Manchester , Left , 2
Decr Bit_number
If Temp.bit_number = 1 Then
Manchester = Manchester + 1                                 '01
Else
Manchester = Manchester + 2                                 '10
End If
Loop Until Bit_number = 0
Make_manchester = Manchester
End Sub


Sub Decode_manchester(byval Tempw As Word ) As Byte
Local Bit_number As Byte
Local Manchester As Word
Bit_number = 8
Do
Shift Manchester , Left , 1
Decr Bit_number
Temp_1 = Tempw And &B1100_0000_0000_0000
If Temp_1 = &B0100_0000_0000_0000 Then Incr Manchester      '01
If Temp_1 = &B1100_0000_0000_0000 Or Temp_1 = 0 Then Set Data_error       '11 or 00
Shift Tempw , Left , 2
Loop Until Bit_number = 0
If Data_error = 0 Then
   Decode_manchester = Manchester
Else
   Decode_manchester = 0
End If
Reset Data_error
End Sub
Rgb dimmer fading

Rgb dimmers are most of the time dimming according figure 1. It’s simple code, just increase al the colors 1 step a time,  but the disadvange is that blue is ready first and red the last and that looks not that realistic. It would be neater when all 3 colors will start and finishing together as seen in figure 2.
This code will fade all colors together.
Timer3 is used to controle the 3 pwm channels.
Timer0 is the delay for the steps. It’s with this xtal and preload an delay of 20ms. If you are going to use a other crystal then you need recalculate the timer0 preload.

rgb1
rgb2
PlayPause
previous arrow
next arrow
 
rgb1
rgb2
previous arrow
next arrow

 

Syntax

Fade Red,Green,Blue,Steps

Remarks

 Red  Constant or variable with new RED value.
 Green  Constant or variable with new GREEN value.
 Blue  Constant or variable with new BLUE value.
 Steps  Number of steps to fade between old and new value

 

 

 

 

 

 

Dowload the code here 

See the code below in action;

 

$regfile = "m128def.DAT"
$crystal = 7372800
$baud = 19200


Config Timer3 = Pwm , Prescale = 64 , Pwm = 8 , Compare A Pwm = Clear Down , Compare B Pwm = Clear Down , Compare C Pwm = Clear Down
Config Timer0 = Timer , Prescale = 1024

On Ovf0 Rgbint
Enable Timer3
Enable Ovf0
Enable Interrupts
Start Timer3
Timer0 = &H70
Stop Timer0


Declare Sub Fade(byval Newrood As Byte , Byval Newgroen As Byte , Byval Newblauw As Byte , Byval Stappen As Byte)
Dim Staprood As Single
Dim Stapgroen As Single
Dim Stapblauw As Single
Dim Roodw As Single
Dim Blauww As Single
Dim Groenw As Single
Dim Stappen As Byte
Dim Temps As Single
Dim Tempint As Integer
Dim Stap2 As Byte

Rood Alias Compare3a
Blauw Alias Compare3b
Groen Alias Compare3c

Rood = 0
Blauw = 0
Groen = 0


Do
Fade 25 , 25 , 25 , 10
Wait 2
Fade 255 , 0 , 0 , 50
Wait 2
Fade 0 , 255 , 0 , 50
Wait 2
Fade 0 , 0 , 255 , 50
Wait 2
Fade 150 , 150 , 75 , 50
Wait 2
Fade 0 , 0 , 0 , 10
Wait 2
Fade 225 , 225 , 225 , 100
Wait 2
Loop




Sub Fade(newrood As Byte , Newgroen As Byte , Newblauw As Byte , Stappen As Byte )
Stap2 = Stappen
Roodw = Rood : Groenw = Groen : Blauww = Blauw
Temps = Newrood - Rood
Staprood = Temps / Stappen
Temps = Newgroen - Groen
Stapgroen = Temps / Stappen
Temps = Newblauw - Blauw
Stapblauw = Temps / Stappen
Start Timer0
End Sub


Rgbint:
Roodw = Roodw + Staprood
Groenw = Groenw + Stapgroen
Blauww = Blauww + Stapblauw
Tempint = Round(roodw)
Rood = Tempint
Tempint = Round(blauww)
Blauw = Tempint
Tempint = Round(groenw)
Groen = Tempint
Decr Stap2
If Stap2 = 0 Then
 Stop Timer0
End If
Timer0 = &H70
Return