Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

ListBox_Basis.bas

Uploader:MitgliedMuttonhead
Datum/Zeit:17.07.2014 19:15:20

declare function AddLBGadget (event as EventHandle ptr,x as integer,y as integer,w as integer,lines as integer, mode as integer=0) as Gadget ptr
declare function LBActions(refgad as Gadget ptr,action as integer) as integer
declare sub DrawLB(gad as Gadget ptr)

declare sub VScrollLB(gad as Gadget ptr,l as integer)

'Ctrl(0)=Breite der Box in Zeichen
'Ctrl(1)=Höhe der Box in Zeilen
'Ctrl(2)=angescrollte Zeile, für Vertikalscrolling, oberste sichtbare Zeile in der Box
'Ctrl(3) mode 0="Normale Darstellung", 1=String ist nach Label und Item zu unterscheiden
'Ctrl(14) Regel/Returngröße: im mode 1 Item ID
'Ctrl(15)= Regel/Returngröße: im mode 0 angeklickte Zeile
function AddLBGadget (event as EventHandle ptr,x as integer,y as integer,w 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=w*8 + 6
    tmpgad->gadh=fontheight*lines + 6

    tmpgad->texto=new TextObject
    tmpgad->affiliation=1

    tmpgad->Ctrl(3)=mode
    tmpgad->Ctrl(15)=0

    tmpgad->Ctrl(0)=w
    tmpgad->Ctrl(1)=lines
    tmpgad->Ctrl(2)=1

    tmpgad->DoDraw     =@DrawLB
    tmpgad->DoAction   =@LBActions
    tmpgad->DoUpdate   =@UpdateGadgetDummy

        SaveBackGround(tmpgad)
    event->ChainGadget (tmpgad)

        function=tmpgad
  end if
end function



function LBActions(refgad as Gadget ptr,action as integer) as integer
  function=0
  dim as integer mx,my,l,ll,lcl,offset
  dim as string lc,header,itemid

  select case action

      case GADGET_HIT        'Control grad frisch gedrückt
        mx=refgad->event->MOUSEX
        my=refgad->event->MOUSEY
        ll=refgad->texto->GetLines
        l=0
        offset=3
        if ll then'wenn Zeilen im TO
          if my>=refgad->posy+offset and my<refgad->posy + refgad->gadh-offset then
            l=refgad->Ctrl(2) + int((my-refgad->posy-offset)/fontheight)
            if l>ll then l=ll
          end if
        end if
        if l>0 then'sollte gültig eine Zeile angeklickt worden sein
          if refgad->Ctrl(3) then 'mode 1
            lc=refgad->texto->GetLineContent(l)
            header=left(lc,3)
            if header="ITM" then
              itemid=mid(lc,5,3)
              refgad->Ctrl(14)=val(itemid)
              refgad->Ctrl(15)=l
              DrawGadget(refgad)
              function=1
            else
              'nichts
            end if
          else                    'mode 0
            refgad->Ctrl(15)=l
            DrawGadget(refgad)
            function=1
          end if
        end if

      case GADGET_HOLD       'Control wird gehalten, Maus über dem Control

      case GADGET_HOLDOFF    'Control wird gehalten, Maus neben dem Control

      case GADGET_RELEASE    'Control regulär losgelassen

      case GADGET_RELEASEOFF 'Control losgelassen, dabei ist Maus neben dem Control

      case GADGET_KEYBOARD   'Keyboardauswertung

  end select
end function



sub DrawLB (gad as Gadget ptr)
    dim as integer x,y,w,h,offset,lines
  dim as integer boxc,boxl,scrollpos,scrollline,lcount,selline
    dim as uinteger tcolor
  dim as TextLine ptr l
  dim as string tmpstring,cursorchar
  x   =gad->posx
    y   =gad->posy
    w       =gad->gadw
    h       =gad->gadh
    offset=3
  lines=TO_GetLines(gad)
  boxc=gad->Ctrl(0)
  boxl=gad->Ctrl(1)
  scrollpos=gad->Ctrl(2)
  scrollline=gad->Ctrl(2)
  l=gad->texto->GetLineAddr(scrollline)
  selline=gad->Ctrl(15)

  tmpstring=""
  screenlock
  if gad->act=0 then
    put(x,y),gad->Images(0),pset
  else
    FrameB x,y,w,h,1
        ClearBox x+1,y+1,w-2,h-2,white
    if lines then
      lcount=0
      do
        tmpstring=gad->texto->GetLineContent(l)

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

          if left(tmpstring,3)="LBL" then
            tmpstring=left(right(tmpstring,len(tmpstring)-4),boxc)
            FillA x+1,y+offset+lcount*fontheight,w-1,fontheight,GadgetColor,1
          end if

          if left(tmpstring,3)="ITM" then tmpstring=left(space(3) & right(tmpstring,len(tmpstring)-8),boxc)

        else                  'mode 0

          tmpstring=left(tmpstring,boxc)

        end if

        if (scrollline+lcount=selline) then
          tcolor=white
          ClearBox x+1,y+offset+lcount*fontheight,w-2,fontheight,CursorColor
        else
          tcolor=TextColor
        end if

        draw string ( x+offset, y+offset+lcount*fontheight ),tmpstring,tcolor

        l=l->nextline
          lcount +=1
      loop until (l=0) or (lcount=boxl)'keine Zeile im TO oder der Zeilenzähler=Anzahl der zu zeigenden Zeilen(lcount startet bei 0!)
    end if
    if gad->act=2 then put(x,y),gad->Images(0),alpha,SleepShade 'Shade (x, y,w, h,gad->Images(0))
  end if
  screenunlock
end sub



sub VScrollLB(gad as Gadget ptr,l as integer)
  gad->Ctrl(2)=l
end sub