Sources PureBasic

Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
Sommaire→Gadgets→CanvasGadgetSé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
EndDataSectionCréé 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
EndDataSectionCréé 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
EndDataSectionCréé le 20 juillet 2011 par einander



