# Sources PureBasicConsultez toutes les sources

Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011

Sommaire→Gadgets→CanvasGadget

- Pavé de boutons en cercle
- Boutons à bascule (Interrupteurs)
- Explorateur musical

Version hors-ligne
Pavé de boutons en cercle
Sélectionnez

    ;CanvasGadget Circular ButtonPad test
    ; by einander - PureBasic 4.60 Beta 3
    EnableExplicit
    #DEGTORAD=#PI/180.0  ; degrees to radian
    ;
    Macro CanvasMX(Canvas)
      GetGadgetAttribute(Canvas, #PB_Canvas_MouseX)
    EndMacro
    ;
    Macro CanvasMY(Canvas)
      GetGadgetAttribute(Canvas, #PB_Canvas_MouseY)
    EndMacro
    ;
    Procedure  CenterText(X,Y,X1,Y1,Tx.S,TextRGB=0,BkRGB=#White)
      Protected TWi=TextWidth(Tx),THe=TextHeight(Tx)
      DrawingMode(#PB_2DDrawing_Transparent)
      If TWi >X1-X
        DrawText(X,(Y1+Y)/2-THe/2 , Tx, TextRGB)
      Else
        DrawText((X1+X)/2-TWi/2, (Y1+Y)/2-THe/2 , Tx, TextRGB)
      EndIf
    EndProcedure
    ;
    Procedure AngleEndPoint(X,Y,Ang.F,Radius.F,*P.POINT) ; Ret circular end pointF for line, angle, size
      *P\X= X+Cos(Ang*#DEGTORAD)*Radius
      *P\Y= Y+Sin(Ang*#DEGTORAD)*Radius
    EndProcedure
    ;
    Procedure Canvas8Arrows(Canvas,Font,Array Pts.Point(1),Array Indx.I(1),Siz.F,Stp.F,Detach=-1,Hover=-1)
      Protected I,RGB,t$,SPi.F=Siz*#PI
      DrawingFont(Font)
      Restore Arrows
      Box(0,0,GadgetWidth(Canvas),GadgetHeight(Canvas),0)
      For I=0 To 7
        Read.I Indx(I)
        AngleEndPoint(Spi,Spi,I*Stp,Siz*2,@Pts(I))
        T$=Chr(230+Indx(I)) ;here change 230 for your offset (try 65 for text fonts) <<<<<<<
        If Detach>-1 And I=Detach:RGB=#Red
        ElseIf Hover>-1 And I=Hover And Hover<>Detach:RGB=#Green
        Else :RGB=#White
        EndIf
        CenterText(Pts(I)\X-TextWidth(T$)/2,Pts(I)\Y,Pts(I)\X,Pts(I)\Y,T$,RGB,0)
      Next
    EndProcedure
    ;
    Macro GetDistance(A1,A2)
      Sqr(Pow(A1,2) + Pow(A2,2))
    EndMacro
    ;
    Procedure Near(X, Y, Array P.POINT(1)) ; Return elem de Array de Points Nearest to  x,y
      Protected A,I,J,Min = $FFFFFFF
      For I = 0 To ArraySize(P())
        A = GetDistance(X - P(I)\X, Y - P(I)\Y)
        If A < Min  : Min = A  : J = I  : EndIf
      Next I
      ProcedureReturn J
    EndProcedure
    ;
    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    OpenWindow(0, 100, 100,600,500 ,"CanvasGadget Button Pad",#PB_Window_SystemMenu|1)
    SetWindowColor(0,$112233)
    Define PadSize=120  ; <<<<<< change here to your preferred size
    Define Ev,I,Detach=-1,Hover=-1,Draw
    Define.F Siz=PadSize/(#PI*2),Stp=360/8
    Define Font1=FontID(LoadFont(#PB_Any,"Wingdings",Siz,#PB_Font_HighQuality))
    ;Define Font1=FontID(LoadFont(#PB_Any,"Arial",Siz,#PB_Font_HighQuality))

    Dim PTS.Point(7)
    Dim Indx.I(7)

    Define Ca1=CanvasGadget(#PB_Any,200,200,PadSize,PadSize, #PB_Canvas_Keyboard)
    StartDrawing(CanvasOutput(Ca1))
    Canvas8Arrows(Ca1,Font1,Pts(),Indx(),Siz,Stp)
    StopDrawing()
    Repeat
      If GetAsyncKeyState_(27)&$8000 :  End : EndIf
      EV=WaitWindowEvent()
      Select Ev
        Case #PB_Event_Gadget
          Select EventGadget()
            Case Ca1
              Select EventType()
                Case  #PB_EventType_LeftButtonDown
                  Detach=Near(CanvasMX(Ca1),CanvasMY(Ca1),Pts())
                  Draw=1
                Case  #PB_EventType_MouseMove
                  Hover=Near(CanvasMX(Ca1),CanvasMY(Ca1),Pts())
                  Draw=1
                Case  #PB_EventType_MouseLeave
                  Hover=-1
                  Draw=1
              EndSelect
          EndSelect
          If Draw
            StartDrawing(CanvasOutput(Ca1))
            Canvas8Arrows(Ca1,Font1,Pts(),Indx(),Siz,Stp,Detach,Hover)
            StopDrawing()
            SetWindowTitle(0,"Hover "+Str(Hover)+"   Detach "+Str(Detach))
            Draw=0
          EndIf
      EndSelect
    Until EV=#PB_Event_CloseWindow
    End
    ;
    DataSection
      Arrows:
      Data.I 2,8,4,7,1,5,3,6 ; for WingDings
      ;Data.i 0,1,2,3,4,5,6,7 ; for text fonts
    EndDataSection

Créé le 16 juillet 2011 par einander
Boutons à bascule (Interrupteurs)
Sélectionnez

    ;Canvas Toggle Buttons
    ;by einander - PureBasic 4.60 Beta 3
    EnableExplicit
    Enumeration ; 6 CanvasButton states
      #Normal=0
      #Selected
      #Pressed
      #HoverSelected
      #HoverUnSelected
      #Disabled
    EndEnumeration
    Global Dim _Stat$(6)
    _Stat$(2)="Pressed"
    _Stat$(3)="HoverSelected"
    _Stat$(4)="HoverUnSelected"
    _Stat$(5)="Disabled"
    Global _Myfont10=FontID(LoadFont(#PB_Any,"arial",10))
    Global _Myfont12=FontID(LoadFont(#PB_Any,"times new roman",12))
    Global _Myfont14=FontID(LoadFont(#PB_Any,"georgia",14))
    Global _Myfont16=FontID(LoadFont(#PB_Any,"impact",16))
    ;
    Structure BtnColors
      TextRGB.L
      BackRGB.L
    EndStructure
    ;
    Structure CanvasButton
      Indx.I
      gNum.I
      FontID.I
      Text.S
      Selected.I
      Stat.I
      RGB.BtnColors[6] ; Colors :\L1=TextColor, \L2=BackColor
    EndStructure
    ;
    Procedure CenterTxt(X,Y,Wi,He,Text.S)
      Protected TextWidth=TextWidth(Text),TextHeight=TextHeight(Text)
      Protected X1=X+Wi,Y1=Y+He
      If TextWidth>Wi :  DrawText(X,(Y+Y1)/2-TextHeight/2 , Text)
      Else            :  DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , Text)
      EndIf
    EndProcedure

    Procedure CBDraw(*CB.CanvasButton)
      With *Cb
        Protected Wi=GadgetWidth(*Cb\gNum)
        Protected He=GadgetHeight(*Cb\gNum)
        Protected Img=CreateImage(#PB_Any,Wi,He)
        StartDrawing(ImageOutput(Img))   ;background Color, Gradient with #White
        DrawingMode(#PB_2DDrawing_Gradient)
        FrontColor(\RGB[\Stat]\BackRGB)
        BackColor(#White)
        LinearGradient(Wi/2,0, Wi/2,He)    ; try  (0,0,Wi,He) to diagonal Gradient
        Box(0,0,Wi,He)
        DrawingMode(#PB_2DDrawing_Transparent) ; Button Text
        DrawingFont(\Fontid)
        FrontColor(\RGB[\Stat]\TextRGB)
        CenterTxt(0,0,Wi,He,\Text)
        StopDrawing()
        SetGadgetAttribute(*Cb\gNum,#Pb_Canvas_Image,ImageID(Img))
        FreeImage(Img)
      EndWith
    EndProcedure
    ;
    Procedure CanvasButton(CBNum,X,Y,Wi,He,Text.S,Fontid,Indx,*Cb.CanvasButton,Flags=-1)
      Protected I
      With *Cb
        If Flags=-1:Flags=#Pb_Canvas_Keyboard
        Else       :Flags|#Pb_Canvas_Keyboard
        EndIf
        \Text=Text
        \gNum =CanvasGadget(CBNum,X,Y,Wi,He,Flags)
        If CBNum<>#PB_Any:\gNum=CBNum:EndIf
        SetGadgetAttribute(\gNum,#Pb_Canvas_Cursor,#Pb_Cursor_Hand)
        \Fontid=Fontid
        \Indx=Indx
        Restore BtnColors
        For I=0 To 5
          Read.I \RGB[I]\TextRGB
          Read.I \RGB[I]\BackRGB
        Next
        CBDraw(*Cb)
      EndWith
    EndProcedure
    ;
    Procedure  GetCanvasState(*Cb.CanvasButton)
      With *Cb
        Select EventType()
          Case  #PB_EventType_LeftButtonDown
            \Selected!1   :\Stat=#Pressed         : CBDraw(*Cb)
          Case #Pb_EventType_MouseEnter,#Pb_EventType_LeftButtonup
            If \Selected  :\Stat=#HoverSelected   : CBDraw(*Cb)
            Else          :\Stat=#HoverUnSelected : CBDraw(*Cb)
            EndIf
          Case #Pb_EventType_Mouseleave
            If \Selected  :\Stat=#Selected        : CBDraw(*Cb)
            Else          :\Stat=#Normal          : CBDraw(*Cb)
            EndIf
        EndSelect
        If \Stat>1: ProcedureReturn \Stat:EndIf
      EndWith
    EndProcedure
    ;
    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    OpenWindow(0, 100, 100,700,500 ,"Canvas Toggle Buttons",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    SetWindowColor(0,0)
    Define Ev,Flags,State
    Define CB1.CanvasButton
    Define CB2.CanvasButton
    Define CB3.CanvasButton
    Define CB4.CanvasButton
    Define *Sel.CanvasButton=0
    Flags=#Pb_Canvas_Border ; try with and without border; #PB_Canvas_Keyboard is Activated on procedure CanvasButton()
    CanvasButton(#PB_Any,100,100,100,25,"Button 1",_Myfont10,1,@Cb1,Flags) ; last parameter optative
    CanvasButton(#PB_Any,100,150,130,30,"Button 2",_Myfont12,2,@Cb2,Flags)
    CanvasButton(#PB_Any,100,200,160,38,"Button 3",_Myfont14,3,@Cb3,Flags)
    CanvasButton(#PB_Any,100,250,200,50,"Button 4",_Myfont16,4,@Cb4,Flags)
    Repeat
      EV=WaitWindowEvent()
      Select Ev
        Case #PB_Event_Gadget
          Select EventGadget()
            Case Cb1\gNum : *Sel=Cb1
            Case Cb2\gNum : *Sel=Cb2
            Case Cb3\gNum : *Sel=Cb3
            Case Cb4\gNum : *Sel=Cb4
          EndSelect
          State=GetCanvasState(*Sel)
          If State
            SetWindowTitle(0,"Button "+Str(*Sel\Indx)+" "+_Stat$(State))
          Else
            SetWindowTitle(0,"")
          EndIf
      EndSelect
    Until EV=#PB_Event_CloseWindow
    End
    ;
    DataSection   ; try here other color pairs <<<<<<<<<<<<<
      BtnColors:
      Data.I $464646 , $888888   ;Normal           : DarkGray, LightGray
      Data.I $0000FF , $6666FF   ;Selected         : Red, Light Red
      Data.I $000000 , $0082FF    ;Pressed          : Black, Dark Orange
      Data.I $FF00FF , $00A5FF   ;HoverSelected    : Magenta, Orange
      Data.I $000000 , $00A5FF   ;HoverUnSelected  : Black, Orange
      Data.I $888888 , $CECECE   ;Disabled         : Light Gray , Pale Gray
    EndDataSection

Créé le 16 juillet 2011 par einander
Explorateur musical
Sélectionnez

    ;Music Scales Explorer
    ;by einander - PureBasic 4.60 Beta 3
    EnableExplicit
    Define I,Midi.MidioutCaps
    Global _DraWing,_HMidiout,_Quit,_SpRoot
    Global _MyFont12=FontID(LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality))
    #NoteOff      = $80
    #NoteOn       = $90
    #CtrlChg      = $B0
    #AllSoundOff  = $7800
    #WayLeft      = 1
    #WayRight     = 2
    #CHROMATIC$   = "C C#D EbE F F#G AbA BbB C "     ;2 Chars per Note,  mixed # b
    #MSEC         = 60000.0    ; milliseconds in 1 minute
    Enumeration     ; 6 CanvasButton States
      #Normal=0
      #Selected
      #Pressed
      #HoverSelected
      #HoverUnSelected
      #Disabled
    EndEnumeration
    ;
    Structure BtnColors
      TextRGB.L
      BackRGB1.L
      BackRGB2.L
    EndStructure
    ;
    Structure CanvasButton
      Indx.I
      gNum.I
      FontID.I
      Selected.I
      State.I
      RGB.BtnColors[6] ; Colors :\L1=TextColor, \L2=BackColor
      Text.S{2}
    EndStructure
    ;
    Structure MidiThread
      Indx.I
      Chan.A ; Midi Channel 0/15
      Vel.A  ; Midi velocity 0/127
      InStrument.I
      Ove.I  ; Midi octave 0/10
      Thread.I
      BPM.F
      BeatDuration.F
      Denom.F
      Loop.I
      BtnPlay.I
    EndStructure
    ;
    Declare PlayThread(*Th1.MidiThread)
    Global _Mutex=CreateMutex()
    Global Dim _BoxNT.CanvasButton(12)
    Global _Root,_Myfont10=FontID(LoadFont(#PB_Any,"arial",10))
    Define BR.S="<br>"
    Define T$="<html><Body>"
    T$+ "<b>Octave</b> is the distance between frequencies with ratio 2:1"+BR
    T$+"The twelve-tone equal temperament divides the octave into 12 equal steps."+BR+BR
    T$+"<b>Note</b> is the sound of each division."+BR
    T$+"If one note has a frequency of 400 Hz, the note one octave above it is at 800 Hz,"
    T$+" and the note one octave below is at 200 Hz. Both notes have the same name but the sound is one octave apart."+BR+BR
    T$+"<b>Scale</b> is any combinantion of notes, starting on any note and ending on the same note name one octave higher."+BR+BR
    T$+"<b>Mode</b> is the order of the steps between the notes of the scale."+BR
    T$+"The mode is changed rotating the steps without moving the first and last notes."+BR
    T$+"________________________"+BR
    T$+"Usage:"+BR+BR
    T$+"First and last notes can't be unselected; any other note can be selected\unselected"+BR+BR
    T$+"<b>Root</b> is the first note of the scale."+BR+BR
    T$+"Button <b>Root</b> transpose all notes"+BR
    T$+"Buttons ' < ' and ' > ' rotates all notes and steps."+BR
    T$+"Button <b>C Major</b> reset all notes and selections to initial C Major Scale."+BR
    T$+"Button <b>Mode</b> rotate selections (change scale mode)."+BR+BR
    T$+"</body></html>"
    ;
    Global _HelpWin=OpenWindow(#PB_Any,0,0,640,640,"PB Scale Explorer Help",#PB_Window_SystemMenu |  1|#PB_Window_Invisible)
    Define WG=WebGadget(#PB_Any, 0, 0, WindowWidth(_HelpWin) - 10, WindowHeight(_HelpWin) - 10, "")
    SetGadgetItemText(WG, #PB_Web_HtmlCode, T$)
    Macro GadgetBottom(Gad)  :  GadgetY(Gad)+GadgetHeight(Gad)  : EndMacro
    Macro GadgetRight(Gad)  :  GadgetX(Gad)+GadgetWidth(Gad)  : EndMacro
    Macro  GetBeatDuration(BPM,Denom) ; millisecs for 1 beat
      #MSEC/(BPM*Denom)
    EndMacro
    ;
    Procedure InitMidiOut()  ; open first MidiOutDevice found
      Protected Ndev,Midi.Midioutcaps
      For NDev=-1 To midiOutGetNumDevs_()-1
        If midiOutGetDevCaps_(NDev,@Midi.MidiOUTCAPS,SizeOf(MidiOUTCAPS))=0
          If Midi\WVoices>0
            midiOutOpen_(@_HMidiout,NDev,0,0,0)
          EndIf
        EndIf
      Next
    EndProcedure
    ;
    Procedure CenterTxt1(X,Y,Wi,He,Text.S)
      Protected TextWidth=TextWidth(Text),TextHeight=TextHeight(Text)
      Protected X1=X+Wi,Y1=Y+He
      If TextWidth>Wi :  DrawText(X,(Y+Y1)/2-TextHeight/2 , Text)
      Else            :  DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , Text)
      EndIf
    EndProcedure
    ;
    Procedure CBInvertImage(gNum,Wi,He)
      Protected Imgid=GetGadgetAttribute(gNum,#PB_Canvas_Image )
      Protected Img=CreateImage(#PB_Any,Wi,He)
      If _DraWing: StopDrawing():EndIf
      _DraWing=StartDrawing(ImageOutput(Img))
      Box(0,0,Wi,He,#White)
      Protected HTMP=CreateCompatibleDC_(_DraWing)
      SelectObject_(HTMP,ImgID)
      BitBlt_(_DraWing,0,0,Wi,He,HTMP,0,0,#SRCINVERT)
      DeleteDC_(HTMP)
      StopDrawing():_DraWing=0
      SetGadgetAttribute(gNum,#PB_Canvas_Image,ImageID(Img))
      FreeImage(Img)
    EndProcedure
    ;
    Procedure CBDraw(Indx,State=-1,Invert=0) ;- Draw CBtn con Color segun \State
      With _BoxNT(Indx)
        Static OldgNum
        Protected Wi=GadgetWidth(\gNum)
        Protected He=GadgetHeight(\gNum)
        If State=-1:State=\State:EndIf
        If OldgNum
          CbInvertImage(OldgNum,Wi,He)
          OldgNum=0
        EndIf
        If Invert
          CbInvertImage(\gNum,Wi,He)
          OldgNum=\gNum
        Else
          Protected Img=CreateImage(#PB_Any,Wi,He)
          If _DraWing:StopDrawing():EndIf
          _DraWing=StartDrawing(ImageOutput(Img))   ;background Color
          DrawingMode(#PB_2DDrawing_Gradient)
          FrontColor(\RGB[State]\BackRGB1)
          BackColor(\RGB[State]\BackRGB2)
          LinearGradient(Wi/2,0, Wi/2,He)    ; try  (0,0,Wi,He) to diagonal Gradient
          Box(0,0,Wi,He)
          DrawingMode(#PB_2DDrawing_Transparent) ; Button Text
          DrawingFont(\Fontid)
          FrontColor(\RGB[State]\TextRGB)
          CenterTxt1(0,0,Wi,He,\Text)
          StopDrawing():_DraWing=0
          SetGadgetAttribute(\gNum,#PB_Canvas_Image,ImageID(Img))
          FreeImage(Img)
        EndIf
      EndWith
    EndProcedure
    ;
    Procedure CanvasButton(CBNum,X,Y,Wi,He,Text.S,Fontid,Indx,*CB.CanvasButton,Flags=-1)
      Protected I
      With *CB
        If Flags=-1:Flags=#PB_Canvas_Keyboard
        Else       :Flags|#PB_Canvas_Keyboard
        EndIf
        \Text=Text
        \gNum =CanvasGadget(CBNum,X,Y,Wi,He,Flags)
        If CBNum<>#PB_Any:\gNum=CBNum:EndIf
        SetGadgetAttribute(\gNum,#PB_Canvas_Cursor,#PB_Cursor_Hand)
        \Fontid=Fontid
        \Indx=Indx
        Restore BtnColors
        For I=0 To 5
          Read.I \RGB[I]\TextRGB
          Read.I \RGB[I]\BackRGB1
          Read.I \RGB[I]\BackRGB2
        Next
        CBDraw(Indx)
      EndWith
    EndProcedure
    ;
    Procedure  CanvasCtrl(Indx,EvTyp)
      Define State
      With _BoxNT(Indx)
        Select EvTyp
          Case  #PB_EventType_LeftButtonDown
            If Indx>0 And Indx<12
              \Selected!1 :
              \State=\Selected
              CbDraw(Indx,-1)
            EndIf
          Case #PB_EventType_MouseEnter,#PB_EventType_LeftButtonUp
            If \Selected   : CBDraw(Indx,#HoverSelected)
            Else:          : CBDraw(Indx,#HoverunSelected)
            EndIf
          Case #PB_EventType_MouseLeave
            If \Selected  : CBDraw(Indx,#Selected)
            Else : CBDraw(Indx,#Normal)
            EndIf
        EndSelect
      EndWith
    EndProcedure
    ;
    Procedure PlayCtrl(*Th1.MidiThread)
      With *Th1
        midiOutShortMsg_(_HMidiout, #CtrlChg | \Chan | #AllSoundOff )
        If GetGadgetState(\BtnPlay) : \Thread=CreateThread(@PlayThread(),*Th1)
        Else                        : CbDraw(\Indx-1)
        EndIf
        \Indx=0
      EndWith
    EndProcedure
    ;
    Procedure PlayThread(*Th1.MidiThread)
      With *Th1
        Static OldNt
        Protected State,Ti
        While GetGadgetState(\BtnPlay) And _Quit=0
          If ElapsedMilliseconds()-Ti>=\BeatDuration
            LockMutex(_Mutex)
            If \Indx>12 And \Loop=0
              SetGadgetState(\BtnPlay,0)
              PlayCtrl(*Th1)
              CbDraw(12)
              UnlockMutex(_Mutex)
              Break
            EndIf
            Ti=ElapsedMilliseconds()
            Repeat ; get next Note to Play
              If \Indx>12: \Indx=0:  EndIf
              State=_BoxNT(\Indx)\State
              If State= #Selected Or State=#HoverSelected
                Break
              EndIf
              \Indx+1
            ForEver
            midiOutShortMsg_(_HMidiout, #NoteOff | \Chan | OldNt << 8 | \Vel << 16) ;
            OldNt=\Indx+\Ove*12+_Root
            midiOutShortMsg_(_HMidiout, $C0 |  \Chan | \InStrument<< 8 )  ; OJO Default=piano 0
            midiOutShortMsg_(_HMidiout, #NoteOn | \Chan | OldNt << 8 | \Vel << 16) ;
            CbDraw(\Indx,-1,1)
            \Indx+1
            UnlockMutex(_Mutex)
          EndIf
          Delay(1)
        Wend
      EndWith
    EndProcedure
    ;
    Procedure Mode(Way)
      Protected I,J,K,Stp
      Select Way
        Case #Wayright
          For J=1 To 12
            If _BoxNT(J)\Selected
              If Stp=0:Stp=J:EndIf
              If Stp
                _BoxNT(J-Stp)\Selected=1
                _BoxNT(J-Stp)\State=1
                If J<12
                  _BoxNT(J)\Selected=0
                  _BoxNT(J)\State=0
                EndIf
              EndIf
            EndIf
          Next
        Case #Wayleft
          For J=11 To 0 Step -1
            If _BoxNT(J)\Selected
              If Stp=0:Stp=12-J:EndIf
              If Stp
                _BoxNT(J+Stp)\Selected=1
                _BoxNT(J+Stp)\State= 1
                If J
                  _BoxNT(J)\Selected=0
                  _BoxNT(J)\State=0
                EndIf
              EndIf
            EndIf
          Next
      EndSelect
      _BoxNT(0)\Selected=1
      _BoxNT(12)\Selected=1
      _BoxNT(0)\State=1
      _BoxNT(12)\State=1
      For I=1 To 11 :  CbDraw(I,-1) : Next
    EndProcedure
    ;
    Procedure Rotation(Way)
      Protected Nt.S,I,Stp
      Select Way
        Case #Wayright
          Repeat : Stp+1 : Until _BoxNT(Stp)\Selected
        Case #Wayleft
          Stp=12
          Repeat : Stp-1 : Until _BoxNT(Stp)\Selected
      EndSelect
      _Root=(_Root+Stp)%12
      Nt=Mid(#CHROMATIC$,(_Root % 12)*2+1,2)
      SetGadgetState(_SpRoot,_Root)
      SetGadgetText(_SpRoot,"Root: "+Nt)
      Mode(Way)
      For I= 0 To 12
        Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
        _BoxNT(I)\Text=Nt
        CbDraw(I)
      Next
      SetActiveGadget(_BoxNT(0)\gNum)
    EndProcedure
    ;
    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    OpenWindow(0, 100, 100,650,200 ,"Music Scales Explorer", #PB_Window_SystemMenu|#PB_Window_Invisible |  1)
    SetWindowColor(0,0)
    Initmidiout()
    Define Nt.S,I,Ev,EvGad,Flags,Way,Evtyp
    Define *Sel.CanvasButton=0
    Define Bwi=40,Bhe=30,X=Bwi,Y=Bhe
    Define Th1.MidiThread
    Define BtnMajor
    Define BtnRotLeft=ButtonGadget(#PB_Any,X,Y,20,30,"<")
    X+22
    For I=0 To 12
      Nt=Trim(Mid(#CHROMATIC$,(I % 12)*2+1,2))
      CanvasButton(#PB_Any,X+I*Bwi,Y,Bwi-1,Bhe,Nt,_Myfont10,I,@_BoxNT(I))
      Select I
        Case 0,2,4,5,7,9,11,12
          _BoxNT(I)\State=#Selected
          _BoxNT(I)\Selected=1
          CbDraw(I)
      EndSelect
    Next
    With Th1.MidiThread
      Define BtnRotRight=ButtonGadget(#PB_Any,X+I*Bwi,Y,20,30,">")
      Define \BtnPlay=ButtonGadget(#PB_Any,Bwi,80,100,26,"Play",#PB_Button_Toggle)
      Define TrackVel=TrackBarGadget(#PB_Any,Bwi,130,230,20,0,127) ; Midi velocity (loudness)
      Define TrackBPM=TrackBarGadget(#PB_Any,Bwi,160,230,20,30,1200)
      _SPRoot=SpinGadget(#PB_Any,160,80,110,26,-1,12)
      Define BtnModeLeft=ButtonGadget(#PB_Any,290,GadgetY(\BtnPlay),30,26,"<")
      Define BtnModeRight=ButtonGadget(#PB_Any,320,GadgetY(\BtnPlay),30,26,">")
      Define ChBLoop=CheckBoxGadget(#PB_Any,370,80,80,26,"Loop")
      Define BtnMajor=ButtonGadget(#PB_Any,520,80,80,26,"C Major")
      Define BtnHelp=ButtonGadget(#PB_Any,WindowWidth(0)-100,WindowHeight(0)-40,60,20,"Help")
      SetGadgetFont(\BtnPlay,_Myfont12)
      SetGadgetFont(_SpRoot,_Myfont12)
      SetGadgetFont(ChbLoop,_Myfont12)
      SetGadgetFont(Btnmajor,_Myfont12)
      SetGadgetText(_SpRoot,"Root: C")
      GadgetToolTip(TrackVel,"Volume")
      GadgetToolTip(TrackBPM,"Speed")
      GadgetToolTip(BtnRotLeft,"Rotation")
      GadgetToolTip(BtnRotRight,"Rotation")
      Define TGMode=TextGadget(-1,GadgetX(btnmodeleft),gadgetbottom(btnmodeleft),60,16,"Mode",#PB_Text_Center)
      SetGadgetColor(tgmode,#PB_Gadget_FrontColor,#White)
      SetGadgetColor(tgmode,#PB_Gadget_BackColor,0)
      \BPM=200
      \Denom=1
      \BeatDuration=300
      \Ove=4
      \Chan=0
      \Vel=100
      \Instrument=0 ; <<<<<<< general Midi inStrument - try 0 to 127
      \Loop=1
      SetGadgetState(TrackVel,\Vel)
      SetGadgetState(TrackBPM,Th1\BPM)
      SetGadgetState(ChbLoop,\Loop)
      HideWindow(0,0)
      Repeat
        EV=WaitWindowEvent()
        Select Ev
          Case #PB_Event_Gadget
            LockMutex(_Mutex)
            EvGad=EventGadget()
            Select EvGad
              Case \BtnPlay:PlayCtrl(Th1)
              Case _SpRoot
                _Root=GetGadgetState(_SpRoot)
                If _Root>11 :_Root=0: SetGadgetState(_SpRoot,0)
                ElseIf _Root<0:_Root=11:SetGadgetState(_SpRoot,11)
                EndIf
                Nt=Mid(#CHROMATIC$,(_Root % 12)*2+1,2)
                SetGadgetText(_SpRoot,"Root: "+Nt)
                For I=0 To 12
                  Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
                  _BoxNT(I)\Text=Nt
                  CbDraw(I)
                Next
                SetActiveGadget(_BoxNT(0)\gNum)
              Case BtnRotLeft   : Rotation(#WayLeft)
              Case BtnRotRight  : Rotation(#WayRight)
              Case BtnModeLeft  : Mode(#WayLeft)
              Case BtnModeRight : Mode(#WayRight)
              Case TrackVel     : \Vel=GetGadgetState(TrackVel)
              Case TrackBPM     : \BPM=GetGadgetState(TrackBPM)
                \BeatDuration=GetBeatDuration(\BPM,\Denom)
              Case ChbLoop      : \Loop=GetGadgetState(ChbLoop)
              Case BtnHelp      : HideWindow(_HelpWin,0)
              Case BtnMajor
                _Root=0         : SetGadgetState(_SpRoot,0)
                SetGadgetText(_SpRoot,"Root: C")
                For I=0 To 12
                  Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
                  _BoxNT(I)\Text=Nt
                  Select I
                    Case 0,2,4,5,7,9,11,12
                      _BoxNT(I)\State=#Selected
                    Default
                      _BoxNT(I)\State=0
                  EndSelect
                  CbDraw(I)
                Next
              Default
                For I=0 To 12
                  If EvGad= _BoxNT(I)\gNum
                    CanvasCtrl(I,EventType())
                    Break
                  EndIf
                Next
            EndSelect
            UnlockMutex(_Mutex)
        EndSelect
        If Ev=#PB_Event_CloseWindow
          If EventWindow()=_HelpWin:HideWindow(_HelpWin,1)
          Else :  Break
          EndIf
        EndIf
      Until _Quit
      Delay(Th1\BeatDuration)
      midiOutShortMsg_(_HMidiout, #CtrlChg | \Chan | #AllSoundOff )
      SetGadgetState(\BtnPlay,0)
    EndWith
    End
    ;
    DataSection
      BtnColors:   ; Assign here Button Color combinations <<<<<<<<<<<<<
      Data.I #Gray   , #Gray   ,#White   ;Normal
      Data.I 0       , #Red    ,#Yellow  ;Selected
      Data.I 0       , #Blue   ,#White   ;Pressed
      Data.I 0       , #Yellow ,#Red     ;HoverSelected
      Data.I #Gray   , #White  ,#Gray    ;HoverUnSelected
      Data.I $88888  , $8A8A8A ,#White   ;Disabled
    EndDataSection

Créé le 20 juillet 2011 par einander
Version hors-ligne

Les sources présentés sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une œuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2008 Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.