click a area of Tpanel control ( Creating a Piano)

[Silvio.Falconi]

I'm trying to create a small piano and I have this ( made with Tpanel control )





the problem...

when I click the first tPanel white ( first white key) control it sound the note C

when I click the first tPanel black ( first black key) control it sound the same the note C because this black control is over the first tpanel white

the problem is when I click the first black key I click the white first key and not the black key ... I hope you understood

How I can reslve it ?

[Antonio Linares]

Silvio,

You could check when the mouse is over the black key and disable the white ones

[Silvio.Falconi]

where i can see a sample for make it ?

[Antonio Linares]

Silvio,

Try this:

oBlackPanel:bMMoved = { | nRow, nCol | oWhitePanel:Disable() }

If that works, next we will see how to enable an array of oWhitePanels again

[Silvio.Falconi]

no ..not work good...

this sample :

Code: Select all  Expand view

#include "fivewin.ch"
#include "constant.ch"

REQUEST HB_GT_GUI_DEFAULT

function Test()
Local oDlgPiano
Local nBottom   := 20
Local nRight    := 55
Local nWidth :=  Max( nRight * DLG_CHARPIX_W, 180 )
Local nHeight := nBottom * DLG_CHARPIX_H
Local oBianco,oNero
Local oBtnBianco[7]
Local oBtnNero[5]
Local oCursorBtn :=TCursor():New(,'HAND')

Local mTime:= 23

   DEFINE BRUSH oBianco COLOR CLR_WHITE
   DEFINE BRUSH oNero COLOR CLR_BLACK



   DEFINE DIALOG oDlgPiano   ;
   TITLE i18n("Virtual Piano")    ;
   SIZE nWidth, nHeight   PIXEL




      //tasti bianchi

       nRowTastoBianco:=10
       nHeightTastoBianco:=100
       ncolTastoBianco:= 2
       nwidthTastoBianco:= 20

 oBtnBianco[1]:=Tpanel():New(nRowTastoBianco,ncolTastoBianco,nHeightTastoBianco,nwidthTastoBianco,oDlgPiano)
              oBtnBianco[1]:oBrush:= oBianco
              oBtnBianco[1]:bLClicked  := { | x, y, z | Note(1) }
              oBtnBianco[1]:oCursor:=oCursorBtn
              oBtnBianco[1]:bMMoved = { | nRow, nCol | oBtnNero[1]:Disable() }

                ncolTastoBianco:=oBtnBianco[1]:nRight+2
                nwidthTastoBianco+= 20

              oBtnBianco[2]:=Tpanel():New(nRowTastoBianco,ncolTastoBianco,nHeightTastoBianco,nwidthTastoBianco,oDlgPiano)
              oBtnBianco[2]:oBrush:= oBianco
              oBtnBianco[2]:bLClicked  := { | x, y, z | Note(3) }
              oBtnBianco[2]:oCursor:=oCursorBtn

 nRowTastoNero:=10
       nHeightTastoNero:=60
       ncolTastoNero:= 15
       nwidthTastoNero:= 25


                oBtnNero[1]:=Tpanel():New(nRowTastoNero,ncolTastoNero,nHeightTastoNero,nwidthTastoNero,oDlgPiano)
                oBtnNero[1]:bLClicked  := { | x, y, z | Note(2) }
                oBtnNero[1]:oCursor:=oCursorBtn
                oBtnNero[1]:bMMoved = { | nRow, nCol | oBtnBianco[1]:Disable(),oBtnBianco[2]:Disable() }

                  for k= 1 to 1
                         oBtnNero[k]:oBrush:= oNero
                   next









   ACTIVATE DIALOG oDlgPiano
   RETUR NIL


Function note(mchoice)
   Local mtone
   Local mTime:= 23
   Do case
    CASE mchoice = 1
      mtone = 130.8
    CASE mchoice = 2
      mtone = 138.6
    CASE mchoice = 3
      mtone = 146.8
    CASE mchoice = 4
      mtone = 155.6
    CASE mchoice = 5
      mtone = 164.8
    CASE mchoice = 6
      mtone = 174.6
    CASE mchoice = 7
      mtone = 185
    CASE mchoice = 8
      mtone = 196
    CASE mchoice = 9
      mtone = 207.7
    CASE mchoice = 10
      mtone = 220
    CASE mchoice = 11
      mtone = 233.1
    CASE mchoice = 12
      mtone = 246.9

   Endcase


      tone(mtone,mTime)



   return nil
 

