Sources PureBasicConsultez toutes les sources

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

 
OuvrirSommaireGadgetsCanvasGadget
 
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
 
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
 
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
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2008 Developpez 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.