'##############################################################################
'##############################################################################
'Begin ListBox.bas
'Container***************************************
declare function AddListBox (event as EventHandle ptr,x as integer,y as integer,w as integer,rows as integer,sa() as string) as Gadget ptr

declare function ListBoxSubHandle(gad as Gadget ptr,junkb as Gadget ptr) as integer

declare sub InitNewListArray(gad as Gadget ptr,sa() as string)
declare function GetListBoxVal(gad as Gadget ptr) as integer
declare sub SetListBoxVal(gad as Gadget ptr,ni as integer)

declare sub DrawListBox (gad as Gadget ptr)
'************************************************
declare function AddListBoxGadget (event as EventHandle ptr,x as integer,y as integer,w as integer,rows as integer,sa() as string) as Gadget ptr
declare function ListHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
declare function ListHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
declare function ListRelease(hitgad as Gadget ptr,relgad as Gadget ptr) as integer

declare sub ScrollList(gad as Gadget ptr,si as integer)

declare function GetListVal(gad as Gadget ptr) as integer
declare sub SetListVal(gad as Gadget ptr,ni as integer)

declare sub DrawList(gad as Gadget ptr)

'Steuerungsvariablen:
'Container
'Ca	vertikale Scroll-Hilfsvariable

'ListBox
'Ca Breite Container in Zeichen
'Cb Höhe Container in Zeilen
'Cc Zeiger auf externes String-Array(kleinster Index, [0])
'Cd grösste Indexnummer
'Ce Scroll - Indexnummer (Offset beim Scrollen)

'ContainerGadget***************************************************************
function AddListBox (event as EventHandle ptr,x as integer,y as integer,w as integer,rows as integer,sa() as string) as Gadget ptr
  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
	if tmpgad then
    tmpgad->nextGadget=0
  	tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    tmpgad->gadw=w*8 + 6 + 15 '6 >> Rand innerhalb ListBox,  15>> Breite Arrows,Slider rechts
    tmpgad->gadh=fontheight*rows + 6 '6 >> Rand innerhalb ListBox

    tmpgad->value=0
    tmpgad->event=event

    tmpgad->DoDraw     =@DrawListBox
    tmpgad->DoHit      =@ListBoxSubHandle
    tmpgad->DoHold     =@ListBoxSubHandle
    tmpgad->DoRelease  =@ListBoxSubHandle
    tmpgad->DoKeyStream=0

		tmpgad->Ca=1

    tmpgad->subevent=CreateSubEventHandle
		if tmpgad->subevent then
      tmpgad->subevent->gad(0)=AddListBoxGadget(tmpgad->subevent->event,x,y,w,rows,sa())
      tmpgad->subevent->gad(1)=AddArrow(tmpgad->subevent->event,x+w*8 + 6,y,2)
    	tmpgad->subevent->gad(2)=AddScrollBar(tmpgad->subevent->event,x+w*8 + 6,y+16,(fontheight*rows + 6)-32,1,ubound(sa),1,rows,1)
    	tmpgad->subevent->gad(3)=AddArrow(tmpgad->subevent->event,x+w*8 + 6,y+fontheight*rows + 6 - 16 ,3)
		end if
		SaveBackGround(tmpgad)
		event->ChainGadget (tmpgad)
		function=tmpgad
	end if
end function



function ListBoxSubHandle(gad as Gadget ptr,junkb as Gadget ptr) as integer
	function=0

	dim as integer VListPos=gad->Ca

	gad->subevent->event->xSleep(0,0)
	if gad->subevent->event->GADGETMESSAGE then
  	select case gad->subevent->event->GADGETMESSAGE
	    case gad->subevent->gad(0)
      	function=-1
			case gad->subevent->gad(1)
        VListPos -=1
        SetScrollBarVal(gad->subevent->gad(2),VListPos)
        VListPos=GetScrollBarVal(gad->subevent->gad(2))
        ScrollList(gad->subevent->gad(0),VListPos)

			case gad->subevent->gad(2)
        VListPos=GetScrollBarVal(gad->subevent->gad(2))
        ScrollList(gad->subevent->gad(0),VListPos)

			case gad->subevent->gad(3)
        VListPos +=1
        SetScrollBarVal(gad->subevent->gad(2),VListPos)
        VListPos=GetScrollBarVal(gad->subevent->gad(2))
        ScrollList(gad->subevent->gad(0),VListPos)
		end select
		gad->Ca=VListPos
		gad->subevent->gad(0)->DoDraw(gad->subevent->gad(0))
	end if
end function



sub InitNewListArray(gad as Gadget ptr,sa() as string)
	dim as integer VListPos=1

  'ehemalig NewListArray(gad->subevent->gad(0),sa())
  'direkt integriert da nur einmal aufgerufen
  	gad->subevent->gad(0)->Cc=cast(integer,@(sa(lbound(sa))))
    gad->subevent->gad(0)->Cd=ubound(sa)
    if gad->subevent->gad(0)->Cd=0 then gad->subevent->gad(0)->Ce=0 else gad->subevent->gad(0)->Ce=1
    gad->subevent->gad(0)->value=0'nach Neuinitiierung keine Selektion vorhanden

'  sub NewListArray(gad as Gadget ptr,sa() as string)
'  	gad->Cc=cast(integer,@(sa(lbound(sa))))
'    gad->Cd=ubound(sa)
'    if gad->Cd=0 then gad->Ce=0 else gad->Ce=1
'    gad->value=0
'  end sub

	SetScrollBarLimits(gad->subevent->gad(2),1,ubound(sa))
  SetScrollBarVal(gad->subevent->gad(2),VListPos)
  VListPos=GetScrollBarVal(gad->subevent->gad(2))
	
  ScrollList(gad->subevent->gad(0),gad->Ca)
  
  gad->subevent->gad(0)->DoDraw(gad->subevent->gad(0))