[cnavarro]

Silvio
No entiendo lo que quieres decir
Esto funciona bien para mi

I do not understand what you mean
This works fine for me

Code: Select all  Expand view

#include "fivewin.ch"
#include "constant.ch"

REQUEST HB_GT_GUI_DEFAULT

function Main()  //Test()
Local oDlgPiano
Local nBottom   := 40 //20
Local nRight    := 75 //55
Local nWidth :=  Max( nRight * DLG_CHARPIX_W, 180 )
Local nHeight := nBottom * DLG_CHARPIX_H
Local oBianco,oNero
Local oBtnBianco[7]
Local oBtnNero[5]
Local oCursorBtn :=TCursor():New(,'HAND')
Local       nRowTastoBianco:=10
Local       nHeightTastoBianco:=100
Local       ncolTastoBianco:= 2
Local       nwidthTastoBianco:= 20
Local   k
Local       nHeightTastoNero:=60
Local       ncolTastoNero:= 15
Local       nwidthTastoNero:= 25
Local       nrowTastoNero


Local mTime:= 23

   DEFINE BRUSH oBianco COLOR CLR_WHITE
   DEFINE BRUSH oNero COLOR CLR_BLACK



   DEFINE DIALOG oDlgPiano   ;
   TITLE i18n("Virtual Piano")    ;
   SIZE nWidth, nHeight   PIXEL




      //tasti bianchi

       nRowTastoBianco:=10
       nHeightTastoBianco:=100
       ncolTastoBianco:= 2
       nwidthTastoBianco:= 20

 oBtnBianco[1]:=Tpanel():New(nRowTastoBianco,ncolTastoBianco,nHeightTastoBianco,nwidthTastoBianco,oDlgPiano)
              oBtnBianco[1]:oBrush:= oBianco
              oBtnBianco[1]:bLClicked  := { | x, y, z | Note(x,y,z,1) }
              //oBtnBianco[1]:oCursor:=oCursorBtn
              //oBtnBianco[1]:bMMoved = { | nRow, nCol | oBtnNero[1]:Disable() }

                ncolTastoBianco:=oBtnBianco[1]:nRight+2
                nwidthTastoBianco+= 20

              oBtnBianco[2]:=Tpanel():New(nRowTastoBianco,ncolTastoBianco,nHeightTastoBianco,nwidthTastoBianco,oDlgPiano)
              oBtnBianco[2]:oBrush:= oBianco
              oBtnBianco[2]:bLClicked  := { | x, y, z | Note(x,y,z,3) }
              //oBtnBianco[2]:oCursor:=oCursorBtn

       nRowTastoNero:=10
       nHeightTastoNero:=60
       ncolTastoNero:= 15
       nwidthTastoNero:= 25


                oBtnNero[1]:=Tpanel():New(nRowTastoNero,ncolTastoNero,nHeightTastoNero,nwidthTastoNero,oDlgPiano)
                oBtnNero[1]:bLClicked  := { | x, y, z | Note(x,y,z,2) }
                //oBtnNero[1]:oCursor:=oCursorBtn
                //oBtnNero[1]:bMMoved = { | nRow, nCol | oBtnBianco[1]:Disable(),oBtnBianco[2]:Disable() }

                  for k= 1 to 1
                         oBtnNero[k]:oBrush:= oNero
                   next

   ACTIVATE DIALOG oDlgPiano
   RETUR NIL


Function note(x,y,z,mchoice)
   Local mtone
   Local mTime:= 0.23
   Do case
    CASE mchoice = 1
      mtone = 130.8
      ? 1
    CASE mchoice = 2
      mtone = 138.6
      ? 2
    CASE mchoice = 3
      mtone = 146.8
      ? 3
    CASE mchoice = 4
      mtone = 155.6
    CASE mchoice = 5
      mtone = 164.8
    CASE mchoice = 6
      mtone = 174.6
    CASE mchoice = 7
      mtone = 185
    CASE mchoice = 8
      mtone = 196
    CASE mchoice = 9
      mtone = 207.7
    CASE mchoice = 10
      mtone = 220
    CASE mchoice = 11
      mtone = 233.1
    CASE mchoice = 12
      mtone = 246.9

   Endcase


      tone(mtone, mTime)



   return nil
 
 

