'##############################################################################
'##############################################################################
'Begin Sliders.bas

declare function AddTrackBar(event as EventHandle ptr,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,hv as integer) as Gadget ptr

declare function TrackBarHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
declare function TrackBarHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
declare function TrackBarRelease(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer

declare sub AnalogSlideTrackBar(gad as Gadget ptr,knobpos as integer)
declare sub SetTrackBarVal (gad as Gadget ptr,va as integer)
declare function GetTrackBarVal (gad as Gadget ptr) as integer

declare sub DrawTrackBar (gad as Gadget ptr)

declare function AddScrollBar(event as EventHandle ptr,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,p as integer,hv as integer) as Gadget ptr

declare function ScrollBarHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
declare function ScrollBarHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
declare function ScrollBarRelease(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer

declare sub AnalogSlideScrollBar(gad as Gadget ptr,knobpos as integer)
declare sub SetScrollBarVal (gad as Gadget ptr,va as integer)
declare function GetScrollBarVal (gad as Gadget ptr) as integer
declare sub SetScrollBarLimits(gad as Gadget ptr,mi as integer,ma as integer)

declare sub DrawScrollBar (gad as Gadget ptr)

'TrackBar**********************************************************************

'Steuerungsvariablen TrackBar:
'Ca Minimalwert den .value als Rückgabewert annehmen kann
'Cb Maximalwert den .value als Rückgabewert annehmen kann
'Cc Position des Knobs in px, ergibt sich aus dem Wert in .value
'Cd Mausoffset beim Klicken auf den Knob
'Ce Schalter für Sliding-Modus
'Cf Schalter vertikal(1)/horizontal(0)

function AddTrackBar (event as EventHandle ptr,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,hv as integer) as Gadget ptr
  dim as integer range

  if ma<mi then ma=mi

  if va>ma then va=ma
  if va<mi then va=mi

  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
  if tmpgad then


    tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    '.dadw,.gadh siehe weiter unten
    tmpgad->value=va

    tmpgad->Ca=mi
    tmpgad->Cb=ma
    '.Cc siehe weiter unten
    tmpgad->Cf=hv

    range=tmpgad->Cb - tmpgad->Ca
    if tmpgad->Cf then
     'vertikal
      tmpgad->gadw=22
      tmpgad->gadh=l
      if range then tmpgad->Cc=(tmpgad->value-tmpgad->Ca)/range * (tmpgad->gadh-11)
    else
      'horizontal
      tmpgad->gadw=l
      tmpgad->gadh=22
      if range then tmpgad->Cc=(tmpgad->value-tmpgad->Ca)/range * (tmpgad->gadw-11)
    end if

    tmpgad->event=event

    tmpgad->DoDraw     =@DrawTrackBar
    tmpgad->DoHit      =@TrackBarHit
    tmpgad->DoHold     =@TrackBarHold
    tmpgad->DoRelease  =@TrackBarRelease
    tmpgad->DoKeyStream=0

		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)

    function=tmpgad
  end if
end function



function TrackBarhit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
  dim as integer mx,my
  mx=hitgad->event->MOUSEX
  my=hitgad->event->MOUSEY

  if hitgad->Cf then
    'vertikal
    if my-hitgad->posy>=hitgad->Cc and _           'Knob Treffer
      my-hitgad->posy<hitgad->Cc+11 then
      hitgad->Cd=(my-hitgad->posy)-hitgad->Cc 'Speichern des MouseOffsets überm Knob
      hitgad->Ce=1 'SliderModus bei Hold aktivieren
      SetSelect (hitgad,1)
    else  'anderenfalls Knob jeweils um 1 in Richtung Mausposition verschieben, kein HOLD
      if my < hitgad->posy + hitgad->Cc then
        SetTrackBarVal(hitgad,GetTrackBarVal(hitgad)-1)
      elseif my >= hitgad->posy+ hitgad->Cc + 11 then
        SetTrackBarVal(hitgad,GetTrackBarVal(hitgad)+1)
      end if
      hitgad->Ce=0
    end if
  else
    'horizontal
    if mx-hitgad->posx>=hitgad->Cc and _           'Knob Treffer
      mx-hitgad->posx<hitgad->Cc+11 then
      hitgad->Cd=(mx-hitgad->posx)-hitgad->Cc 'Speichern des MouseOffsets überm Knob
      hitgad->Ce=1 'SliderModus bei Hold aktivieren
      SetSelect (hitgad,1)
    else  'anderenfalls Knob jeweils um 1 in Richtung Mausposition verschieben, kein HOLD
      if mx < hitgad->posx + hitgad->Cc then
        SetTrackBarVal(hitgad,GetTrackBarVal(hitgad)-1)
      elseif mx >= hitgad->posx + hitgad->Cc + 11 then
        SetTrackBarVal(hitgad,GetTrackBarVal(hitgad)+1)
      end if
      hitgad->Ce=0
    end if

  end if
  function=-1
end function



function TrackBarHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  static as integer oldval
  dim as integer mx,my
  mx=hitgad->event->MOUSEX
  my=hitgad->event->MOUSEY

  if hitgad->Ce=1 then
    oldval=GetTrackBarVal(hitgad)

    if hitgad->Cf then  'vertikal
      AnalogSlideTrackBar(hitgad,my- hitgad->posy-hitgad->Cd)
    else                'horizontal
      AnalogSlideTrackBar(hitgad,mx- hitgad->posx-hitgad->Cd)
    end if

    if oldval<>GetTrackBarVal(hitgad) then
      function=-1
    else
      function=0
    end if
  end if
end function



function TrackBarRelease(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  hitgad->Ce=0
  SetSelect(hitgad,0)
  function=0
end function



sub AnalogSlideTrackBar(gad as Gadget ptr,knobpos as integer)
	dim as integer range,l
  range=gad->Cb - gad->Ca
  
  if gad->Cf then l=gad->gadh else l=gad->gadw ' vert.-->l=gadh  /  horiz.-->l=gadw
  
  if knobpos<0 then knobpos=0
  if knobpos>l-11 then knobpos=l-11

  gad->Cc=knobpos
  if range then gad->value=gad->Ca  +  cint(range*gad->Cc/(l-11))

  gad->DoDraw(gad)
end sub



sub SetTrackBarVal (gad as Gadget ptr,va as integer)
	dim as integer range,l
  range=gad->Cb - gad->Ca
  
  if gad->Cf then l=gad->gadh else l=gad->gadw ' vert.-->l=gadh  /  horiz.-->l=gadw

  if va>gad->Cb then va=gad->Cb
  if va<gad->Ca then va=gad->Ca

  gad->value=va
  if range then gad->Cc=(gad->value-gad->Ca)/range * (l-11)

  gad->DoDraw(gad)
end sub



function GetTrackBarVal (gad as Gadget ptr) as integer
	function=gad->value
end function



sub DrawTrackBar (gad as Gadget ptr)
	dim as integer i,x,y,w,h,p,s,range
  x   =gad->posx
	y   =gad->posy
	w		=gad->gadw
	h		=gad->gadh
	p		=gad->Cc
	range=gad->Cb - gad->Ca

  screenlock
	if gad->act=0 then put(x,y),gad->BackGroundImage,pset

  if gad->act=1 then
    put(x,y),gad->BackGroundImage,pset
    if gad->Cf then'vertikal
      Slot x+10,y,h,1
      FillB x,y+p,22,11,GadgetColor,gad->sel'Knob
    else'horizontal
      Slot x,y+10,w,0
      FillB x+p,y,11,22,GadgetColor,gad->sel'Knob
    end if
  end if

  if gad->act=2 then
    put(x,y),gad->BackGroundImage,pset
    if gad->Cf then'vertikal
      Slot x+10,y,h,1
      FillB x,y+p,22,11,BackGroundColor,0
    else'horizontal
      Slot x,y+10,w,0
      FillB x+p,y,11,22,BackGroundColor,0
    end if
  end if
  screenunlock
end sub



'ScrollBar*********************************************************************

'Steuerungsvariablen ScrollBar:
'Ca Minimalwert den .value als Rückgabewert annehmen kann
'Cb Maximalwert den .value als Rückgabewert annehmen kann
'Cc Position des Knobs in px, ergibt sich aus dem Wert in .value
'Cd Mausoffset beim Klicken auf den Knob
'Ce Schalter für Sliding-Modus
'Cf Schalter vertikal(1)/horizontal(0)
'Cg KnobSize
'Ch PageSize

function AddScrollBar(event as EventHandle ptr,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,p as integer,hv as integer) as Gadget ptr
  dim as integer range,ks,full

  if ma<mi then ma=mi

  range=ma-(p-1)-mi

  if va>mi+range then va=mi+range  'sollte range kleiner 1 sein so ergibt das für va einen Fehler (va ist unter mi)!!!
  if va<mi then va=mi              'hiermit korrigiert

  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
  if tmpgad then

    tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    '.gadw,.gadh siehe weiter unten
    tmpgad->value=va

    tmpgad->Ca=mi
    tmpgad->Cb=ma
    '.Cc siehe weiter unten
    tmpgad->Cf=hv

    ks=(l-2) * p/(ma-mi+1)
    if ks<6 then ks=8
    if ks>l-2 then ks=l-2


    tmpgad->Cg=ks
    tmpgad->Ch=p

    if tmpgad->Cf then
     'vertikal
      tmpgad->gadw=15
      tmpgad->gadh=l
      if range>=1 then
        tmpgad->Cc=1 + (tmpgad->value-tmpgad->Ca)/range * (tmpgad->gadh - 2 - tmpgad->Cg)
      else
        tmpgad->Cc=1
      end if
    else
      'horizontal
      tmpgad->gadw=l
      tmpgad->gadh=15
      if range>=1 then
        tmpgad->Cc=1 + (tmpgad->value-tmpgad->Ca)/range * (tmpgad->gadw - 2 - tmpgad->Cg)
      else
        tmpgad->Cc=1
      end if
    end if

    tmpgad->event=event

    tmpgad->DoDraw     =@DrawScrollBar
    tmpgad->DoHit      =@ScrollBarHit
    tmpgad->DoHold     =@ScrollBarHold
    tmpgad->DoRelease  =@ScrollBarRelease
    tmpgad->DoKeyStream=0

		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)
    function=tmpgad
  end if
end function



function ScrollBarHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
  dim as integer mx,my
  mx=hitgad->event->MOUSEX
  my=hitgad->event->MOUSEY

  function=0

  if hitgad->Cf then
    'vertikal
    if my-hitgad->posy>=hitgad->Cc and _           'Knob Treffer
      my-hitgad->posy<hitgad->Cc+hitgad->Cg then
      hitgad->Cd=my - hitgad->posy  - hitgad->Cc 'Speichern des MouseOffsets überm Knob
      hitgad->Ce=1 'SliderModus für Hold aktivieren
      SetSelect (hitgad,1)
    else 'anderenfalls Knob jeweils um page in Richtung Mausposition verschieben, kein HOLD
      if my < hitgad->posy + hitgad->Cc then
        SetScrollBarVal(hitgad,GetScrollBarVal(hitgad)-hitgad->Ch)
      elseif my >= hitgad->posy+ hitgad->Cc + hitgad->Cg then
        SetScrollBarVal(hitgad,GetScrollBarVal(hitgad)+hitgad->Ch)
      end if
      hitgad->Ce=0
    end if
  else
    'horizontal
    if mx-hitgad->posx>=hitgad->Cc and _           'Knob Treffer
      mx-hitgad->posx<hitgad->Cc+hitgad->Cg then
      hitgad->Cd=mx - hitgad->posx  - hitgad->Cc 'Speichern des MouseOffsets überm Knob
      hitgad->Ce=1 'SliderModus für Hold aktivieren
      SetSelect (hitgad,1)
    else 'anderenfalls Knob jeweils um page in Richtung Mausposition verschieben, kein HOLD
      if mx < hitgad->posx + hitgad->Cc then
        SetScrollBarVal(hitgad,GetScrollBarVal(hitgad)-hitgad->Ch)
      elseif mx >= hitgad->posx + hitgad->Cc + hitgad->Cg then
        SetScrollBarVal(hitgad,GetScrollBarVal(hitgad)+hitgad->Ch)
      end if
      hitgad->Ce=0
    end if
  end if
  function=-1
end function



function ScrollBarHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  dim as integer mx,my,oldval
  mx=hitgad->event->MOUSEX
  my=hitgad->event->MOUSEY
  if hitgad->Ce=1 then
    oldval=GetScrollBarVal(hitgad)
    if hitgad->Cf then 'vertikal
      AnalogSlideScrollBar(hitgad,my- hitgad->posy-hitgad->Cd)
    else               'horizontal
      AnalogSlideScrollBar(hitgad,mx- hitgad->posx-hitgad->Cd)
    end if

    if oldval<>GetScrollBarVal(hitgad) then
      SetSelect (hitgad,1)
      function=-1
    else
      function=0
    end if

  end if
end function



function ScrollBarRelease(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  hitgad->Ce=0
  SetSelect(hitgad,0)
  function=0
end function



sub AnalogSlideScrollBar(gad as Gadget ptr,knobpos as integer)
	dim as integer range,l

  if gad->Cf then l=gad->gadh else l=gad->gadw ' vert.-->l=gadh  /  horiz.-->l=gadw
  range=gad->Cb- (gad->Ch-1) - gad->Ca

  'knob Position festlegen
  if knobpos<1 then knobpos=1
  if knobpos>l-2-gad->Cg then knobpos=l-1-gad->Cg
  gad->Cc=knobpos

  'Value festlegen
  if range>=1 then
    gad->value=gad->Ca  +  cint(range*(gad->Cc-1)/(l-2-gad->Cg))
  else
    gad->value=gad->Ca
  end if

  gad->DoDraw(gad)
end sub



sub SetScrollBarVal (gad as Gadget ptr,va as integer)
	dim as integer range,l
  if gad->Cf then l=gad->gadh else l=gad->gadw ' vert.-->l=gadh  /  horiz.-->l=gadw

  range=gad->Cb- (gad->Ch-1) - gad->Ca

  if va>gad->Ca+range then va=gad->Ca+range
  if va<gad->Ca then va=gad->Ca

  gad->value=va

  if range>=1 then
    gad->Cc=1 + (gad->value-gad->Ca)/range * (l - 2 - gad->Cg)
  else
    gad->Cc=1
  end if

  gad->DoDraw(gad)
end sub



function GetScrollBarVal (gad as Gadget ptr) as integer
	function=gad->value
end function



sub SetScrollBarLimits(gad as Gadget ptr,mi as integer,ma as integer)
  dim as integer range,l,va,p,ks

  'Werte holen
  if gad->Cf then l=gad->gadh else l=gad->gadw ' vert.-->l=gadh  /  horiz.-->l=gadw
  va=gad->value
  p =gad->Ch

  'Limiter für ma
  if ma<mi then ma=mi

  range=ma-(p-1)-mi

  if va>mi+range then va=mi+range  'sollte range kleiner 1 sein so ergibt das für va einen Fehler (va ist unter mi)!!!
  if va<mi then va=mi              'hiermit korrigiert

  'Knobsize berechen
  ks=(l-2) * p/(ma-mi+1)
  if ks<6 then ks=8
  if ks>l-2 then ks=l-2

  'Werte zurückschreiben
  gad->value=va
  gad->Ca=mi
  gad->Cb=ma
  gad->Cg=ks
  if range>=1 then
    gad->Cc=1 + (gad->value-gad->Ca)/range * (l - 2 - gad->Cg)
  else
    gad->Cc=1
  end if

  gad->DoDraw(gad)
end sub



sub DrawScrollBar (gad as Gadget ptr)
	dim as integer i,x,y,w,h,p,k
  x   =gad->posx
	y   =gad->posy
	w		=gad->gadw
	h		=gad->gadh
	p		=gad->Cc
	k   =gad->Cg

  screenlock
	if gad->act=0 then put(x,y),gad->BackGroundImage,pset

  if gad->act=1 then
    FrameB x,y,w,h,1
		ClearBox x+1,y+1,w-2,h-2,ShiftRGB(BackGroundColor,-contrast\6)
    if gad->Cf then'vertikal
      FillB x+1,y+p,w-2,k,GadgetColor,gad->sel
    else'horizontal
      FillB x+p,y+1,k,h-2,GadgetColor,gad->sel
    end if
  end if

  if gad->act=2 then
    FrameB x,y,w,h,1
		ClearBox x+1,y+1,w-2,h-2,BackGroundColor
    if gad->Cf then'vertikal
      FillB x+1,y+p,w-2,k,BackGroundColor,gad->sel
    else'horizontal
      FillB x+p,y+1,k,h-2,BackGroundColor,gad->sel
    end if
  end if
  screenunlock
end sub

'End Sliders.bas
'##############################################################################
'##############################################################################
