Sources PureBasic
Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
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