[Silvio.Falconi]

Dear cNavarro,
If you press the first white panel it play the note C and the msginfo is 1
If you press the black panel on area is on first white panel it play the note C and the msginfo is 1 but it is wrong because it must play c# and the msginfo must be = 2
If you press the black panel on area is on second white panel it play the note D and the msginfo is 3 but it is wrong because it must play c# and the msginfo must be = 2


Dear Antonio,
I saw there is a function PtInRect( ) , it could be usefull to click on right coordinates ...
can you make a sample or where I can see a small sample with this function ?

[Antonio Linares]

Silvio,

In FWH\source\classes\vistamnu.prg there is an example of use

[nageswaragunupudi]

Silvio

Please try this Piano.Prg

Code: Select all  Expand view

/*
*
*  Piano.prg
*  G.N.Rao
*
*/

#include "fiveWin.Ch"

Static aTone   := { 130.8, 138.6, 146.8, 155.6, 164.8, 174.6, 185, 196, 207.7, 220, 233.1, 246.9 }
static aWhite, aBlack

// Configuration Parameters
static aDlgMargin := { 20, 20, 20, 20 }  // top, left, bottom, right
static nHtWhite   := 200
static nWdWhite   := 40
static nHtBlack   := 120
static nWdBlack   := 20
static nDuration  := 23

//----------------------------------------------------------------------------//

function Main()

   local oDlg

   PrepareKeys()

   DEFINE DIALOG oDlg SIZE ;
      aWhite[7][3][4]+aDlgMargin[ 4 ], aWhite[1][3][3]+aDlgMargin[ 3 ] ;
      PIXEL COLOR CLR_BLACK, CLR_HGRAY TITLE "PIANO"

   ACTIVATE DIALOG oDlg CENTERED ;
      ON PAINT PaintPiano( hDC, oDlg ) ;
      ON CLICK PlayPiano( nRow, nCol )

return nil

//----------------------------------------------------------------------------//

static function PaintPiano( hDC, oDlg )

   local hBrush
   local aKey

   hBrush      := CreateSolidBrush( CLR_WHITE )
   for each aKey in aWhite
      FillRect( hDC, aKey[ 3 ], hBrush )
   next
   DeleteObject( hBrush )

   hBrush   := CreateSolidBrush( CLR_BLACK )
   for each aKey in aBlack
      FillRect( hDC, aKey[ 3 ], hBrush )
   next
   DeleteObject( hBrush )

return nil

//----------------------------------------------------------------------------//

static function PlayPiano( nRow, nCol )

   local n, aKey

   for each aKey in { aBlack, aWhite }
      if nRow >= aKey[ 1 ][ 3 ][ 1 ] .and. nRow < aKey[ 1 ][ 3 ][ 3 ]
         for n := 1 to Len( aKey )
            if nCol >= aKey[ n ][ 3 ][ 2 ]
               if nCol < aKey[ n ][ 3 ][ 4 ]
                  TONE( aKey[ n ][ 2 ], 23 )
                  return nil
               endif
            else
               EXIT
            endif
        next
      endif
   next

return nil

//----------------------------------------------------------------------------//

static function PrepareKeys()

   local nGap        :=   4
   local n, nTop, nLeft, nBottom

   aWhite      := {}
   nTop        := aDlgMargin[ 1 ]
   nLeft       := aDlgMargin[ 2 ]
   nBottom     := nTop + nHtWhite

   for each n in { 1, 3, 5, 6, 8, 10, 12 }
      AAdd( aWhite, { n, aTone[ n ], { nTop, nLeft, nBottom, nLeft + nWdWhite } } )
      nLeft    += ( nWdWhite + nGap )
   next

   aBlack      := {}
   nLeft       := aDlgMargin[ 2 ] + nWdWhite - Int( nWdBlack / 2 )
   nBottom     := nTop + nHtBlack

   for each n in { 2, 4, 7, 9, 11 }
      AAdd( aBlack, { n, aTone[ n ], { nTop, nLeft, nBottom, nLeft + nWdBlack } } )
      nLeft    += ( nWdWhite + nGap )
      if n == 4
         nLeft    += ( nWdWhite + nGap )
      endif
   next

return nil

//----------------------------------------------------------------------------//
 

[Silvio.Falconi]

