Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
ListBox_Basis.bas
| Uploader: |  Muttonhead |
| Datum/Zeit: | 17.07.2014 18:06:59 |
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
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