Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
SimpleGUImerge.bi
| Uploader: |  Muttonhead |
| Datum/Zeit: | 21.12.2008 14:49:54 |
'##############################################################################
'##############################################################################
'Begin WaitEvent.bi
Dim shared As Integer ASCCODE,SCANCODE,MOUSEX,MOUSEY,LMB,MMB,RMB,EXITPROG
const as integer PRESSED=1
const as integer RELEASED=0
declare sub WaitEvent
sub WaitEvent
static as integer event,omx,omy,button,olmb,ommb,ormb
static as string keybrd
event=0
keybrd=""
ASCCODE=-1
SCANCODE=-1
do
GetMouse(MOUSEX,MOUSEY,,button)
if button and 1 then LMB=PRESSED else LMB=RELEASED
if button and 2 then RMB=PRESSED else RMB=RELEASED
if button and 4 then MMB=PRESSED else MMB=RELEASED
keybrd=inkey
'Event MousePosition + MouseBewegung
if MOUSEX<>omx or MOUSEY<>omy then
omx=MOUSEX
omy=MOUSEY
event=1
end if
'Event LMB
if LMB then event=1
if LMB=RELEASED and olmb=PRESSED then event=1
olmb=LMB
'Event RMB
if ormb<>RMB then
ormb=RMB
event=1
end if
'Event MMB
if ommb<>MMB then
ommb=MMB
event=1
end if
'Event Tastatur & CloseButton
if keybrd<>"" then
if len(keybrd)=1 then
ASCCODE=asc(keybrd)
end if
if len(keybrd)=2 then
ASCCODE=asc(left(keybrd,1))
SCANCODE=asc(right(keybrd,1))
end if
if ASCCODE=255 and SCANCODE=107 then EXITPROG=1' chr(255,107) CloseButton oder AltGr+F4
event=1
end if
sleep 1
loop until event
end sub
'End Waitevent.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin SimpleGUI.bi
'#include "simplegui\WaitEvent.bi"
'Screen Stuff
dim shared as integer fontheight
'ColorSet
dim shared as uinteger bgrnd,black,white,curs
dim shared as uinteger alite,anorm,adark
dim shared as uinteger blite,bnorm,bdark
dim shared as uinteger glite,gdark
'Gadget Stuff
type Gadget
gadtype as integer ' Gadget Typ
sel as integer ' Gadget Selektion
act as integer ' Gadget Aktivierung
posx as integer ' PositionX
posy as integer ' PositionY
gadw as integer ' Gadget Breite
gadh as integer ' Gadget Höhe
gadtext as string ' Gadget Text
buffstr as string ' String Text Puffer
buffval as integer ' Trackbar,Slider Puffer
DoDraw as sub (gadnum as integer)
DoPress as function (pressgad as integer) as integer
DoHold as function (pressgad as integer,actgad as integer) as integer
DoRelease as function (pressgad as integer,releasegad as integer) as integer
ctrla as integer ' Steuerungsvariablen, je nach Gadgettyp unterschiedlich genutzt
ctrlb as integer '
ctrlc as integer '
ctrld as integer '
ctrle as integer '
ctrlf as integer '
ctrlg as integer '
end type
dim shared as integer maxgad=64
dim shared as Gadget GadgetList(1 to maxgad)
'HauptSub
declare function GadgetControl as integer
'Hilfsfunktionen und Subs für alle Gadget
declare sub DrawGadget (gadnum as integer)
declare function GetGadgetNumber as integer
declare function GetSelect (gadnum as integer) as integer
declare sub SetSelect (gadnum as integer,mode as integer)
declare sub GadgetOn (gadnum as integer)
declare sub GadgetSleep (gadnum as integer)
declare sub GadgetOff (gadnum as integer)
'Font &Vars
declare sub SetColors
declare function GetFontHeight as integer
'HauptSub
function GadgetControl as integer
dim as integer gadnum,SendMessage
static as integer remembergad,rememberstringgad
gadnum=0
SendMessage=0
'string handle
if rememberstringgad>0 then
if ASCCODE>-1 or SCANCODE>-1 then
if ASCCODE<>13 then
'!!Achtung!!.DoHold enthält bei StringGadgets den eigentlichen StringEditor :)
SendMessage=GadgetList(rememberstringgad).DoHold(rememberstringgad,0)
else
GadgetList(rememberstringgad).ctrlc=1
GadgetList(rememberstringgad).ctrld=0
SetSelect (rememberstringgad,0)
SendMessage=rememberstringgad
rememberstringgad=0
endif
end if
end if
'press handle
if LMB=PRESSED then
gadnum=GetGadgetNumber'<-----------!!!!!
if gadnum=-1 and remembergad=0 then remembergad=gadnum
'deaktiviere StringGadget wenn was anderes angeklickt wird
if rememberstringgad>0 and gadnum<>rememberstringgad then
GadgetList(rememberstringgad).ctrlc=1
GadgetList(rememberstringgad).ctrld=0
SetSelect (rememberstringgad,0)
rememberstringgad=0
end if
'hold
if remembergad>0 and rememberstringgad=0 then ' und es ist kein StringGadget, da wir .DoHold für StringEditor
SendMessage=GadgetList(remembergad).DoHold(remembergad,gadnum) 'benutzen werden. siehe oben!!
end if
'1st hit
if gadnum>0 and remembergad=0 then
remembergad=gadnum
SendMessage=GadgetList(remembergad).DoPress(remembergad)
if SendMessage=-1 then 'bei -1 ist es ein Stringadget
rememberstringgad=remembergad 'aktivieren eines StringGadget
SendMessage=0
end if
end if
end if
'release handle
if LMB=RELEASED then
gadnum=GetGadgetNumber'<-----------!!!!!
if remembergad>0 then SendMessage=GadgetList(remembergad).DoRelease(remembergad,gadnum)
remembergad=0
end if
function=SendMessage
end function
'******************************************************************************
'******************************************************************************
'Hilfsfunktionen und Subs für alle Gadgets
function GetGadgetNumber as integer
dim as integer i,gadnum
gadnum=-1
for i=1 to maxgad
if GadgetList(i).act=1 then 'nur Activation=1 liefert eine Antwort
if MOUSEX>=GadgetList(i).posx and MOUSEX<GadgetList(i).posx+GadgetList(i).gadw and _
MOUSEY>=GadgetList(i).posy and MOUSEY<GadgetList(i).posy+GadgetList(i).gadh then gadnum=i
end if
next i
function=gadnum
end function
sub DrawGadget(gadnum as integer)
GadgetList(gadnum).DoDraw(gadnum)
end sub
function GetSelect (gadnum as integer) as integer
function=GadgetList(gadnum).sel
end function
sub SetSelect (gadnum as integer,selection as integer)
GadgetList(gadnum).sel=selection
GadgetList(gadnum).DoDraw(gadnum)
end sub
sub GadgetOn (gadnum as integer)
GadgetList(gadnum).act=1
GadgetList(gadnum).DoDraw(gadnum)
end sub
sub GadgetSleep (gadnum as integer)
GadgetList(gadnum).act=2
GadgetList(gadnum).DoDraw(gadnum)
end sub
sub GadgetOff (gadnum as integer)
GadgetList(gadnum).act=0
GadgetList(gadnum).DoDraw(gadnum)
end sub
'******************************************************************************
'******************************************************************************
'Font & Vars
sub SetColors
fontheight=GetFontHeight
bgrnd=&he8e8e8 'hintergrund
black=&h000000 'schwarz
white=&hffffff 'weiss
curs=&hdd8833 'cursor
alite=&hf2f2f2 'Farbe a hell
anorm=&he0e0e0 'Farbe a normal
adark=&h909090 'Farbe a dunkel
blite=&hd8eefa 'Farbe b hell
bnorm=&hb7d9ed 'Farbe b normal
bdark=&h4e8cbe 'Farbe b dunkel
glite=&hf2f2f2 'ghost (Mode 3) hell
gdark=&hb8b8b8 'ghost (Mode 3) dunkel
color black,bgrnd
cls
end sub
'Nach einer Idee von Volta :)
function GetFontHeight as integer
dim as integer h,fheight
screeninfo ,h
select case h\hiword(width)
case is < 8
fheight=0
case 8 to 13
fheight=8
case 14, 15
fheight=14
case is > 15
fheight=16
end select
function=fheight
end function
'#include "simplegui\GFXAdds.bi"
'End SimpleGUI.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin GFXAdds.bi
declare sub Frame (x as integer, y as integer, w as integer, h as integer, txt as string)
sub Frame (x as integer, y as integer, w as integer, h as integer, txt as string)
line (x+1,y+1)-(x+w-1,y+h-1),white,b
line (x,y)-(x+w-2,y+h-2),gdark,b
if len(txt) then
line(x+8,y-fontheight/2)-(x+8+8*len(txt),y-fontheight/2+fontheight),bgrnd,bf
draw string (x+8,y-fontheight/2),txt,black
end if
end sub
'End GFXAdds.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin SimpleGadget.bi
declare sub AddSimpleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,txt as string)
declare function SGPress(pressgad as integer) as integer
declare function SGHold (pressgad as integer,actgad as integer) as integer
declare function SGRelease (pressgad as integer,releasegad as integer) as integer
declare sub DrawSimpleGadget (gadnum as integer)
sub AddSimpleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,txt as string)
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=w
GadgetList(gadnum).gadh=h
GadgetList(gadnum).gadtext=txt
GadgetList(gadnum).DoDraw =@DrawSimpleGadget
GadgetList(gadnum).DoPress =@SGPress
GadgetList(gadnum).DoHold =@SGHold
GadgetList(gadnum).DoRelease =@SGRelease
end sub
function SGPress(pressgad as integer) as integer
SetSelect (pressgad,1)
function=0
end function
function SGHold (pressgad as integer,actgad as integer) as integer
function=0
end function
function SGRelease (pressgad as integer,releasegad as integer) as integer
SetSelect (pressgad,0)
if pressgad=releasegad then function=pressgad else function=0
end function
sub DrawSimpleGadget (gadnum as integer)
dim as integer x,y,w,h
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
'inactive invisible
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
end if
'active
if GadgetList(gadnum).act=1 then
'unselected
if GadgetList(gadnum).sel=0 then
line (x,y+h-2)-(x,y+1),adark
line (x+1,y)-(x+w-2,y),adark
line (x+w-1,y+1)-(x+w-1,y+h-2),adark
line (x+w-2,y+h-1)-(x+1,y+h-1),adark
pset (x+1,y+1),adark
pset (x+w-2,y+1),adark
pset (x+w-2,y+h-2),adark
pset (x+1,y+h-2),adark
line (x+1,y+h-3)-(x+1,y+2),white
line (x+2,y+1)-(x+w-3,y+1),white
line (x+w-2,y+2)-(x+w-2,y+h-3),anorm
line (x+w-3,y+h-2)-(x+2,y+h-2),anorm
line (x+2,y+2)-(x+w-3,y+h\2-1),alite,bf
line (x+2,y+h\2)-(x+w-3,y+h-3),anorm,bf
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,black
end if
'selected
if GadgetList(gadnum).sel=1 then
line (x,y+h-2)-(x,y+1),bdark
line (x+1,y)-(x+w-2,y),bdark
line (x+w-1,y+1)-(x+w-1,y+h-2),bdark
line (x+w-2,y+h-1)-(x+1,y+h-1),bdark
pset (x+1,y+1),bdark
pset (x+w-2,y+1),bdark
pset (x+w-2,y+h-2),bdark
pset (x+1,y+h-2),bdark
line (x+1,y+h-3)-(x+1,y+2),bnorm
line (x+2,y+1)-(x+w-3,y+1),bnorm
line (x+w-2,y+2)-(x+w-2,y+h-3),blite
line (x+w-3,y+h-2)-(x+2,y+h-2),blite
line (x+2,y+2)-(x+w-3,y+h\2),blite,bf
line (x+2,y+h\2+1)-(x+w-3,y+h-3),bnorm,bf
draw string ( x+1+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+1+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,black
end if
end if
'inactive visible(ghosted)
if GadgetList(gadnum).act=2 then
line (x,y+h-2)-(x,y+1),gdark
line (x+1,y)-(x+w-2,y),gdark
line (x+w-1,y+1)-(x+w-1,y+h-2),gdark
line (x+w-2,y+h-1)-(x+1,y+h-1),gdark
pset (x+1,y+1),gdark
pset (x+w-2,y+1),gdark
pset (x+w-2,y+h-2),gdark
pset (x+1,y+h-2),gdark
line (x+2,y+2)-(x+w-3,y+h-3),bgrnd,bf
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,gdark
end if
end sub
'End SimpleGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin StringGadget.bi
declare sub AddStringGadget (gadnum as integer,x as integer,y as integer,glen as integer,slen as integer,txt as string)
declare function StrGPress(pressgad as integer) as integer
declare function EditString (gadnum as integer,dummy as integer) as integer
declare function StrGRelease (pressgad as integer,releasegad as integer) as integer
declare sub PutString (gadnum as integer,txt as string)
declare function GetString (gadnum as integer) as string
declare sub DrawStringGadget (gadnum as integer)
sub AddStringGadget (gadnum as integer,x as integer,y as integer,glen as integer,slen as integer,txt as string)
if len(txt)>slen then txt=left(txt,slen)
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=(glen)*8+6
GadgetList(gadnum).gadh=GetFontHeight+6
GadgetList(gadnum).buffstr=txt
GadgetList(gadnum).DoDraw =@DrawStringGadget
GadgetList(gadnum).DoPress =@StrGPress
GadgetList(gadnum).DoHold =@EditString
GadgetList(gadnum).DoRelease =@StrGRelease
GadgetList(gadnum).ctrla=glen
GadgetList(gadnum).ctrlb=slen
GadgetList(gadnum).ctrlc=1
GadgetList(gadnum).ctrld=0
end sub
function StrGPress(pressgad as integer) as integer
GadgetList(pressgad).ctrlc=GadgetList(pressgad).ctrld+(MOUSEX-GadgetList(pressgad).posx-3)\8+1
if GadgetList(pressgad).ctrlc >GadgetList(pressgad).ctrld+GadgetList(pressgad).ctrla then _
GadgetList(pressgad).ctrlc=GadgetList(pressgad).ctrld+GadgetList(pressgad).ctrla
if GadgetList(pressgad).ctrlc > len(GadgetList(pressgad).buffstr)+1 then _
GadgetList(pressgad).ctrlc=len(GadgetList(pressgad).buffstr)+1
SetSelect (pressgad,1)
function=-1 'statt 0 liefern wir -1 GadgetControl erkennt daran ein StringGadget!!
end function
'die wichtigste Funktion - den Stringeditor - verpacken
'wir in .DoHold
function EditString (gadnum as integer,dummy as integer) as integer
dim as string lpart,rpart
'Move Cursor
if SCANCODE=75 and GadgetList(gadnum).ctrlc > 1 then GadgetList(gadnum).ctrlc -=1
if SCANCODE=77 and GadgetList(gadnum).ctrlc < len(GadgetList(gadnum).buffstr)+1 then GadgetList(gadnum).ctrlc +=1
'Backspace
if GadgetList(gadnum).ctrlc>1 then 'wenn Cursor grösser 1
if SCANCODE=14 or ASCCODE=8 then
if GadgetList(gadnum).ctrlc=len(GadgetList(gadnum).buffstr)+1 then 'wenn Cursor hinter Text
GadgetList(gadnum).buffstr=left(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-1)
elseif GadgetList(gadnum).ctrlc=2 then 'wenn Cursor an 2.Stelle
GadgetList(gadnum).buffstr=right(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-1)
else 'wenn Cursor mittendrin
lpart=left(GadgetList(gadnum).buffstr,GadgetList(gadnum).ctrlc-2)
rpart=right(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-GadgetList(gadnum).ctrlc+1)
GadgetList(gadnum).buffstr=lpart+rpart
end if
if GadgetList(gadnum).ctrld>0 then GadgetList(gadnum).ctrld -=1 'ScrollOffset verändern
GadgetList(gadnum).ctrlc -=1 'Cusorposition verringern
end if
end if
'Delete
if GadgetList(gadnum).ctrlc<=len(GadgetList(gadnum).buffstr) then 'wenn Cursor im Text
if SCANCODE=83 or ASCCODE=127 then
if GadgetList(gadnum).ctrlc=len(GadgetList(gadnum).buffstr) then 'wenn Cursor auf letzem Zeichen
GadgetList(gadnum).buffstr=left(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-1)
elseif GadgetList(gadnum).ctrlc=1 then 'wenn Cursor auf erstem Zeichen
GadgetList(gadnum).buffstr=right(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-1)
else 'ansonsten (wenn) Cursor mittendrin
lpart=left(GadgetList(gadnum).buffstr,GadgetList(gadnum).ctrlc-1)
rpart=right(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-GadgetList(gadnum).ctrlc)
GadgetList(gadnum).buffstr=lpart+rpart
end if
end if
end if
'Add Char
if len(GadgetList(gadnum).buffstr)<GadgetList(gadnum).ctrlb then 'wenn Textlänge kleiner ma. Textlänge
if ASCCODE>=32 and ASCCODE<>127 and ASCCODE<>257 and ASCCODE<>258 and ASCCODE<>259 and ASCCODE<>260 and ASCCODE<255 then
'Ausschluss folgender Zeichen: alle ASC codes unter 32 sowie ESC,BACKSPACE,DEL,UP,DOWN,LEFT,RIGHT sowie ASC(255)
if len(GadgetList(gadnum).buffstr)>0 then 'wenn kein Leerstring
if GadgetList(gadnum).ctrlc=1 then 'wenn Curor an erster Stelle
GadgetList(gadnum).buffstr=chr(ASCCODE)+GadgetList(gadnum).buffstr
elseif GadgetList(gadnum).ctrlc=len(GadgetList(gadnum).buffstr)+1 then 'wenn Cursor hinter Text
GadgetList(gadnum).buffstr=GadgetList(gadnum).buffstr+chr(ASCCODE)
else 'ansonsten (wenn) Cursor mittendrin
lpart=left(GadgetList(gadnum).buffstr,GadgetList(gadnum).ctrlc-1)
rpart=right(GadgetList(gadnum).buffstr,len(GadgetList(gadnum).buffstr)-GadgetList(gadnum).ctrlc+1)
GadgetList(gadnum).buffstr=lpart+chr(ASCCODE)+rpart
end if
GadgetList(gadnum).ctrlc +=1
end if
if len(GadgetList(gadnum).buffstr)=0 then 'wenn Leerstring dann
GadgetList(gadnum).buffstr=chr(ASCCODE)
GadgetList(gadnum).ctrlc +=1
end if
end if
end if
'Scrolling
if GadgetList(gadnum).ctrlc<GadgetList(gadnum).ctrld+1 then
GadgetList(gadnum).ctrld=GadgetList(gadnum).ctrlc-1
end if
if GadgetList(gadnum).ctrlc>GadgetList(gadnum).ctrld+GadgetList(gadnum).ctrla then
GadgetList(gadnum).ctrld=GadgetList(gadnum).ctrlc-GadgetList(gadnum).ctrla
end if
GadgetList(gadnum).DoDraw(gadnum)
function=0
end function
function StrGRelease (pressgad as integer,releasegad as integer) as integer
function=0
end function
function GetString (gadnum as integer) as string
function=GadgetList(gadnum).buffstr
end function
sub PutString (gadnum as integer,txt as string)
if len(txt)>GadgetList(gadnum).ctrlb then txt=left(txt,GadgetList(gadnum).ctrlb)
GadgetList(gadnum).ctrlc=1
GadgetList(gadnum).ctrld=0
GadgetList(gadnum).buffstr=txt
DrawGadget (gadnum)
end sub
sub DrawStringGadget (gadnum as integer)
dim as integer x,y,w,h,i,c,o,os
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
c =GadgetList(gadnum).ctrlc
o =GadgetList(gadnum).ctrld
os =3
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
if GadgetList(gadnum).sel=0 then
for i=1 to GadgetList(gadnum).ctrla
line( x+os+8*(i-1),y+os)-(x+os+8*(i)-1,y+os+fontheight-1),white,bf
if i+o<=len(GadgetList(gadnum).buffstr) then
draw string ( x+os+8*(i-1), y+os ),mid(GadgetList(gadnum).buffstr,i+o,1),black
end if
next i
line(x,y+h-2)-(x,y),adark
line(x,y)-(x+w-1,y),adark
line(x+w-1,y+1)-(x+w-1,y+h-1),anorm
line(x+w-1,y+h-1)-(x,y+h-1),anorm
line(x+1,y+1)-(x+w-2,y+h-2),white,b
line(x+2,y+2)-(x+w-3,y+h-3),white,b
end if
if GadgetList(gadnum).sel=1 then
for i=1 to GadgetList(gadnum).ctrla
if i+o=c then
line( x+os+8*(i-1),y+os)-(x+os+8*(i)-1,y+os+fontheight-1),curs,bf
draw string ( x+os+8*(i-1), y+os ),mid(GadgetList(gadnum).buffstr,i+o,1),white
else
line( x+os+8*(i-1),y+os)-(x+os+8*(i)-1,y+os+fontheight-1),white,bf
draw string ( x+os+8*(i-1), y+os ),mid(GadgetList(gadnum).buffstr,i+o,1),black
end if
next i
line(x,y+h-2)-(x,y),bdark
line(x,y)-(x+w-1,y),bdark
line(x+w-1,y+1)-(x+w-1,y+h-1),bnorm
line(x+w-1,y+h-1)-(x,y+h-1),bnorm
line(x+1,y+1)-(x+w-2,y+h-2),white,b
line(x+2,y+2)-(x+w-3,y+h-3),white,b
end if
end if
if GadgetList(gadnum).act=2 then
for i=1 to GadgetList(gadnum).ctrla
line( x+os+8*(i-1),y+os)-(x+os+8*(i)-1,y+os+fontheight-1),bgrnd,bf
if i+o<=len(GadgetList(gadnum).buffstr) then
draw string ( x+os+8*(i-1), y+os ),mid(GadgetList(gadnum).buffstr,i+o,1),gdark
end if
next i
line(x,y+h-2)-(x,y),gdark
line(x,y)-(x+w-1,y),gdark
line(x+w-1,y+1)-(x+w-1,y+h-1),glite
line(x+w-1,y+h-1)-(x,y+h-1),glite
end if
end sub
'End StringGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin ToggleGadget.bi
declare sub AddToggleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,s as integer,txt as string)
declare function ToGPress(pressgad as integer) as integer
declare function ToGHold (pressgad as integer,actgad as integer) as integer
declare function ToGRelease (pressgad as integer,releasegad as integer) as integer
declare sub DrawToggleGadget (gadnum as integer)
declare sub ToTick (x as integer, y as integer)
declare sub ToTickGhost (x as integer, y as integer)
sub AddToggleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,s as integer,txt as string)
GadgetList(gadnum).sel=s
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=w
GadgetList(gadnum).gadh=h
GadgetList(gadnum).gadtext=txt
GadgetList(gadnum).DoDraw =@DrawToggleGadget
GadgetList(gadnum).DoPress =@ToGPress
GadgetList(gadnum).DoHold =@ToGHold
GadgetList(gadnum).DoRelease =@ToGRelease
end sub
function ToGPress(pressgad as integer) as integer
function=0
end function
function ToGHold (pressgad as integer,actgad as integer) as integer
function=0
end function
function ToGRelease (pressgad as integer,releasegad as integer) as integer
if pressgad=releasegad then
if GetSelect(pressgad)=1 then SetSelect(pressgad,0) else SetSelect(pressgad,1)
function=pressgad
else
function=0
end if
end function
sub DrawToggleGadget (gadnum as integer)
dim as integer x,y,w,h
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
if GadgetList(gadnum).sel=0 then
line (x,y+h-2)-(x,y+1),adark
line (x+1,y)-(x+w-2,y),adark
line (x+w-1,y+1)-(x+w-1,y+h-2),adark
line (x+w-2,y+h-1)-(x+1,y+h-1),adark
pset (x+1,y+1),adark
pset (x+w-2,y+1),adark
pset (x+w-2,y+h-2),adark
pset (x+1,y+h-2),adark
line (x+1,y+h-3)-(x+1,y+2),white
line (x+2,y+1)-(x+w-3,y+1),white
line (x+w-2,y+2)-(x+w-2,y+h-3),anorm
line (x+w-3,y+h-2)-(x+2,y+h-2),anorm
line (x+2,y+2)-(x+w-3,y+h\2-1),alite,bf
line (x+2,y+h\2)-(x+w-3,y+h-3),anorm,bf
draw string ( x-1+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y-1+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,white
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,black
end if
if GadgetList(gadnum).sel=1 then
line (x,y+h-2)-(x,y+1),bdark
line (x+1,y)-(x+w-2,y),bdark
line (x+w-1,y+1)-(x+w-1,y+h-2),bdark
line (x+w-2,y+h-1)-(x+1,y+h-1),bdark
pset (x+1,y+1),bdark
pset (x+w-2,y+1),bdark
pset (x+w-2,y+h-2),bdark
pset (x+1,y+h-2),bdark
line (x+1,y+h-3)-(x+1,y+2),bnorm
line (x+2,y+1)-(x+w-3,y+1),bnorm
line (x+w-2,y+2)-(x+w-2,y+h-3),blite
line (x+w-3,y+h-2)-(x+2,y+h-2),blite
line (x+2,y+2)-(x+w-3,y+h\2),blite,bf
line (x+2,y+h\2+1)-(x+w-3,y+h-3),bnorm,bf
ToTick(x+w-8,y+2)
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,white
draw string ( x+1+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+1+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,black
end if
end if
if GadgetList(gadnum).act=2 then
line (x,y+h-2)-(x,y+1),gdark
line (x+1,y)-(x+w-2,y),gdark
line (x+w-1,y+1)-(x+w-1,y+h-2),gdark
line (x+w-2,y+h-1)-(x+1,y+h-1),gdark
pset (x+1,y+1),gdark
pset (x+w-2,y+1),gdark
pset (x+w-2,y+h-2),gdark
pset (x+1,y+h-2),gdark
line (x+2,y+2)-(x+w-3,y+h-3),bgrnd,bf
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,white
draw string ( x+1+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+1+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,gdark
if GadgetList(gadnum).sel=1 then ToTickGhost(x+w-8,y+2)
end if
end sub
sub ToTick (x as integer,y as integer)
line(x,y+4)-(x+2,y+6),bdark
line(x,y+5)-(x+2,y+7),bdark
line(x+3,y+4)-(x+3,y+5),bdark
line(x+4,y+2)-(x+4,y+3),bdark
line(x+5,y+0)-(x+5,y+1),bdark
line(x+3,y+3)-(x+4,y+4),bnorm
line(x+4,y+1)-(x+5,y+2),bnorm
end sub
sub ToTickGhost (x as integer,y as integer)
line(x,y+4)-(x+2,y+6),gdark
line(x,y+5)-(x+2,y+7),gdark
line(x+3,y+4)-(x+3,y+5),gdark
line(x+4,y+2)-(x+4,y+3),gdark
line(x+5,y+0)-(x+5,y+1),gdark
line(x+3,y+3)-(x+4,y+4),glite
line(x+4,y+1)-(x+5,y+2),glite
end sub
'End ToggleGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin CheckmarkGadget.bi
declare sub AddCheckmarkGadget (gadnum as integer,x as integer,y as integer,s as integer)
declare function CmGPress(pressgad as integer) as integer
declare function CmGHold (pressgad as integer,actgad as integer) as integer
declare function CmGRelease (pressgad as integer,releasegad as integer) as integer
declare sub DrawCheckmarkGadget (gadnum as integer)
declare Sub CTick (x as integer,y as integer)
declare Sub CTickGhost (x as integer,y as integer)
sub AddCheckmarkGadget (gadnum as integer,x as integer,y as integer,s as integer)
GadgetList(gadnum).sel=s
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=13
GadgetList(gadnum).gadh=13
GadgetList(gadnum).DoDraw =@DrawCheckmarkGadget
GadgetList(gadnum).DoPress =@CmGPress
GadgetList(gadnum).DoHold =@CmGHold
GadgetList(gadnum).DoRelease =@CmGRelease
end sub
function CmGPress(pressgad as integer) as integer
function=0
end function
function CmGHold (pressgad as integer,actgad as integer) as integer
function=0
end function
function CmGRelease (pressgad as integer,releasegad as integer) as integer
if pressgad=releasegad then
if GetSelect(pressgad)=1 then SetSelect(pressgad,0) else SetSelect(pressgad,1)
function=pressgad
else
function=0
end if
end function
sub DrawCheckmarkGadget (gadnum as integer)
dim as uinteger ca,cb,cc,cd
dim as integer x,y
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
if GadgetList(gadnum).act=0 then
line (x,y)-(x+12,y+12),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
line (x,y)-(x+12,y+12),adark,b
line (x+1,y+1)-(x+11,y+11),alite,b
line (x+2,y+9)-(x+2,y+2),anorm
line (x+2,y+2)-(x+10,y+2),anorm
line (x+10,y+3)-(x+10,y+10),white
line (x+10,y+10)-(x+2,y+10),white
line (x+3,y+3)-(x+9,y+5),anorm,bf
line (x+3,y+6)-(x+9,y+9),alite,bf
if GadgetList(gadnum).sel=1 then CTick (x+2,y+2)
end if
if GadgetList(gadnum).act=2 then
line (x,y)-(x+12,y+12),gdark,b
line (x+1,y+1)-(x+11,y+11),bgrnd,bf
if GadgetList(gadnum).sel=1 then CTickGhost (x+2,y+2)
end if
end sub
sub CTick (x as integer,y as integer)
line(x+2,y+5)-(x+3,y+6),bdark
line(x+1,y+5)-(x+3,y+7),bdark
line(x,y+5)-(x+3,y+8),bdark
line(x+3,y+7)-(x+6,y),bdark
line(x+3,y+8)-(x+7,y),bdark
end sub
sub CTickGhost (x as integer,y as integer)
line(x+2,y+5)-(x+3,y+6),gdark
line(x+1,y+5)-(x+3,y+7),gdark
line(x,y+5)-(x+3,y+8),gdark
line(x+3,y+7)-(x+6,y),gdark
line(x+3,y+8)-(x+7,y),gdark
end sub
'End CheckmarkGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin RadioButton.bi
declare sub AddRadioButton (gadnum as integer,x as integer,y as integer,s as integer,pgad as integer)
declare function RBPress(pressgad as integer) as integer
declare function RBHold (pressgad as integer,actgad as integer) as integer
declare function RBRelease (pressgad as integer,releasegad as integer) as integer
declare sub DrawRadioButton (gadnum as integer)
declare sub RDot (x as integer,y as integer)
declare sub RDotGhost (x as integer,y as integer)
sub AddRadiobutton (gadnum as integer,x as integer,y as integer,s as integer,pgad as integer)
GadgetList(gadnum).sel=s
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=12
GadgetList(gadnum).gadh=12
GadgetList(gadnum).DoDraw =@DrawRadioButton
GadgetList(gadnum).DoPress =@RBPress
GadgetList(gadnum).DoHold =@RBHold
GadgetList(gadnum).DoRelease =@RBRelease
if pgad>0 then
GadgetList(gadnum).ctrla=GadgetList(pgad).ctrla' erstes Element aus vorhergehenden holen
GadgetList(pgad).ctrlb=gadnum 'ins vorhergehende Element dieses hier eintragen ---> Verkettung
end if
if pgad=0 then
GadgetList(gadnum).ctrla=gadnum 'sich selbst als erstes Element definieren
end if
GadgetList(gadnum).ctrlb=0
end sub
function RBPress(pressgad as integer) as integer
function=0
end function
function RBHold (pressgad as integer,actgad as integer) as integer
function=0
end function
function RBRelease (pressgad as integer,releasegad as integer) as integer
if pressgad=releasegad then
dim as integer element=GadgetList(pressgad).ctrla' erstes Element holen (in jedem RadioButton hinterlegt)
do
if element=pressgad then
SetSelect(element,1)
else
SetSelect(element,0)
end if
if GadgetList(element).ctrlb=0 then exit do
element=GadgetList(element).ctrlb 'Nachfolger holen
loop
function=pressgad
else
function=0
end if
end function
sub DrawRadioButton (gadnum as integer)
dim as uinteger ca,cb,cc,cd
dim as integer x,y
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
if GadgetList(gadnum).act=0 then
line (x,y)-(x+11,y+11),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
line(x,y+8)-(x,y+3),adark
line -(x+3,y),adark
line -(x+8,y),adark
line -(x+11,y+3),adark
line -(x+11,y+8),adark
line -(x+8,y+11),adark
line -(x+3,y+11),adark
line -(x,y+8),adark
line(x+1,y+8)-(x+1,y+3),alite
line -(x+3,y+1),alite
line -(x+8,y+1),alite
line -(x+10,y+3),alite
line -(x+10,y+8),alite
line -(x+8,y+10),alite
line -(x+3,y+10),alite
line -(x+1,y+8),alite
line(x+2,y+8)-(x+2,y+3),anorm
line -(x+3,y+2),anorm
line -(x+8,y+2),anorm
line -(x+9,y+3),anorm
line -(x+9,y+8),anorm
line -(x+8,y+9),anorm
line -(x+3,y+9),anorm
line -(x+2,y+8),anorm
line(x+3,y+3)-(x+8,y+5),anorm,bf
line(x+3,y+6)-(x+8,y+8),alite,bf
if GadgetList(gadnum).sel=1 then RDot (x+3,y+3)
end if
if GadgetList(gadnum).act=2 then
line(x,y+8)-(x,y+3),gdark
line -(x+3,y),gdark
line -(x+8,y),gdark
line -(x+11,y+3),gdark
line -(x+11,y+8),gdark
line -(x+8,y+11),gdark
line -(x+3,y+11),gdark
line -(x,y+8),gdark
line(x+3,y+1)-(x+8,y+1),glite
line(x+10,y+3)-(x+10,y+8),glite
line(x+3,y+10)-(x+8,y+10),glite
line(x+1,y+3)-(x+1,y+8),glite
line(x+2,y+2)-(x+9,y+9),glite,bf
if GadgetList(gadnum).sel=1 then RDotGhost (x+3,y+3)
end if
end sub
sub RDot (x as integer,y as integer)
line(x,y+4)-(x,y+1),black
line(x+1,y)-(x+4,y),black
line(x+5,y+1)-(x+5,y+4),black
line(x+4,y+5)-(x+1,y+5),black
line(x+1,y+1)-(x+2,y+1),bnorm
line(x+3,y+1)-(x+4,y+1),bdark
line(x+1,y+2)-(x+4,y+2),bdark
line(x+1,y+3)-(x+4,y+4),bdark,bf
end sub
sub RDotGhost (x as integer,y as integer)
line(x,y+4)-(x,y+1),gdark
line(x+1,y)-(x+4,y),gdark
line(x+5,y+1)-(x+5,y+4),gdark
line(x+4,y+5)-(x+1,y+5),gdark
paint (x+1,y+1),gdark,gdark
end sub
'End RadioButton.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin Trackbars.bi
declare sub AddHTrackbar (gadnum as integer,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,sc as integer)
declare sub AddVTrackbar (gadnum as integer,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,sc as integer)
declare function TbPress(pressgad as integer) as integer
declare function TbHold (pressgad as integer,actgad as integer) as integer
declare function TbRelease (pressgad as integer,releasegad as integer) as integer
declare sub SetPos(gadnum as integer,p as integer)
declare function GetPos(gadnum as integer)as integer
declare sub SetVal (gadnum as integer,va as integer)
declare function GetVal (gadnum as integer) as integer
declare function GetTargetVal(gadnum as integer,p as integer) as integer
declare sub DrawHTrackbar (gadnum as integer)
declare sub DrawVTrackbar (gadnum as integer)
declare sub Slot (gadnum as integer,x as integer,y as integer,w as integer,h as integer,p as integer)
declare sub SlotGhost (gadnum as integer,x as integer,y as integer,w as integer,h as integer,p as integer)
declare sub Scale (gadnum as integer,col as uinteger)
sub AddHTrackbar (gadnum as integer,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,sc as integer)
dim as integer range
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=l
GadgetList(gadnum).gadh=22
GadgetList(gadnum).buffval=va
GadgetList(gadnum).DoDraw =@DrawHTrackbar
GadgetList(gadnum).DoPress =@TbPress
GadgetList(gadnum).DoHold =@TbHold
GadgetList(gadnum).DoRelease =@TbRelease
GadgetList(gadnum).ctrla=mi
GadgetList(gadnum).ctrlb=ma
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadw-10))+5
GadgetList(gadnum).ctrld=sc
GadgetList(gadnum).ctrlg=0
end sub
sub AddVTrackbar (gadnum as integer,x as integer,y as integer,l as integer,mi as integer,ma as integer,va as integer,sc as integer)
dim as integer range
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=22
GadgetList(gadnum).gadh=l
GadgetList(gadnum).buffval=va
GadgetList(gadnum).DoDraw =@DrawVTrackbar
GadgetList(gadnum).DoPress =@TbPress
GadgetList(gadnum).DoHold =@TbHold
GadgetList(gadnum).DoRelease =@TbRelease
GadgetList(gadnum).ctrla=mi
GadgetList(gadnum).ctrlb=ma
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadh-10))+5
GadgetList(gadnum).ctrld=sc
GadgetList(gadnum).ctrlg=1
end sub
function TbPress(pressgad as integer) as integer
if GadgetList(pressgad).ctrlg=0 then
if MOUSEX-GadgetList(pressgad).posx>GadgetList(pressgad).ctrlc-6 and _ 'Knob Treffer
MOUSEX-GadgetList(pressgad).posx<GadgetList(pressgad).ctrlc+6 then
GadgetList(pressgad).ctrle=(MOUSEX-GadgetList(pressgad).posx)-GadgetList(pressgad).ctrlc 'Speichern des MouseOffsets überm Knob
GadgetList(pressgad).ctrlf=1 'SliderModus bei Hold aktivieren
SetSelect (pressgad,1)
else 'anderenfalls Knob jeweils eine Position in Richtung Wunschposition verschieben, kein HOLD
if GetTargetVal(pressgad,MOUSEX- GadgetList(pressgad).posx) < GetVal(pressgad) then
SetVal(pressgad,GetVal(pressgad)-1)
end if
if GetTargetVal(pressgad,MOUSEX- GadgetList(pressgad).posx)>GetVal(pressgad) then
SetVal(pressgad,GetVal(pressgad)+1)
end if
GadgetList(pressgad).ctrlf=0
end if
function=pressgad
end if
if GadgetList(pressgad).ctrlg=1 then
if MOUSEY-GadgetList(pressgad).posy>GadgetList(pressgad).ctrlc-6 and _
MOUSEY-GadgetList(pressgad).posy<GadgetList(pressgad).ctrlc+6 then
GadgetList(pressgad).ctrle=(MOUSEY-GadgetList(pressgad).posy)-GadgetList(pressgad).ctrlc 'Speichern des MouseOffsets überm Knob
GadgetList(pressgad).ctrlf=1 'SliderModus bei Hold aktivieren
SetSelect (pressgad,1)
else 'anderenfalls Knob jeweils eine Position in Richtung Wunschposition verschieben, kein HOLD
if GetTargetVal(pressgad,MOUSEY- GadgetList(pressgad).posy) < GetVal(pressgad) then
SetVal(pressgad,GetVal(pressgad)-1)
end if
if GetTargetVal(pressgad,MOUSEY- GadgetList(pressgad).posy)>GetVal(pressgad) then
SetVal(pressgad,GetVal(pressgad)+1)
end if
GadgetList(pressgad).ctrlf=0
end if
function=pressgad
end if
end function
function TbHold (pressgad as integer,actgad as integer) as integer
static as integer oldval
if GadgetList(pressgad).ctrlg=0 then
if GadgetList(pressgad).ctrlf=1 then
oldval=GetVal(pressgad)
SetVal(pressgad,GetTargetVal(pressgad,MOUSEX- GadgetList(pressgad).posx-GadgetList(pressgad).ctrle))
if oldval<>GetVal(pressgad) then function=pressgad else function=0
end if
end if
if GadgetList(pressgad).ctrlg=1 then
if GadgetList(pressgad).ctrlf=1 then
oldval=GetVal(pressgad)
SetVal(pressgad,GetTargetVal(pressgad,MOUSEY- GadgetList(pressgad).posy-GadgetList(pressgad).ctrle))
if oldval<>GetVal(pressgad) then function=pressgad else function=0
end if
end if
end function
function TbRelease (pressgad as integer,releasegad as integer) as integer
GadgetList(pressgad).ctrlf=0
SetSelect(pressgad,0)
function=0
end function
sub SetPos(gadnum as integer,p as integer)
SetVal(gadnum,GetTargetVal(gadnum,p))
end sub
sub SetVal (gadnum as integer,va as integer)
dim range as uinteger
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
GadgetList(gadnum).buffval=va
if GadgetList(gadnum).ctrlg=0 then
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadw-11))+5
end if
if GadgetList(gadnum).ctrlg=1 then
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadh-11))+5
end if
GadgetList(gadnum).DoDraw(gadnum)
end sub
function GetVal (gadnum as integer) as integer
function=GadgetList(gadnum).buffval
end function
function GetTargetVal(gadnum as integer,p as integer) as integer
dim as uinteger range
dim as integer targetval
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
if p<5 then p=5
if GadgetList(gadnum).ctrlg=0 then
if p>GadgetList(gadnum).gadw-6 then p=GadgetList(gadnum).gadw-6
targetval=GadgetList(gadnum).ctrla + range*(p-5)/(GadgetList(gadnum).gadw-11)
end if
if GadgetList(gadnum).ctrlg=1 then
if p>GadgetList(gadnum).gadh-6 then p=GadgetList(gadnum).gadh-6
targetval=GadgetList(gadnum).ctrla + range*(p-5)/(GadgetList(gadnum).gadh-11)
end if
function=targetval
end function
sub DrawHTrackbar (gadnum as integer)
dim as integer i,x,y,w,h,p,s,sc,range
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
p =GadgetList(gadnum).ctrlc
sc =GadgetList(gadnum).ctrld
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
if sc then Scale (gadnum,bgrnd)
end if
if GadgetList(gadnum).act=1 then
Slot(gadnum,x,y,w,h,p)
'clear l+r knob
if p>5 then
line (x,y) -(x+p-6,y+8),bgrnd,bf
line (x,y+13)-(x+p-6,y+h-1),bgrnd,bf
end if
if p<w-6 then
line (x+p+6,y) -(x+w-1,y+8),bgrnd,bf
line (x+p+6,y+13)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).sel=0 then
'knob unselect
'line (x+p-5,y) -(x+p+5,y+h-1),adark,b
line (x+p-4,y)-(x+p+4,y),adark
line (x+p+5,y+1)-(x+p+5,y+h-2),adark
line (x+p-4,y+h-1)-(x+p+4,y+h-1),adark
line (x+p-5,y+1)-(x+p-5,y+h-2),adark
pset(x+p-5,y),anorm
pset(x+p+5,y),anorm
pset(x+p+5,y+h-1),anorm
pset(x+p-5,y+h-1),anorm
line (x+p-4,y+1) -(x+p+4,y+h/2-1),alite,bf
line (x+p-4,y+h/2)-(x+p+4,y+h-2),anorm,bf
end if
if GadgetList(gadnum).sel=1 then
'knob select
line (x+p-4,y)-(x+p+4,y),bdark
line (x+p+5,y+1)-(x+p+5,y+h-2),bdark
line (x+p-4,y+h-1)-(x+p+4,y+h-1),bdark
line (x+p-5,y+1)-(x+p-5,y+h-2),bdark
pset(x+p-5,y),bnorm
pset(x+p+5,y),bnorm
pset(x+p+5,y+h-1),bnorm
pset(x+p-5,y+h-1),bnorm
line (x+p-4,y+1) -(x+p+4,y+h/2),blite,bf
line (x+p-4,y+h/2)-(x+p+4,y+h-2),bnorm,bf
end if
if sc then Scale (gadnum,adark)
end if
if GadgetList(gadnum).act=2 then
SlotGhost(gadnum,x,y,w,h,p)
'knob ghosted
line (x+p-4,y)-(x+p+4,y),gdark
line (x+p+5,y+1)-(x+p+5,y+h-2),gdark
line (x+p-4,y+h-1)-(x+p+4,y+h-1),gdark
line (x+p-5,y+1)-(x+p-5,y+h-2),gdark
pset(x+p-5,y),bgrnd
pset(x+p+5,y),bgrnd
pset(x+p+5,y+h-1),bgrnd
pset(x+p-5,y+h-1),bgrnd
line (x+p-4,y+1) -(x+p+4,y+h-2),bgrnd,bf
if sc then Scale (gadnum,gdark)
end if
end sub
sub DrawVTrackbar (gadnum as integer)
dim as integer i,x,y,w,h,p,s,sc,range
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
p =GadgetList(gadnum).ctrlc
sc =GadgetList(gadnum).ctrld
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
if sc then Scale (gadnum,bgrnd)
end if
if GadgetList(gadnum).act=1 then
Slot(gadnum,x,y,w,h,p)
'clear knob
if p>5 then
line (x,y) -(x+8,y+p-6),bgrnd,bf
line (x+13,y)-(x+w-1,y+p-6),bgrnd,bf
end if
if p<h-6 then
line (x,y+p+6) -(x+8,y+h-1),bgrnd,bf
line (x+13,y+p+6)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).sel=0 then
'knob
line (x+1,y+p-5) -(x+w-2,y+p-5),adark
line (x+w-1,y+p-4) -(x+w-1,y+p+4),adark
line (x+1,y+p+5) -(x+w-2,y+p+5),adark
line (x,y+p-4) -(x,y+p+4),adark
pset (x,y+p-5),anorm
pset (x+w-1,y+p-5),anorm
pset (x+w-1,y+p+5),anorm
pset (x,y+p+5),anorm
line (x+1,y+p-4) -(x+w/2-1,y+p+4),alite,bf
line (x+w/2,y+p-4)-(x+w-2,y+p+4),anorm,bf
end if
if GadgetList(gadnum).sel=1 then
'knob
line (x+1,y+p-5) -(x+w-2,y+p-5),bdark
line (x+w-1,y+p-4) -(x+w-1,y+p+4),bdark
line (x+1,y+p+5) -(x+w-2,y+p+5),bdark
line (x,y+p-4) -(x,y+p+4),bdark
pset (x,y+p-5),bnorm
pset (x+w-1,y+p-5),bnorm
pset (x+w-1,y+p+5),bnorm
pset (x,y+p+5),bnorm
line (x+1,y+p-4) -(x+w/2-1,y+p+4),blite,bf
line (x+w/2,y+p-4)-(x+w-2,y+p+4),bnorm,bf
end if
if sc then Scale (gadnum,adark)
end if
if GadgetList(gadnum).act=2 then
SlotGhost(gadnum,x,y,w,h,p)
'knob ghosted
line (x+1,y+p-5) -(x+w-2,y+p-5),gdark
line (x+w-1,y+p-4) -(x+w-1,y+p+4),gdark
line (x+1,y+p+5) -(x+w-2,y+p+5),gdark
line (x,y+p-4) -(x,y+p+4),gdark
pset (x,y+p-5),bgrnd
pset (x+w-1,y+p-5),bgrnd
pset (x+w-1,y+p+5),bgrnd
pset (x,y+p+5),bgrnd
line (x+1,y+p-4) -(x+w-2,y+p+4),bgrnd,bf
if sc then Scale (gadnum,gdark)
end if
end sub
sub Slot (gadnum as integer,x as integer,y as integer,w as integer,h as integer,p as integer)
if GadgetList(gadnum).ctrlg=0 then
if p>5 then
line (x,y+9)-(x+p-6,y+9),adark
line (x,y+10)-(x,y+11),adark
line (x+1,y+10)-(x+p-6,y+11),bgrnd,bf
line (x,y+12)-(x+p-6,y+12),alite
end if
if p<w-6 then
line (x+p+6,y+9)-(x+w-1,y+9),adark
line (x+p+6,y+10)-(x+w-1,y+11),bgrnd,bf
line (x+p+6,y+12)-(x+w-1,y+12),alite
line (x+w-1,y+10)-(x+w-1,y+12),alite
end if
end if
if GadgetList(gadnum).ctrlg=1 then
if p>5 then
line (x+9,y)-(x+9,y+p-6),adark
line (x+10,y)-(x+11,y),adark
line (x+10,y+1)-(x+11,y+p-6),bgrnd,bf
line (x+12,y)-(x+12,y+p-6),alite
end if
if p<h-6 then
line (x+9,y+p+6)-(x+9,y+h-1),adark
line (x+10,y+p+6)-(x+11,y+h-1),bgrnd,bf
line (x+12,y+p+6)-(x+12,y+h-1),alite
line (x+10,y+h-1)-(x+12,y+h-1),alite
end if
end if
end sub
sub SlotGhost (gadnum as integer,x as integer,y as integer,w as integer,h as integer,p as integer)
if GadgetList(gadnum).ctrlg=0 then
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla then
line (x,y+9)-(x+p-5,y+9),gdark
line (x,y+10)-(x,y+11),gdark
line (x+1,y+10)-(x+p-5,y+11),bgrnd,bf
line (x,y+12)-(x+p-5,y+12),glite
end if
if GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+p+4,y+9)-(x+w-1,y+9),gdark
line (x+p+4,y+10)-(x+w-1,y+11),bgrnd,bf
line (x+p+4,y+12)-(x+w-1,y+12),glite
line (x+w-1,y+11)-(x+w-1,y+12),glite
end if
end if
if GadgetList(gadnum).ctrlg=1 then
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla then
line (x+9,y)-(x+9,y+p-6),gdark
line (x+10,y)-(x+11,y),gdark
line (x+10,y+1)-(x+11,y+p-6),bgrnd,bf
line (x+12,y)-(x+12,y+p-6),glite
end if
if GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+9,y+p+5)-(x+9,y+h-1),gdark
line (x+10,y+p+5)-(x+11,y+h-1),bgrnd,bf
line (x+12,y+p+5)-(x+12,y+h-1),glite
line (x+11,y+h-1)-(x+12,y+h-1),glite
end if
end if
end sub
sub Scale (gadnum as integer,col as uinteger)
dim as integer i,x,y,w,h,range,s
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
for i=GadgetList(gadnum).ctrla to GadgetList(gadnum).ctrlb
if GadgetList(gadnum).ctrlg=0 then
s=((i-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadw-10))+5
line (x+s,y+GadgetList(gadnum).gadh+1)-(x+s,y+GadgetList(gadnum).gadh+3),col
else
s=((i-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadh-10))+5
line (x+GadgetList(gadnum).gadw+1,y+s)-(x+GadgetList(gadnum).gadw+3,y+s),col
end if
next i
end sub
'End Trackbars.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin arrows.bi
declare sub AddArrow (gadnum as integer,x as integer,y as integer,d as integer)
declare sub AddSmallArrow (gadnum as integer,x as integer,y as integer,d as integer)
declare sub DrawArrow (gadnum as integer)
declare sub DrawSmallArrow (gadnum as integer)
declare function APress(pressgad as integer) as integer
declare function AHold (pressgad as integer,actgad as integer) as integer
declare function ARelease (pressgad as integer,releasegad as integer) as integer
sub AddArrow (gadnum as integer,x as integer,y as integer,d as integer)
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
if d=0 or d=1 then
GadgetList(gadnum).gadw=16
GadgetList(gadnum).gadh=15
end if
if d=2 or d=3 then
GadgetList(gadnum).gadw=15
GadgetList(gadnum).gadh=16
end if
GadgetList(gadnum).DoDraw =@DrawArrow
GadgetList(gadnum).DoPress =@APress
GadgetList(gadnum).DoHold =@AHold
GadgetList(gadnum).DoRelease =@ARelease
GadgetList(gadnum).ctrlg=d
end sub
sub AddSmallArrow (gadnum as integer,x as integer,y as integer,d as integer)
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
if d=0 or d=1 then
GadgetList(gadnum).gadw=10
GadgetList(gadnum).gadh=9
end if
if d=2 or d=3 then
GadgetList(gadnum).gadw=9
GadgetList(gadnum).gadh=10
end if
GadgetList(gadnum).DoDraw =@DrawSmallArrow
GadgetList(gadnum).DoPress =@APress
GadgetList(gadnum).DoHold =@AHold
GadgetList(gadnum).DoRelease =@ARelease
GadgetList(gadnum).ctrlg=d
end sub
function APress(pressgad as integer) as integer
SetSelect (pressgad,1)
function=pressgad
end function
function AHold (pressgad as integer,actgad as integer) as integer
static as double tt
function=0
if pressgad=actgad then
if GadgetList(pressgad).ctrla=1 and timer >= tt+.8 then
tt=timer
GadgetList(pressgad).ctrla=2
function=pressgad
elseif GadgetList(pressgad).ctrla=2 and timer >= tt+.1 then
tt=timer
function=pressgad
else
function=0
end if
if GadgetList(pressgad).ctrla=0 then
tt=timer
GadgetList(pressgad).ctrla=1
end if
end if
end function
function ARelease (pressgad as integer,releasegad as integer) as integer
GadgetList(pressgad).ctrla=0
SetSelect (pressgad,0)
function=0
end function
sub DrawArrow (gadnum as integer)
dim as integer i,x,y,w,h
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
if GadgetList(gadnum).sel=0 then
'box
line (x,y+h-2)-(x,y+1),adark
line (x+1,y)-(x+w-2,y),adark
line (x+w-1,y+1)-(x+w-1,y+h-2),adark
line (x+w-2,y+h-1)-(x+1,y+h-1),adark
pset (x,y),anorm
pset (x+w-1,y),anorm
pset (x+w-1,y+h-1),anorm
pset (x,y+h-1),anorm
line (x+1,y+h-3)-(x+1,y+1),white
line (x+1,y+1)-(x+w-2,y+1),white
line (x+w-2,y+2)-(x+w-2,y+h-2),anorm
line (x+w-2,y+h-2)-(x+1,y+h-2),anorm
select case GadgetList(gadnum).ctrlg
case 0
line (x+2,y+2)-(x+w-3,y+7),alite,bf
line (x+2,y+8)-(x+w-3,y+h-3),anorm,bf
for i=0 to 3
line (x+6+i,y+7-i)-(x+6+i,y+7+i),black
next i
case 1
line (x+2,y+2)-(x+w-3,y+7),alite,bf
line (x+2,y+8)-(x+w-3,y+h-3),anorm,bf
for i=0 to 3
line (x+9-i,y+7-i)-(x+9-i,y+7+i),black
next i
case 2
line (x+2,y+2)-(x+7,y+h-3),alite,bf
line (x+8,y+2)-(x+w-3,y+h-3),anorm,bf
for i=0 to 3
line (x+7-i,y+6+i)-(x+7+i,y+6+i),black
next i
case 3
line (x+2,y+2)-(x+7,y+h-3),alite,bf
line (x+8,y+2)-(x+w-3,y+h-3),anorm,bf
for i=0 to 3
line (x+7-i,y+9-i)-(x+7+i,y+9-i),black
next i
end select
end if
if GadgetList(gadnum).sel=1 then
line (x,y+h-2)-(x,y+1),bdark
line (x+1,y)-(x+w-2,y),bdark
line (x+w-1,y+1)-(x+w-1,y+h-2),bdark
line (x+w-2,y+h-1)-(x+1,y+h-1),bdark
pset (x+1,y+1),bdark
pset (x+w-2,y+1),bdark
pset (x+w-2,y+h-2),bdark
pset (x+1,y+h-2),bdark
line (x+1,y+h-3)-(x+1,y+1),bnorm
line (x+1,y+1)-(x+w-2,y+1),bnorm
line (x+w-2,y+2)-(x+w-2,y+h-2),blite
line (x+w-2,y+h-2)-(x+1,y+h-2),blite
select case GadgetList(gadnum).ctrlg
case 0
line (x+2,y+2)-(x+w-3,y+7),blite,bf
line (x+2,y+8)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 3
line (x+5+i,y+7-i)-(x+5+i,y+7+i),black
next i
case 1
line (x+2,y+2)-(x+w-3,y+7),blite,bf
line (x+2,y+8)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 3
line (x+10-i,y+7-i)-(x+10-i,y+7+i),black
next i
case 2
line (x+2,y+2)-(x+7,y+h-3),blite,bf
line (x+8,y+2)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 3
line (x+7-i,y+5+i)-(x+7+i,y+5+i),black
next i
case 3
line (x+2,y+2)-(x+7,y+h-3),blite,bf
line (x+8,y+2)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 3
line (x+7-i,y+10-i)-(x+7+i,y+10-i),black
next i
end select
end if
end if
if GadgetList(gadnum).act=2 then
line (x,y+h-2)-(x,y+1),gdark
line (x+1,y)-(x+w-2,y),gdark
line (x+w-1,y+1)-(x+w-1,y+h-2),gdark
line (x+w-2,y+h-1)-(x+1,y+h-1),gdark
pset (x+1,y+1),gdark
pset (x+w-2,y+1),gdark
pset (x+w-2,y+h-2),gdark
pset (x+1,y+h-2),gdark
line (x+1,y+1)-(x+w-2,y+h-2),bgrnd,bf
select case GadgetList(gadnum).ctrlg
case 0
for i=0 to 3
line (x+5+i,y+7-i)-(x+5+i,y+7+i),gdark
next i
case 1
for i=0 to 3
line (x+10-i,y+7-i)-(x+10-i,y+7+i),gdark
next i
case 2
for i=0 to 3
line (x+7-i,y+5+i)-(x+7+i,y+5+i),gdark
next i
case 3
for i=0 to 3
line (x+7-i,y+10-i)-(x+7+i,y+10-i),gdark
next i
end select
end if
end sub
sub DrawSmallArrow (gadnum as integer)
dim as integer i,x,y,w,h
x =GadgetList(gadnum).posx
y =GadgetList(gadnum).posy
w =GadgetList(gadnum).gadw
h =GadgetList(gadnum).gadh
if GadgetList(gadnum).act=0 then
line (x,y)-(x+w-1,y+h-1),bgrnd,bf
end if
if GadgetList(gadnum).act=1 then
if GadgetList(gadnum).sel=0 then
'box
line (x,y+h-2)-(x,y+1),adark
line (x+1,y)-(x+w-2,y),adark
line (x+w-1,y+1)-(x+w-1,y+h-2),adark
line (x+w-2,y+h-1)-(x+1,y+h-1),adark
pset (x,y),anorm
pset (x+w-1,y),anorm
pset (x+w-1,y+h-1),anorm
pset (x,y+h-1),anorm
line (x+1,y+h-3)-(x+1,y+1),white
line (x+1,y+1)-(x+w-2,y+1),white
line (x+w-2,y+2)-(x+w-2,y+h-2),anorm
line (x+w-2,y+h-2)-(x+1,y+h-2),anorm
select case GadgetList(gadnum).ctrlg
case 0
line (x+2,y+2)-(x+w-3,y+3),alite,bf
line (x+2,y+4)-(x+w-3,y+h-3),anorm,bf
for i=0 to 2
line (x+3+i,y+4-i)-(x+3+i,y+4+i),black
next i
case 1
line (x+2,y+2)-(x+w-3,y+3),alite,bf
line (x+2,y+4)-(x+w-3,y+h-3),anorm,bf
for i=0 to 2
line (x+6-i,y+4-i)-(x+6-i,y+4+i),black
next i
case 2
line (x+2,y+2)-(x+3,y+h-3),alite,bf
line (x+4,y+2)-(x+w-3,y+h-3),anorm,bf
for i=0 to 2
line (x+4-i,y+3+i)-(x+4+i,y+3+i),black
next i
case 3
line (x+2,y+2)-(x+3,y+h-3),alite,bf
line (x+4,y+2)-(x+w-3,y+h-3),anorm,bf
for i=0 to 2
line (x+4-i,y+6-i)-(x+4+i,y+6-i),black
next i
end select
end if
if GadgetList(gadnum).sel=1 then
line (x,y+h-2)-(x,y+1),bdark
line (x+1,y)-(x+w-2,y),bdark
line (x+w-1,y+1)-(x+w-1,y+h-2),bdark
line (x+w-2,y+h-1)-(x+1,y+h-1),bdark
pset (x+1,y+1),bdark
pset (x+w-2,y+1),bdark
pset (x+w-2,y+h-2),bdark
pset (x+1,y+h-2),bdark
line (x+1,y+h-3)-(x+1,y+1),bnorm
line (x+1,y+1)-(x+w-2,y+1),bnorm
line (x+w-2,y+2)-(x+w-2,y+h-2),blite
line (x+w-2,y+h-2)-(x+1,y+h-2),blite
select case GadgetList(gadnum).ctrlg
case 0
line (x+2,y+2)-(x+w-3,y+3),blite,bf
line (x+2,y+4)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 2
line (x+2+i,y+4-i)-(x+2+i,y+4+i),black
next i
case 1
line (x+2,y+2)-(x+w-3,y+3),blite,bf
line (x+2,y+4)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 2
line (x+7-i,y+4-i)-(x+7-i,y+4+i),black
next i
case 2
line (x+2,y+2)-(x+3,y+h-3),blite,bf
line (x+4,y+2)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 2
line (x+4-i,y+2+i)-(x+4+i,y+2+i),black
next i
case 3
line (x+2,y+2)-(x+3,y+h-3),blite,bf
line (x+4,y+2)-(x+w-3,y+h-3),bnorm,bf
for i=0 to 2
line (x+4-i,y+7-i)-(x+4+i,y+7-i),black
next i
end select
end if
end if
if GadgetList(gadnum).act=2 then
line (x,y+h-2)-(x,y+1),gdark
line (x+1,y)-(x+w-2,y),gdark
line (x+w-1,y+1)-(x+w-1,y+h-2),gdark
line (x+w-2,y+h-1)-(x+1,y+h-1),gdark
pset (x+1,y+1),gdark
pset (x+w-2,y+1),gdark
pset (x+w-2,y+h-2),gdark
pset (x+1,y+h-2),gdark
line (x+1,y+1)-(x+w-2,y+h-2),bgrnd,bf
select case GadgetList(gadnum).ctrlg
case 0
for i=0 to 2
line (x+3+i,y+4-i)-(x+3+i,y+4+i),gdark
next i
case 1
for i=0 to 2
line (x+6-i,y+4-i)-(x+6-i,y+4+i),gdark
next i
case 2
for i=0 to 2
line (x+4-i,y+3+i)-(x+4+i,y+3+i),gdark
next i
case 3
for i=0 to 2
line (x+4-i,y+6-i)-(x+4+i,y+6-i),gdark
next i
end select
end if
end sub
'End Arrows.bi
'##############################################################################
'##############################################################################