,.

[Silvio.Falconi]

for write the note ...I'm trying with

Code: Select all  Expand view

#define SRCCOPY  13369376
#define DT_TOP                      0x00000000
#define DT_LEFT                     0x00000000
#define DT_CENTER                   0x00000001
#define DT_RIGHT                    0x00000002
#define DT_VCENTER                  0x00000004
#define DT_BOTTOM                   0x00000008
#define DT_WORDBREAK                0x00000010
#define DT_SINGLELINE               0x00000020
#define DT_EXPANDTABS               0x00000040
#define DT_TABSTOP                  0x00000080
#define DT_NOCLIP                   0x00000100
#define DT_EXTERNALLEADING          0x00000200
#define DT_CALCRECT                 0x00000400
#define DT_NOPREFIX                 0x00000800
#define DT_INTERNAL                 0x00001000

  DEFINE FONT oFont NAME GetSysFont() SIZE 0, -9 bold

DEFINE DIALOG oDlg SIZE ;
      aWhite[7][3][4]+aDlgMargin[ 4 ], aWhite[1][3][3]+aDlgMargin[ 3 ] ;
      PIXEL COLOR CLR_BLACK, CLR_HGRAY TITLE "PIANO"  [b]FONT oFont[/b]



static function PaintPiano( hDC, oDlg )

   local hBrush
   local aKey
   local aWhite_Text   := {"C","D","E","F","G","A","B" }
   local aBlack_Text   := {"C#","D#","F#","G#","A#"}


    n:= 1
   hBrush      := CreateSolidBrush( CLR_WHITE )
   for each aKey in aWhite
      FillRect( hDC, aKey[ 3 ], hBrush )
   nMode     := SetBkMode( hDC, 1 )
   nColor := SetTextColor( hDC, CLR_BLACK )
   hFont     := if(oDlg:oFont != nil,oDlg:oFont:hFont, GetDefFont())
   hOldFont  := SelectObject( hDC, hFont )
   DrawText( hDC, aWhite_Text[n] ,aKey[ 3 ] , nOr( DT_SINGLELINE, DT_VCENTER, DT_RIGHT ))
   SetBkMode( hDC, nMode )
   n:= n+1
   next
   DeleteObject( hBrush )


   n:= 1
   hBrush   := CreateSolidBrush( CLR_BLACK )
   for each aKey in aBlack
      FillRect( hDC, aKey[ 3 ], hBrush )
   nMode     := SetBkMode( hDC, 1 )
   nColor := SetTextColor( hDC, CLR_YELLOW )
   hFont     := if(oDlg:oFont != nil,oDlg:oFont:hFont, GetDefFont())
   hOldFont  := SelectObject( hDC, hFont )
   DrawText( hDC, aBlack_Text[n] ,aKey[ 3 ] , nOr( DT_SINGLELINE, DT_VCENTER, DT_RIGHT ))
   SetBkMode( hDC, nMode )
   n:= n+1
   next
   DeleteObject( hBrush )


return nil

 

the result





How I can move the text on white keys ?

[Silvio.Falconi]

Found !!!!

aKey[ 3 ][1]+= 80
aKey[ 3 ][2]+= 20

the result

Code: Select all  Expand view

static function PaintPiano( hDC, oDlg )

   local hBrush
   local aKey
   local aWhite_Text   := {"C","D","E","F","G","A","B" }
   local aBlack_Text   := {"C#","D#","F#","G#","A#"}


   n:= 1
   hBrush      := CreateSolidBrush( CLR_WHITE )
   for each aKey in aWhite
      FillRect( hDC, aKey[ 3 ], hBrush )
   nMode     := SetBkMode( hDC, 1 )
   nColor := SetTextColor( hDC, CLR_BLACK )
   hFont     := if(oDlg:oFont != nil,oDlg:oFont:hFont, GetDefFont())
   hOldFont  := SelectObject( hDC, hFont )
   aKey[ 3 ][1]+= 80
   aKey[ 3 ][2]+= 20
   DrawText( hDC, aWhite_Text[n] ,aKey[ 3 ] , nOr( DT_SINGLELINE,DT_VCENTER,DT_VCENTER ))
   SetBkMode( hDC, nMode )
   n:= n+1
   aKey[ 3 ][1]-= 80
   aKey[ 3 ][2]-= 20
   next
   DeleteObject( hBrush )


   n:= 1
   hBrush   := CreateSolidBrush( CLR_BLACK )
   for each aKey in aBlack
      FillRect( hDC, aKey[ 3 ], hBrush )
   nMode     := SetBkMode( hDC, 1 )
   nColor := SetTextColor( hDC, CLR_YELLOW )
   hFont     := if(oDlg:oFont != nil,oDlg:oFont:hFont, GetDefFont())
   hOldFont  := SelectObject( hDC, hFont )
   DrawText( hDC, aBlack_Text[n] ,aKey[ 3 ] , nOr( DT_SINGLELINE, DT_VCENTER, DT_RIGHT ))
   SetBkMode( hDC, nMode )
   n:= n+1


   next
   DeleteObject( hBrush )


