fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
ListBox.bas

Uploader:	Muttonhead
Datum/Zeit:	17.07.2014 18:07:51
#include once "ListBox_Basis.bas"

#include once "ScrollBar.bas"



declare function AddListBox (event as EventHandle ptr,x as integer,y as integer,c as integer,lines as integer,mode as integer=0) as Gadget ptr

declare function ListActions(refgad as Gadget ptr,action as integer) as integer

declare sub DrawList (gad as Gadget ptr)

declare sub UpdateLB(gad as Gadget ptr)



declare sub ListSubHandle(gad as Gadget ptr)



declare function GetListBoxVal(gad as Gadget ptr) as integer

declare sub SetListBoxVal(gad as Gadget ptr,i as integer)



'Ctrl(1) mode 0="Normale Darstellung", 1=String ist nach Label und Item zu unterscheiden

'Ctrl(15) wenn 1 wird ein Ping gegeben

function AddListBox(event as EventHandle ptr,x as integer,y as integer,c as integer,lines as integer,mode as integer=0) as Gadget ptr

  function=0

  dim as Gadget ptr tmpgad

  tmpgad=new Gadget

  if tmpgad then

    tmpgad->event=event

    tmpgad->nextGadget=0

    tmpgad->sel=0

    tmpgad->act=0

    tmpgad->posx=x

    tmpgad->posy=y

    tmpgad->gadw=c*8 + 6 + 15 '6 >> Rand innerhalb MLEB,  15>> Breite ScrollBar rechts

    tmpgad->gadh=fontheight*lines + 6'6 >> Rand innerhalb MLEB



    tmpgad->Ctrl(1)=mode



    tmpgad->subevent=CreateEventHandle

        if tmpgad->subevent then

      tmpgad->gad(0)=AddLBGadget(tmpgad->subevent,x,y,c,lines,mode)

        tmpgad->gad(1)=AddScrollBar(tmpgad->subevent,x+c*8 + 6,y,lines*fontheight+6+1,1,1,1,lines,1)

        end if



    tmpgad->texto=tmpgad->gad(0)->texto'Verbindung zum Textobjekt erzeugen das eigentlich zur LB in gad(0) gehört

    tmpgad->affiliation=0'das TO darf nicht bei Zugriff über dieses Control gelöscht werden



    tmpgad->DoDraw     =@DrawList

    tmpgad->DoAction   =@ListActions

    tmpgad->DoUpdate   =@UpdateLB



        SaveBackGround(tmpgad)

    event->ChainGadget (tmpgad)



        function=tmpgad

  end if

end function







function ListActions(refgad as Gadget ptr,action as integer) as integer

  function=0

  dim as integer enable

  select case action

      case GADGET_HIT,GADGET_HOLD,GADGET_HOLDOFF,GADGET_RELEASE,GADGET_RELEASEOFF

        ListSubHandle(refgad)

        if refgad->Ctrl(15) then function=1

  end select

end function







sub DrawList (gad as Gadget ptr)

  DrawGadget(gad->gad(0))

end sub







sub UpdateLB(gad as Gadget ptr)

  gad->gad(0)->Ctrl(15)=0'Selektion in LB aufheben

  ModifyScrollBar(gad->gad(1),1,TO_GetLines(gad),1)

  VScrollLB(gad->gad(0),1)

  DrawGadget(gad->gad(0))

end sub







sub ListSubHandle(gad as Gadget ptr)

  gad->subevent->xSleep(-1,0)'"Durchläufer" und ohne SLEEP

  gad->Ctrl(15)=0

  if gad->subevent->GADGETMESSAGE then

    select case gad->subevent->GADGETMESSAGE

      case gad->gad(0)

        gad->Ctrl(15)=1

      case gad->gad(1)

        VScrollLB(gad->gad(0),GetScrollBarVal(gad->gad(1)))

        DrawGadget(gad->gad(0))

    end select

  end if

end sub







function GetListBoxVal(gad as Gadget ptr) as integer

  if gad->Ctrl(1) then

    function=gad->gad(0)->Ctrl(14)

  else

    function=gad->gad(0)->Ctrl(15)

  end if

end function







sub SetListBoxVal(gad as Gadget ptr,i as integer)

  dim as integer l,lcount,found

  dim as string lc,header

  dim as integer itemid

  l=TO_GetLines(gad)

  'im mode 1 steht i für die item ID nachder in allen Zeilen des TOs gesucht wird

  'wird die Zeile gefunden



  'im mode 0 entsprich i direkt der Zeile



  if gad->Ctrl(1) then              'mode 1

    if l then

      lcount=1

      found=0

      do

        lc=TO_GetLineContent(gad,lcount)

        header=left(lc,3)

        if header="ITM" then

          itemid=val(mid(lc,5,3))

          if itemid=i then found=lcount

        end if

        lcount +=1

      loop until (lcount>l) or (found>0)

      'found ist die Zeilennummer in der i als Item ID definiert ist

      if found then

        gad->gad(0)->Ctrl(14)=i

        gad->gad(0)->Ctrl(15)=found

        ModifyScrollBar(gad->gad(1),found)

        VScrollLB(gad->gad(0),GetScrollBarVal(gad->gad(1)))

        DrawGadget(gad)

      end if

    end if



 else                              'mode 0



    if i<0 then i=0

    if i>l then i=l

    gad->gad(0)->Ctrl(15)=i

    ModifyScrollBar(gad->gad(1),i)

    VScrollLB(gad->gad(0),GetScrollBarVal(gad->gad(1)))

    DrawGadget(gad)

  end if

end sub