PureBasic Forums - English

Code: Select all

;Knob by einander
;june 7 -2005
;PB 3.94 beta 1
;Thanks Psychophanta for the Wrap ASM procedure!
UseJPEGImageDecoder()
RandomSeed(3234)    ; change seed to see other colors - Original seed=3234

Structure Knob
    Pos.Point
    Size.l
    MinValue.l
    MaxValue.l
    xCenter.l
    yCenter.l
EndStructure

Global Knob.Knob, _MX,_MY,_MK,_Inkey,_Deg2Rad.f,Position.Point, _KnobIMG
Global _Red.f,_Green.f,_Blue.f,_RR.f,_GG.f,_BB.f,_OldValue
_Red=100:_Green=100:_Blue=100 :_RR=3.3 :_GG=3.4 :_BB=-3.2
_Deg2Rad=57.29577  ;Degrees To Radians

Procedure APILine(DC,X,Y,X1,Y1,width,Color) 
    Pen=CreatePen_(#Ps_Solid,width,Color)  
    SelectObject_(DC,Pen) 
    MoveToEx_(DC,X,Y,0):LineTo_(DC,X1,Y1) 
    DeleteObject_(Pen) 
EndProcedure 

Procedure ChangeColor()
    r=Random(50)
    Select Random(2)
        Case 0
            _Red+_RR:If _Red>200+r Or _Red<120-r:_RR=-_RR:EndIf
        Case 1
            _Green+_GG:If _Green>200+r Or _Green<120-r:_GG=-_GG:EndIf
        Default
            _Blue+_BB:If _Blue>200+r Or _Blue<120-r:_BB=-_BB:EndIf
    EndSelect
EndProcedure


Procedure Limit(a,b,c)
    If a < b : ProcedureReturn b :EndIf
    If a > c : ProcedureReturn c : EndIf
    ProcedureReturn a
EndProcedure

Procedure Proportion(X.f, Min,Max,a,z)
    If X.f = Min :ProcedureReturn a: EndIf   
    If X.f = Max : ProcedureReturn z: EndIf
    b.f=(Max-Min) / (X.f - Min)
    ProcedureReturn Limit(a + (z-a) / b,a,z)
EndProcedure

Procedure.f WrapF(Number.f,Margin1.f,Margin2.f) 
    !FINIT 
    !;!fld 1E-?(minimum quantity allowed by a floating point number). Needed below to increment by 1E-? -if we want a "both inclusive" range. This push 1E-? to FPU stack (will be to st3). 
    !FLD dWord[esp] ;push number to FPU stack (to st2) 
    !FLD dWord[esp+8] ;push right value to FPU stack (to st1) 
    !FLD dWord[esp+4] ;push left value (to st0) 
    !FCOM st1    ;compares st1 (margin2) with st0 (margin1) 
    !fnstsw ax  ;transfers FPU status word to ax 
    !SAHF    ;transfers ah to CPU flags. 
    !JZ go  ;if margin1 = margin2 then return margin1 
    !JC @f   ;if st1 (margin2) < st0 (margin1), then: 
    !FXCH    ;swap st0 and st1 
    !@@: ;now we have lower margin at st0, and higher margin at st1 
    !FSTP dWord[esp+4];lower margin 
    !FST dWord[esp+8];higher margin 
    !FLD dWord[esp+4];lower margin to st0 again 
    !FSUB st2,st0  ;number (st2) substracted to floor. Number now in st2 
    !fsubp st1,st0  ;range [lowermargin,highermargin] decremented to floor. Range now in st1 
    !;and pop FPU stack. Number in st1. Range in st0. 1 in st2 
    !;!fadd st0,st2 ;add 1E-? to have a "both inclusive" range, this is: [lowermargin,highermargin]. 
    !FXCH  ;Number in st0. Range in st1. 
    !FTST   ;test number (st0) for check the sign 
    !fnstsw ax  ;transfers FPU status word to ax 
    !SAHF    ;transfers ah to CPU flags. 
    !JNC @f ;if number has a negative value (is less than lower margin) then: 
    !FCHS      ;change st0 sign 
    !FPREM  ;get remainder (modulo) in st0, from the division st0/st1 
    !FLD dWord[esp+8];higher margin 
    !FSUB st0,st1  ;decrement higher margin by the obtained modulo and return the result 
    !JMP go ;finish returning st0 content 
    !@@:    ;else: 
    !FPREM  ;get remainder (modulo) in st0, from the division st0/st1 
    !FLD dWord[esp+4];lower margin 
    !FADD st0,st1  ;increment lower margin with the obtained modulo and return the result 
    !go: ;finish returning st0 content 
EndProcedure 

Procedure.f AngleXY(X,Y,Ang.f,Dist)  ;Get Point at distance Dist from X, Y, with angle Angle 
    Ang/_Deg2Rad
    Position\X= X+(Dist*Cos(Ang) + Dist*Sin(Ang))        
    Position\Y= Y+(Dist*Sin(Ang) - Dist*Cos(Ang))
EndProcedure

Procedure.f GetAngle(X,Y,X1,Y1)  ; Get angle between two points 
    a.f = X1-X  
    Ang.f = ACos(a/Sqr(a*a+Pow( Y1-Y,2)))*_Deg2Rad 
    If Y < Y1 :ProcedureReturn -(359-Ang) : EndIf 
    ProcedureReturn -Ang 
EndProcedure

Procedure DrawKnob(DC,X,Y,l)
    Ang.f
    Repeat
        x2.f = X+(l*Cos(Ang) + l*Sin(Ang))        
        y2.f = Y+(l*Sin(Ang) - l*Cos(Ang))
        APILine(DC,X,Y,x2 ,y2,4,RGB(_Red,_Green,_Blue))
        ChangeColor()
        Ang+0.01
    Until Ang>=359
EndProcedure 


Procedure Knob(Ang.f)
    X=Knob\Pos\X :Y=Knob\Pos\Y
    DrawImage(UseImage(_KnobIMG), X,Y,Knob\Size,Knob\Size)
    AngleXY(Knob\xCenter,Knob\yCenter,Ang,Knob\Size/3.14)
    Circle(Position\X,Position\Y,6,#Blue)
    ProcedureReturn Proportion(WrapF(Ang-136,0,359),0,359,Knob\MinValue,Knob\MaxValue)
EndProcedure


Procedure Callback(hWnd, Msg, lParam, wParam)
    If Msg = #WM_PAINT
        DrawImage(UseImage(_KnobIMG), Knob\Pos\X,Knob\Pos\Y,Knob\Size,Knob\Size)
    EndIf
    Select Msg
        Case #WM_KEYDOWN 
            _Inkey = EventwParam() 
            If _Inkey=27:End:EndIf
        Case #PB_Event_CloseWindow
            End
        Default
            _MX=WindowMouseX() 
            _MY=WindowMouseY() 
            _MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
    EndSelect
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
;_________________________________________
OpenWindow(0,0,0,0,0,#WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE,"")
hDC=GetDC_(WindowID()) 
;**********************************************************     
Knob\Pos\X=WindowWidth()/2.5                ; put here your defs
Knob\Pos\Y=WindowHeight()/2.5
Knob\Size=120
Knob\xCenter=Knob\Pos\X+Knob\Size/2
Knob\yCenter=Knob\Pos\Y+Knob\Size/2
Knob\MinValue=0        
Knob\MaxValue=1000
;********************************************************** 

Style=0   ; ************************choose style=1 to load knob; style=0 to create knob 

If Style   ; Load your knob image
    _KnobIMG=LoadImage(#PB_Any,"G:\Graficos\Knob 1.bmp")
Else         ; Draw Knob
    _KnobIMG=CreateImage(#PB_Any,Knob\Size,Knob\Size)
    DrawKnob(StartDrawing(ImageOutput()),ImageWidth()/2,ImageHeight()/2,ImageWidth()/3)
    StopDrawing()
EndIf
StartDrawing(WindowOutput())

Box(0,0,WindowWidth(),WindowHeight(),0)
SetWindowCallback(@Callback())
Repeat
    EV = WaitWindowEvent()
    If _MK=1
        X=Knob\Pos\X:Y=Knob\Pos\Y
        X1=X+Knob\Size : Y1=Y+Knob\Size
        If _MX>X And _MY>Y And _MX<X1 And _MY<Y1 
            Catch=1              ;catch the knob until mouse is released
        EndIf            
    Else
        Catch=0   ; released
    cuadrant=0
        EndIf
    If Catch
        Ang.f=WrapF(GetAngle(_MX,_MY,Knob\xCenter,Knob\yCenter)-136,0,359)
        value=Knob(Ang)
        If  _MY>Knob\yCenter
            If _MX<Knob\xCenter
                If cuadrant=0: cuadrant=1: EndIf
            Else
                If cuadrant=0 : cuadrant=2 : EndIf
            EndIf
        Else
            cuadrant=0
        EndIf 
        If cuadrant=1
            If value>Knob\MaxValue/2
                value=Knob\MinValue
            EndIf
        ElseIf cuadrant=2
            If value<Knob\MaxValue/4
                value=Knob\MaxValue
            EndIf
        EndIf
        
        t$=Str(value)
        SetBkMode_(hDC,#Transparent)
        SetTextColor_(hDC,#Green)
        TextOut_(hDC,Knob\Pos\X,Knob\Pos\Y+Knob\Size-18,t$,Len(t$))      
    EndIf
Until EV = #PB_EventCloseWindow 
End