return nil

[Silvio.Falconi]

.

[Antonio Linares]

Rao, Silvio,

Very nice

[nageswaragunupudi]

Please try this with #define METHOD1 and also commenting out //#define METHOD1.
Are you sure the frequencies are right?

Is it possible to stop the Tone when the user presses another key?

Code: Select all  Expand view

/*
*
*  Piano.prg
*  G.N.Rao
*
*/

#include "fiveWin.Ch"

#define METHOD1

#ifdef METHOD1
static aTone        := { 130.8, 138.6, 146.8, 155.6, 164.8, 174.6, 185, 196, 207.7, 220, 233.1, 246.9,;
                         261.7, 277.2, 293.7, 311.1, 329.6,349.2,370, 415.3, 440, 466.2, 493.9, 523.3 }
#else
static aTone := {  262, 277, 294, 311, 330, 349, 370, 392, 415, 440, 460, 494, ;
                   523, 554, 587, 622, 659, 698, 740, 784, 831, 880, 932, 988, ;
                  1047,1109,1175,1244,1318,1397,1480,1568,1661,1760,1865,1976, ;
                  2094,2218,2350,2489,2637,2794,2960,3136,3322,3520,3730,3951, ;
                  4187 }
#endif

static aWhite, aBlack

// Configuration Parameters
static aDlgMargin := { 20, 20, 20, 20 }  // top, left, bottom, right
static nHtWhite   := 200
static nWdWhite   := 40
static nHtBlack   := 120
static nWdBlack   := 20
static nDuration  := 23
static nKeyPress  := 0
static nOctaves   := 4

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oFont

   nOctaves       := Min( nOctaves, Int( Len( aTone ) / 12 ) )
   PrepareKeys()

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-10 BOLD
   DEFINE DIALOG oDlg FONT oFont SIZE ;
      ATail( aWhite )[3][4]+aDlgMargin[ 4 ], aWhite[1][3][3]+aDlgMargin[ 3 ] ;
      PIXEL COLOR CLR_BLACK, CLR_HGRAY TITLE "PIANO"

   ACTIVATE DIALOG oDlg CENTERED ;
      ON PAINT PaintPiano( hDC, oDlg ) ;
      ON CLICK PlayPiano( nRow, nCol, oDlg )

   RELEASE FONT oFont

return nil

//----------------------------------------------------------------------------//

static function PaintPiano( hDC, oDlg )

   local hBrush, hBrush2
   local aKey

   hBrush      := CreateSolidBrush( CLR_WHITE )
   for each aKey in aWhite
      if aKey[ 1 ] == nKeyPress
         hBrush2 := CreateSolidBrush( RGB(255,255,150) )
         FillRect( hDC, aKey[ 3 ], hBrush2 )
         DeleteObject( hBrush2 )
      else
         FillRect( hDC, aKey[ 3 ], hBrush )
      endif
      PaintLabel( hDC, aKey[ 4 ], aKey[ 3 ], oDlg:oFont, CLR_BLACK )
   next
   DeleteObject( hBrush )

   hBrush   := CreateSolidBrush( CLR_BLACK )
   for each aKey in aBlack
      if aKey[ 1 ] == nKeyPress
         hBrush2 := CreateSolidBrush( CLR_GRAY )
         FillRect( hDC, aKey[ 3 ], hBrush2 )
         DeleteObject( hBrush2 )
      else
         FillRect( hDC, aKey[ 3 ], hBrush )
      endif
      PaintLabel( hDC, aKey[ 4 ], aKey[ 3 ], oDlg:oFont, CLR_YELLOW )
   next
   DeleteObject( hBrush )