end sub



function GetListBoxVal(gad as Gadget ptr) as integer
  function=gad->subevent->gad(0)->value
end function



sub SetListBoxVal(gad as Gadget ptr,ni as integer)
  dim as integer upperindex
  upperindex=gad->subevent->gad(0)->Cd
  if ni>-1 and ni<=upperindex then
    gad->subevent->gad(0)->value=ni
		ScrollList(gad->subevent->gad(0),ni)
		SetScrollBarVal(gad->subevent->gad(2),ni)
  	gad->Ca=GetScrollBarVal(gad->subevent->gad(2))
	  gad->subevent->gad(0)->DoDraw(gad->subevent->gad(0))
  end if
end sub



sub DrawListBox (gad as Gadget ptr)
'Da es sich hier "nur" um ein Container
'handelt, passiert hier einfach mal nichts!!!
end sub



function AddListBoxGadget (event as EventHandle ptr,x as integer,y as integer,w as integer,rows as integer,sa() as string) as Gadget ptr
  dim as Gadget ptr tmpgad
  function=0
  tmpgad=new Gadget
  if tmpgad then
    tmpgad->nextGadget=0
  	tmpgad->sel=0
    tmpgad->act=0
    tmpgad->posx=x
    tmpgad->posy=y
    tmpgad->gadw=w*8 + 6
    tmpgad->gadh=fontheight*rows + 6

    tmpgad->value=0
    tmpgad->event=event

    tmpgad->DoDraw     =@DrawList
    tmpgad->DoHit      =@ListHit
    tmpgad->DoHold     =@ListHold
    tmpgad->DoRelease  =@ListRelease
    tmpgad->DoKeyStream=0

    tmpgad->Ca=w
    tmpgad->Cb=rows
    tmpgad->Cc=cast(integer,@(sa(lbound(sa))))
    tmpgad->Cd=ubound(sa)
    if tmpgad->Cd=0 then tmpgad->Ce=0 else tmpgad->Ce=1

		SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)

    function=tmpgad
  end if
end function



function ListHit(hitgad as Gadget ptr,junk as Gadget ptr) as integer
  function=0
  dim as integer my=hitgad->event->MOUSEY
	dim as integer dwidth,drows,upperindex,scrollindex,tmpindex
  drows =hitgad->Cb
  upperindex=hitgad->Cd
  scrollindex=hitgad->Ce
  if upperindex>0 and my >= hitgad->posy+3 and my < hitgad->posy+3+fontheight*drows then
    tmpindex=scrollindex + (my - 3 - hitgad->posy)\fontheight
    if tmpindex>=1 and tmpindex<=upperindex then
      hitgad->value=tmpindex
      hitgad->DoDraw(hitgad)
      function=-1
    end if
  end if
end function



function ListHold(hitgad as Gadget ptr,holdgad as Gadget ptr) as integer
  function=0
end function



function ListRelease(hitgad as Gadget ptr,relgad as Gadget ptr) as integer
  function=0
end function



sub ScrollList(gad as Gadget ptr,si as integer)
  dim as integer drows,upperindex
  drows =gad->Cb
  upperindex=gad->Cd
  if upperindex then
    if si>upperindex-drows+1 then si=upperindex-drows+1'kann unter 1 sein !!
    if si<1 then si=1                                  'wird aber hiermit behoben
    gad->Ce=si
  else
    gad->Ce=0
  end if
  'gad->DoDraw(gad)
end sub



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



sub DrawList (gad as Gadget ptr)
	dim as integer x,y,w,h,offset,i
	dim as integer dwidth,drows,upperindex,scrollindex,tmpindex,selectindex
  dim as string ptr stringptr
  dim as string tmpstring
  x   =gad->posx
	y   =gad->posy
	w		=gad->gadw
	h		=gad->gadh
	offset=3

  dwidth=gad->Ca
  drows =gad->Cb
  stringptr=cast(string ptr,gad->Cc)
  upperindex=gad->Cd
  scrollindex=gad->Ce
  selectindex=gad->value

  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,white
		for i=0 to drows-1
      tmpindex=scrollindex+i
      if tmpindex>0 and tmpindex<= upperindex then
        tmpstring=UImport(left(stringptr[tmpindex],dwidth))
        if tmpindex=selectindex then
          ClearBox(x+offset, y+offset+i*fontheight,dwidth*8,fontheight,CursorColor)
          draw string ( x+offset, y+offset+i*fontheight ),tmpstring,white
        else
          ClearBox(x+offset, y+offset+i*fontheight,dwidth*8,fontheight,white)
          draw string ( x+offset, y+offset+i*fontheight ),tmpstring,TextColor
		    end if
      else
        ClearBox(x+offset, y+offset+i*fontheight,dwidth*8,fontheight,white)
      end if
    next i
  end if

  if gad->act=2 then
		FrameB x,y,w,h,1
    ClearBox x+1,y+1,w-2,h-2
    for i=0 to drows-1
      tmpindex=scrollindex+i
      if tmpindex>0 and tmpindex<= upperindex then
        tmpstring=UImport(left(stringptr[tmpindex],dwidth))
        if tmpindex=selectindex then ClearBox(x+offset, y+offset+i*fontheight,dwidth*8,fontheight,ShiftRGB(BackGroundColor,-contrast\8))
        draw string ( x+offset, y+offset+i*fontheight ),tmpstring,ShiftRGB(BackGroundColor,-contrast\2)
      end if
    next i
  end if
  screenunlock
end sub
'End ListBox.bas
'##############################################################################
'##############################################################################