return nil

//----------------------------------------------------------------------------//

static function PaintLabel( hDC, cLabel, aRect, oFont, nColor )

   local nMode

   if Len( cLabel ) == 1  // White Key
      aRect    := AClone( aRect )
      aRect[ 1 ]  += nHtBlack
   endif

   nMode       := SetBkMode( hDC, 1 )
   SetTextColor( hDC, nColor )
   oFont:Activate( hDC )
   DrawText( hDC, cLabel ,aRect , 0x25 ) // DT_SINGLELINE + DT_VCENTER + DT_CENTER
   oFont:DeActivate( hDC )
   SetBkMode( hDC, nMode )



return nil

//----------------------------------------------------------------------------//

static function PlayPiano( nRow, nCol, oDlg )

   local n, aKey

   for each aKey in { aBlack, aWhite }
      if nRow >= aKey[ 1 ][ 3 ][ 1 ] .and. nRow < aKey[ 1 ][ 3 ][ 3 ]
         for n := 1 to Len( aKey )
            if nCol >= aKey[ n ][ 3 ][ 2 ]
               if nCol < aKey[ n ][ 3 ][ 4 ]
                  nKeyPress   := aKey[ n ][ 1 ]
                  oDlg:Refresh()
                  SysRefresh()
#ifdef METHOD1
                  TONE( aKey[ n ][ 2 ], nDuration )
#else
                  TONE_2( aKey[ n ][ 2 ], "1/2" )
#endif
                  nKeyPress   := 0
                  oDlg:Refresh()
                  SysRefresh()
                  return nil
               endif
            else
               EXIT
            endif
        next
      endif
   next

return nil

//----------------------------------------------------------------------------//

static function PrepareKeys()

   local nGap        :=   4
   local n, x, nTop, nLeft, nBottom
   local nOctave
   local aLabel    := { "C", "C#", "D", "D#", "E", "F", "F#", "G", "G#", "A", "A#", "B" }

   aWhite      := {}
   nTop        := aDlgMargin[ 1 ]
   nLeft       := aDlgMargin[ 2 ]
   nBottom     := nTop + nHtWhite

   x           := 0
   for nOctave := 1 to nOctaves
      for each n in { 1, 3, 5, 6, 8, 10, 12 }
         AAdd( aWhite, { x + n, aTone[ x + n ], { nTop, nLeft, nBottom, nLeft + nWdWhite }, aLabel[ n ] } )
         nLeft    += ( nWdWhite + nGap )
      next
      x        += 12
   next

   aBlack      := {}
   nLeft       := aDlgMargin[ 2 ] + nWdWhite - Int( nWdBlack / 2 )
   nBottom     := nTop + nHtBlack

   x           := 0
   for nOctave := 1 to nOctaves
      for each n in { 2, 4, 7, 9, 11 }
         AAdd( aBlack, { x + n, aTone[ x + n ], { nTop, nLeft, nBottom, nLeft + nWdBlack }, aLabel[ n ] } )
         nLeft    += ( nWdWhite + nGap )
         if n == 4
            nLeft    += ( nWdWhite + nGap )
         endif
      next
      nLeft    += ( nWdWhite + nGap )
      x        += 12
   next

return nil

//----------------------------------------------------------------------------//

static function TONE_2( nFreq, cTempo ) // cTempo can be "1/2", "1/4", "1/8"

   local nTime

   DEFAULT cTempo := "1/2"

   nTime    := &cTempo
   nTime    *= 24

return TONE( nFreq, nTime )

//----------------------------------------------------------------------------//

#pragma BEGINDUMP

/*
   Author: Andi Jahja <harbour@cbn.net.id>

   TONE() for Windows to replace the ugly-heard GT Tone :-)
   Mono approach. Duration has been roughly estimated to be Cli**per-like,
   please refer to tests/sound.prg.
   Using Windows MMsystem, sound card is a must in order to make
   this function work.

   Syntax: TONE( nFreq, nDuration, [ lSmooth ], [ nVol ] ) -> NIL

   nFreq     = INTEGER, Tone frequency
   nDuration = NUMERIC, Duration Time, as in Cl**per
   lSmooth   = LOGICAL, pass .F. to disable sound smoothing, default is .T.
   nVol      = INTEGER, Sound Intensity/Volume, value 0 - 127, Default 127 ( Max )

*/

#include "hbapi.h"
#include <windows.h>
#include <mmsystem.h>
#include <math.h>

#ifndef __XHARBOUR__
   #define ISLOG( n )            HB_ISLOG( n )
   #define ISNUM( n )            HB_ISNUM( n )
#endif

#define SAMPLING_RATE 44100

void HB_EXPORT hb_winTone( UINT, double, BOOL, UINT );

HB_FUNC( TONE )
{
   if ISNUM( 1 )
   {
      hb_winTone( hb_parni( 1 ),
                ( ISNUM( 2 ) ? hb_parnd( 2 ) : 1.0 ) * 2100,
                  ISLOG( 3) ? hb_parl( 3 ) : TRUE,
                  ISNUM( 4 ) ? hb_parni( 4 ) : 127 );
   }
}

/* Keep it here for access from C programs */
void HB_EXPORT hb_winTone( UINT uFrequency, double dwDuration, BOOL bSmoothing, UINT uVolume )
{
   WAVEFORMATEX wfx;
   HWAVEOUT hWaveOut = NULL;

   wfx.wFormatTag = WAVE_FORMAT_PCM;
   wfx.nChannels = 1;
   wfx.nSamplesPerSec = SAMPLING_RATE;
   wfx.nAvgBytesPerSec = SAMPLING_RATE;
   wfx.nBlockAlign = 1;
   wfx.wBitsPerSample = 8;
   wfx.cbSize = 0;

   /*
   WAVE_MAPPER is the most commonly used device
   CallBack is unnecessary since we only play simple tone
   */
   if( waveOutOpen( &hWaveOut, WAVE_MAPPER, &wfx, NULL, NULL, CALLBACK_NULL ) == MMSYSERR_NOERROR )
   {
      char amp = uVolume;
      int i;
      unsigned char* buffer = (unsigned char*) hb_xgrab( (ULONG) dwDuration );
      double dKoef = uFrequency * 2 * 3.14159 / SAMPLING_RATE;
      WAVEHDR wh;

      if ( buffer )
      {
         wh.lpData = (LPSTR) buffer;
         wh.dwBufferLength = (DWORD) dwDuration;
         wh.dwFlags = WHDR_BEGINLOOP;
         wh.dwLoops = 1;

         if( waveOutPrepareHeader( hWaveOut, &wh, sizeof( wh ) ) == MMSYSERR_NOERROR )
         {
            wh.dwFlags = WHDR_BEGINLOOP | WHDR_ENDLOOP | WHDR_PREPARED;
            wh.dwLoops = 1;

            if ( bSmoothing )
            {
               /*
               Manipulating data to smooth sound from clicks at the start
               and end (particularly noted when we call TONE() many times
               in a row). This is a simulation of increasing volume gradually
               before it reaches the peak, and decreasing volume gradually
               before it reaches the end.
               */
               for( i = 0; i < dwDuration; i++ )
               {
                  if ( i < amp )
                  {
                     buffer[ i ] = (unsigned char) ( cos( i * dKoef ) * i + 127 );
                  }
                  else if ( dwDuration - i <= amp - 1  )
                  {
                     amp = max( 0, --amp );
                     buffer[ i ] = (unsigned char) ( cos( i * dKoef ) * amp + 127 );
                  }
                  else
                  {
                     buffer[ i ] = (unsigned char) ( cos( i * dKoef ) * amp + 127 );
                  }
               }
            }
            else
            {
               /*
               Raw sound, may cause annoying clicks when some tones are played
               in a row.
               */
               for( i = 0; i < (int) dwDuration; i++ )
               {
                  buffer[ i ] = (unsigned char) ( cos( i * dKoef ) * amp + 127 );
               }
            }

            /*
            Play the sound here
            */
            if ( waveOutWrite( hWaveOut, &wh, sizeof(WAVEHDR) ) == MMSYSERR_NOERROR )
            {
               /*
               Wait until the sound is finished
               */
               while (!(wh.dwFlags & WHDR_DONE))
               {
                  Sleep( 1 );
               }

               waveOutUnprepareHeader(hWaveOut, &wh, sizeof(WAVEHDR));
            }
         }

         hb_xfree( buffer );
      }
   }
}

#pragma ENDDUMP

//----------------------------------------------------------------------------//