Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
SimpleGUIm.bi (TextEingabe jetzt auch in LINUX moeglich)
| Uploader: |  Muttonhead |
| Datum/Zeit: | 29.11.2008 17:10:20 |
'##############################################################################
'##############################################################################
'Begin SimpleGUIm.bi
'Screen Stuff
dim shared as integer ScreenWidth,ScreenHeight,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
msg as integer ' Message Modus
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
ctrla as integer ' TrackBar->Max,StringGadget->Gadgetlänge
ctrlb as integer ' TrackBar->Min,StringGadget->Stringlänge
ctrlc as integer ' TrackBar->Knob,StringGadget->Cursor
ctrld as integer ' StringGadget->TextOffset
end type
dim shared as integer maxgad=64
dim shared as Gadget GadgetList(1 to maxgad)
'Gadget Typen
'const SimpleGadget=1 'siehe SimpleGadget.bi
'const StringGadget=2 'siehe StringGadget.bi
'const TextOptionGadget=3 'siehe SimpleGadget.bi
'const CheckmarkGadget=4 'siehe Checkmark.bi
'const HTrackbar=10 'siehe TrackBar.bi
'const VTrackbar=11 'siehe TrackBar.bi
'selection 0=unselect
' 1=select
'activation 0= inactive invisible
' 1= active
' 2= inactive visible
'
'Message Modus 0=liefert SendMessage nur bei RELEASE
' 1=liefert SendMessage bei PRESS(1x) + Bewegung X Achse und RELEASE(auch ausserhalb!)
' 2=liefert SendMessage bei PRESS(1x) + Bewegung Y Achse und RELEASE(auch ausserhalb!)
' 4=liefert SendMessage chr(13)
'main sub
declare function GadgetControl as integer
declare sub ModifyPress(gadnum as integer)
declare sub ModifyRelease(gadnum as integer)
declare sub DrawGadget (gadnum as integer)
'Hilfsfunktionen für alle Gadgets
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)
declare function GetGadgetMsg (gadnum as integer) as integer
'Font &Vars
declare sub SetGlobVars
declare function GetFontHeight as integer
'#include "simplegui\GFXAdds.bi"
'#include "simplegui\WaitEvent.bi"
'#include "simplegui\SimpleGadget.bi"
'#include "simplegui\StringGadget.bi"
'#include "simplegui\TextOptionGadget.bi"
'#include "simplegui\CheckmarkGadget.bi"
'#include "simplegui\Trackbars.bi"
'oneparted
'Break SimpleGUI.bi - all includes now
'******************************************************************************
'##############################################################################
'##############################################################################
'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 WaitEvent.bi
#INCLUDE once "fbgfx.bi"
declare sub WaitEvent
declare sub KillEvent
DIM shared AS FB.EVENT PTR event
event = ALLOCATE(20)
dim shared as integer KEY,ASCCODE,SCANCODE,LBUTTON,MBUTTON,RBUTTON,WHEEL,MOUSEX,MOUSEY,MOUSEDX,MOUSEDY,MOUSE,FOCUS,EXITPROG
const as integer PRESSED=1
const as integer RELEASED=2
const as integer DOUBLECLICKED=3
const as integer REPEATED=3
sub WaitEvent
Dim as integer ExitSub
KEY=0
ASCCODE=-1
SCANCODE=-1
ExitSub=0
do
IF (SCREENEVENT(event)) Then
ExitSub=1
SELECT CASE event->type
CASE FB.EVENT_KEY_PRESS
KEY=PRESSED
ASCCODE=event->ascii
SCANCODE=event->scancode
CASE FB.EVENT_KEY_RELEASE
KEY=RELEASED
ASCCODE=event->ascii
SCANCODE=event->scancode
CASE FB.EVENT_KEY_REPEAT
KEY=REPEATED
ASCCODE=event->ascii
SCANCODE=event->scancode
CASE FB.EVENT_MOUSE_MOVE
MOUSEX=event->x
MOUSEY=event->y
MOUSEDX=event->dx
MOUSEDX=event->dy
CASE FB.EVENT_MOUSE_BUTTON_PRESS
IF (event->button = FB.BUTTON_LEFT ) THEN LBUTTON=PRESSED
IF (event->button = FB.BUTTON_MIDDLE) THEN MBUTTON=PRESSED
IF (event->button = FB.BUTTON_RIGHT) THEN RBUTTON=PRESSED
CASE FB.EVENT_MOUSE_BUTTON_RELEASE
IF (event->button = FB.BUTTON_LEFT ) THEN LBUTTON=RELEASED
IF (event->button = FB.BUTTON_MIDDLE) THEN MBUTTON=RELEASED
IF (event->button = FB.BUTTON_RIGHT) THEN RBUTTON=RELEASED
CASE FB.EVENT_MOUSE_DOUBLE_CLICK
IF (event->button = FB.BUTTON_LEFT ) THEN LBUTTON=DOUBLECLICKED
IF (event->button = FB.BUTTON_MIDDLE) THEN MBUTTON=DOUBLECLICKED
IF (event->button = FB.BUTTON_RIGHT) THEN RBUTTON=DOUBLECLICKED
CASE FB.EVENT_MOUSE_WHEEL
WHEEL=event->z
CASE FB.EVENT_MOUSE_ENTER
MOUSE=1
CASE FB.EVENT_MOUSE_EXIT
MOUSE=0
CASE FB.EVENT_WINDOW_GOT_FOCUS
FOCUS=1
CASE FB.EVENT_WINDOW_LOST_FOCUS
FOCUS=0
CASE FB.EVENT_WINDOW_CLOSE
EXITPROG=1
END SELECT
end if
Sleep 1
loop until ExitSub=1
end sub
sub KillEvent
deallocate event
end sub
'End Waitevent.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin SimpleGadget.bi
const SimpleGadget=1
declare sub AddSimpleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,txt as string)
declare sub DrawSimpleGadget (gadnum as integer)
declare sub SBoxUnselect (x as integer, y as integer, w as integer, h as integer)
declare sub SBoxSelect (x as integer, y as integer, w as integer, h as integer)
declare sub SBoxGhost (x as integer, y as integer, w as integer, h as integer)
'Simple und TextOption Gadget
sub AddSimpleGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,txt as string)
GadgetList(gadnum).gadtype=SimpleGadget
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=w
GadgetList(gadnum).gadh=h
GadgetList(gadnum).gadtext=txt
end sub
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
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
SBoxUnselect (x,y,w,h)
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
SBoxSelect (x,y,w,h)
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
SBoxGhost (x,y,w,h)
draw string ( x+(w-len(GadgetList(gadnum).gadtext)*8)/2 , y+(h-fontheight)/2 ),GadgetList(gadnum).gadtext,gdark
end if
end sub
sub SBoxUnselect (x as integer, y as integer, w as integer, h as integer)
' line (x,y)-(x+w-1,y+h-1),adark,b
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
end sub
sub SBoxSelect (x as integer, y as integer, w as integer, h as integer)
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
end sub
sub SBoxGhost (x as integer, y as integer, w as integer, h as integer)
line (x,y)-(x+w-1,y+h-1),gdark,b
line (x+1,y+1)-(x+w-2,y+h-2),bgrnd,bf
end sub
'End SimpleGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin StringGadget.bi
const StringGadget=2
declare sub AddStringGadget (gadnum as integer,x as integer,y as integer,glen as integer,slen as integer,txt as string)
declare sub EditString (gadnum as integer)
declare sub PutString (gadnum as integer,txt as string)
declare function GetString (gadnum as integer) as string
declare sub gfxStringGadget (gadnum as integer)
declare sub StrBoxUnselect (x as integer, y as integer, w as integer, h as integer)
declare sub StrBoxSelect (x as integer, y as integer, w as integer, h as integer)
declare sub StrBoxGhost (x as integer, y as integer, w as integer, h 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).gadtype=StringGadget
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=4
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).ctrla=glen
GadgetList(gadnum).ctrlb=slen
GadgetList(gadnum).ctrlc=1
GadgetList(gadnum).ctrld=0
end sub
sub EditString(gadnum 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
end sub
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
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
StrBoxUnselect(x,y,w,h)
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
StrBoxSelect(x,y,w,h)
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
StrBoxGhost(x,y,w,h)
end if
end sub
sub StrBoxUnselect (x as integer, y as integer, w as integer, h as integer)
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 sub
sub StrBoxSelect (x as integer, y as integer, w as integer, h as integer)
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 sub
sub StrBoxGhost (x as integer, y as integer, w as integer, h as integer)
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 sub
'End StringGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin TextOptionGadget.bi
const TextOptionGadget=3
declare sub AddTextOptionGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,s as integer,txt as string)
declare sub DrawTextOptionGadget (gadnum as integer)
declare sub TOBoxUnselect (x as integer, y as integer, w as integer, h as integer)
declare sub TOBoxSelect (x as integer, y as integer, w as integer, h as integer)
declare sub TOBoxGhost (x as integer, y as integer, w as integer, h as integer)
declare sub TOTick (x as integer, y as integer)
declare sub TOTickGhost (x as integer, y as integer)
sub AddTextOptionGadget (gadnum as integer,x as integer,y as integer,w as integer,h as integer,s as integer,txt as string)
GadgetList(gadnum).gadtype=TextOptionGadget
GadgetList(gadnum).sel=s
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=w
GadgetList(gadnum).gadh=h
GadgetList(gadnum).gadtext=txt
end sub
sub DrawTextOptionGadget (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
TOBoxUnselect (x,y,w,h)
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
TOBoxSelect (x,y,w,h)
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
TOBoxGhost (x,y,w,h)
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 TOBoxUnselect (x as integer, y as integer, w as integer, h as integer)
line (x,y)-(x+w-1,y+h-1),adark,b
line (x+1,y+1)-(x+w-2,y+h-2),alite,b
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
end sub
sub TOBoxSelect (x as integer, y as integer, w as integer, h as integer)
line (x,y)-(x+w-1,y+h-1),bdark,b
line (x+1,y+1)-(x+w-2,y+h-2),bnorm,b
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
end sub
sub TOBoxGhost (x as integer, y as integer, w as integer, h as integer)
line (x,y)-(x+w-1,y+h-1),gdark,b
line (x+1,y+1)-(x+w-2,y+h-2),bgrnd,bf
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 TextOptionGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin CheckmarkGadget.bi
const CheckmarkGadget=4
declare sub AddCheckmarkGadget (gadnum as integer,x as integer,y as integer,s as integer)
declare sub DrawCheckmarkGadget (gadnum as integer)
declare Sub CBoxUnselect (x as integer,y as integer)
declare Sub CBoxGhost (x as integer,y 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).gadtype=CheckmarkGadget
GadgetList(gadnum).sel=s
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=0
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=13
GadgetList(gadnum).gadh=13
end sub
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
CBoxUnselect (x,y)
if GadgetList(gadnum).sel=1 then CTick (x+3,y+2)
end if
if GadgetList(gadnum).act=2 then
CBoxGhost (x,y)
if GadgetList(gadnum).sel=1 then CTickGhost (x+3,y+2)
end if
end sub
Sub CBoxUnselect (x as integer,y as integer)
line (x,y)-(x+12,y+12),adark,b
line (x+1,y+1)-(x+11,y+11),bgrnd,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
end sub
Sub CBoxGhost (x as integer,y as integer)
line (x,y)-(x+12,y+12),gdark,b
line (x+1,y+1)-(x+11,y+11),bgrnd,bf
end sub
sub CTick (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 CTickGhost (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 CheckmarkGadget.bi
'##############################################################################
'##############################################################################
'##############################################################################
'##############################################################################
'Begin Trackbars.bi
const HTrackbar=10
const VTrackbar=11
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 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 sub DrawHTrackbar (gadnum as integer)
declare sub HTKnobUnselect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
declare sub HTKnobSelect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
declare sub HTKnobGhost(x as integer,y as integer,h as integer,p as integer)
declare sub DrawVTrackbar (gadnum as integer)
declare sub VTKnobUnselect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
declare sub VTKnobSelect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
declare sub VTKnobGhost(x as integer,y as integer,w as integer,p 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).gadtype=HTrackbar
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=1
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=l
GadgetList(gadnum).gadh=22
GadgetList(gadnum).buffval=va
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
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).gadtype=VTrackbar
GadgetList(gadnum).sel=0
GadgetList(gadnum).act=0
GadgetList(gadnum).msg=2
GadgetList(gadnum).posx=x
GadgetList(gadnum).posy=y
GadgetList(gadnum).gadw=22
GadgetList(gadnum).gadh=l
GadgetList(gadnum).buffval=va
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
end sub
sub SetPos(gadnum as integer,p as integer)
dim range as uinteger
range=GadgetList(gadnum).ctrlb - GadgetList(gadnum).ctrla
if p<5 then p=5
if GadgetList(gadnum).gadtype=HTrackbar then
if p>GadgetList(gadnum).gadw-5 then p=GadgetList(gadnum).gadw-5
end if
if GadgetList(gadnum).gadtype=VTrackbar then
if p>GadgetList(gadnum).gadh-5 then p=GadgetList(gadnum).gadh-5
end if
GadgetList(gadnum).ctrlc=p ' vorläufige knob Position
if GadgetList(gadnum).gadtype=HTrackbar then
GadgetList(gadnum).buffval=GadgetList(gadnum).ctrla + range*(GadgetList(gadnum).ctrlc-5)/(GadgetList(gadnum).gadw-10)
end if
if GadgetList(gadnum).gadtype=VTrackbar then
GadgetList(gadnum).buffval=GadgetList(gadnum).ctrla + range*(GadgetList(gadnum).ctrlc-5)/(GadgetList(gadnum).gadh-10)
end if
SetVal(gadnum,GetVal(gadnum)) 'knob position korrigiert, an buffval angepasst!!
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).gadtype=HTrackbar then
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadw-10))+5
end if
if GadgetList(gadnum).gadtype=VTrackbar then
GadgetList(gadnum).ctrlc=((GadgetList(gadnum).buffval-GadgetList(gadnum).ctrla)/range*(GadgetList(gadnum).gadh-10))+5
end if
end sub
function GetVal (gadnum as integer) as integer
function=GadgetList(gadnum).buffval
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)
if GadgetList(gadnum).sel=0 then HTKnobUnselect (gadnum,x,y,w,h,p)
if GadgetList(gadnum).sel=1 then HTKnobSelect (gadnum,x,y,w,h,p)
if sc then Scale (gadnum,adark)
end if
if GadgetList(gadnum).act=2 then
SlotGhost(gadnum,x,y,w,h,p)
HTKnobGhost (x,y,h,p)
if sc then Scale (gadnum,gdark)
end if
end sub
sub HTKnobUnselect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+p+5,y) -(x+w-1,y+8),bgrnd,bf
line (x+p+5,y+13)-(x+w-1,y+h-1),bgrnd,bf
end if
'knob 11x22px Bewegung von 5 bis gadw-5
line (x+p-5,y) -(x+p+4,y+h-1),adark,b
line (x+p-4,y+1) -(x+p+3,y+h/2-1),alite,bf
line (x+p-4,y+h/2)-(x+p+3,y+h-2),anorm,bf
end sub
sub HTKnobSelect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+p+5,y) -(x+w-1,y+8),bgrnd,bf
line (x+p+5,y+13)-(x+w-1,y+h-1),bgrnd,bf
end if
'knob 11x22px Bewegung von 5 bis gadw-5
line (x+p-5,y) -(x+p+4,y+h-1),bdark,b
line (x+p-4,y+1) -(x+p+3,y+h/2),blite,bf
line (x+p-4,y+h/2)-(x+p+3,y+h-2),bnorm,bf
end sub
sub HTKnobGhost(x as integer,y as integer,h as integer,p as integer)
'knob 11x22px Bewegung von 5 bis gadw-5
line (x+p-5,y) -(x+p+4,y+h-1),gdark,b
line (x+p-4,y+1) -(x+p+3,y+h-2),bgrnd,bf
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)
if GadgetList(gadnum).sel=0 then VTKnobUnselect (gadnum,x,y,w,h,p)
if GadgetList(gadnum).sel=1 then VTKnobSelect (gadnum,x,y,w,h,p)
if sc then Scale (gadnum,adark)
end if
if GadgetList(gadnum).act=2 then
SlotGhost(gadnum,x,y,w,h,p)
VTKnobGhost (x,y,h,p)
if sc then Scale (gadnum,gdark)
end if
end sub
sub VTKnobUnselect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x,y+p+5) -(x+8,y+h-1),bgrnd,bf
line (x+13,y+p+5)-(x+w-1,y+h-1),bgrnd,bf
end if
'knob 11x22px Bewegung von 5 bis gadw-5
line (x,y+p-5) -(x+w-1,y+p+4),adark,b
line (x+1,y+p-4) -(x+w-2,y+p-1),alite,bf
line (x+1,y+p) -(x+w-2,y+p+3),anorm,bf
end sub
sub VTKnobSelect(gadnum as integer,x as integer,y as integer,w as integer,h as integer, p as integer)
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x,y+p+5) -(x+8,y+h-1),bgrnd,bf
line (x+13,y+p+5)-(x+w-1,y+h-1),bgrnd,bf
end if
'knob 11x22px Bewegung von 5 bis gadw-5
line (x,y+p-5) -(x+w-1,y+p+4),bdark,b
line (x+1,y+p-4) -(x+w-2,y+p-1),blite,bf
line (x+1,y+p) -(x+w-2,y+p+3),bnorm,bf
end sub
Sub VTKnobGhost (x as integer,y as integer,h as integer,p as integer)
'knob 11x22px Bewegung von 5 bis gadw-5
line (x+p-5,y) -(x+p+4,y+h-1),gdark,b
line (x+p-4,y+1) -(x+p+3,y+h-2),bgrnd,bf
line (x+p-5,y) -(x+p+4,y+h-1),gdark,b
line (x+p-4,y+1) -(x+p+3,y+h-2),bgrnd,bf
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).gadtype=HTrackbar then
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+p+5,y+9)-(x+w-1,y+9),adark
line (x+p+5,y+10)-(x+w-1,y+11),bgrnd,bf
line (x+p+5,y+12)-(x+w-1,y+12),alite
line (x+w-1,y+11)-(x+w-1,y+12),alite
end if
end if
if GadgetList(gadnum).gadtype=VTrackbar then
if GadgetList(gadnum).buffval>GadgetList(gadnum).ctrla 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 GadgetList(gadnum).buffval<GadgetList(gadnum).ctrlb then
line (x+9,y+p+5)-(x+9,y+h-1),adark
line (x+10,y+p+5)-(x+11,y+h-1),bgrnd,bf
line (x+12,y+p+5)-(x+12,y+h-1),alite
line (x+11,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).gadtype=HTrackbar 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).gadtype=VTrackbar 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).gadtype=HTrackbar 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
'##############################################################################
'##############################################################################
'******************************************************************************
'Continue SimpleGUI.bi
'Haupt Subs und Functions
function GadgetControl as integer
dim as integer gadnum,SendMessage
static as integer remembergad,rememberselect,remembermx,remembermy,rememberstringgad
gadnum=0
'string handle
if rememberstringgad>0 then
if KEY=PRESSED or KEY=REPEATED then
if ASCCODE<>13 then
EditString(rememberstringgad)
DrawGadget(rememberstringgad)
else
GadgetList(rememberstringgad).ctrlc=1
GadgetList(rememberstringgad).ctrld=0
SetSelect (rememberstringgad,0)
DrawGadget(rememberstringgad)
SendMessage=rememberstringgad
rememberstringgad=0
endif
end if
end if
'press (& doubleclick) handle
if LBUTTON=PRESSED or LBUTTON=DOUBLECLICKED then
gadnum=GetGadgetNumber '<-----------!!!!!
if gadnum=-1 and remembergad=0 then remembergad=gadnum
if rememberstringgad>0 and gadnum<>rememberstringgad then 'deaktivieren eines StringGadget sobald anderes Gadget angewählt
GadgetList(rememberstringgad).ctrlc=1
GadgetList(rememberstringgad).ctrld=0
SetSelect (rememberstringgad,0)
DrawGadget(rememberstringgad)
rememberstringgad=0
end if
'hold (& move)
if remembergad>0 then 'and gadnum=remembergad
if GetGadgetMsg(remembergad)=1 and remembermx<>MOUSEX then
SendMessage=remembergad
ModifyPress (remembergad)
DrawGadget(remembergad)
end if
if GetGadgetMsg(remembergad)=2 and remembermy<>MOUSEY then
SendMessage=remembergad
ModifyPress (remembergad)
DrawGadget(remembergad)
end if
remembermx=MOUSEX
remembermy=MOUSEY
end if
'1st hit
if gadnum>0 and remembergad=0 then
remembergad=gadnum
if GadgetList(remembergad).gadtype=2 then rememberstringgad=remembergad 'aktivieren eines StringGadget
rememberselect=GetSelect(gadnum)
remembermx=MOUSEX
remembermy=MOUSEY
if GetGadgetMsg(remembergad)=1 then SendMessage=remembergad
if GetGadgetMsg(remembergad)=2 then SendMessage=remembergad
ModifyPress (gadnum)
DrawGadget(gadnum)
end if
end if
'release handle
if LBUTTON=RELEASED and remembergad<>0 then
gadnum=GetGadgetNumber '<-----------!!!!!
'pressed in and released out
if remembergad>0 and gadnum<>remembergad then
if GetGadgetMsg(remembergad)=1 then SendMessage=remembergad
if GetGadgetMsg(remembergad)=2 then SendMessage=remembergad
SetSelect(remembergad,rememberselect)
DrawGadget(remembergad)
end if
'pressed and released in
if remembergad>0 and gadnum=remembergad then
if GetGadgetMsg(remembergad)=0 then SendMessage=remembergad
if GetGadgetMsg(remembergad)=1 then SendMessage=remembergad
if GetGadgetMsg(remembergad)=2 then SendMessage=remembergad
ModifyRelease (gadnum)
DrawGadget(gadnum)
end if
remembergad=0
rememberselect=0
end if
function=SendMessage
end function
'Wie soll das Gadget bei Press verändert werden
'verändert werden nur bestimmte GadgetList()records des Gadgets!
'jede Typennummer kann dabei seine eigene Routine haben
'diese Sub muss entsprechend neuer Gadgets erweitert werden
sub ModifyPress (gadnum as integer)
if MOUSEX>ScreenWidth-1 then MOUSEX=0
if MOUSEY>ScreenHeight-1 then MOUSEY=0
select case GadgetList(gadnum).gadtype
case SimpleGadget
SetSelect (gadnum,1)
case TextOptionGadget,CheckmarkGadget
'nothing to do
case StringGadget
'Cursor Mouse sensitive ;)
GadgetList(gadnum).ctrlc=GadgetList(gadnum).ctrld+(MOUSEX-GadgetList(gadnum).posx-3)\8+1
if GadgetList(gadnum).ctrlc >GadgetList(gadnum).ctrld+GadgetList(gadnum).ctrla then _
GadgetList(gadnum).ctrlc=GadgetList(gadnum).ctrld+GadgetList(gadnum).ctrla
if GadgetList(gadnum).ctrlc > len(GadgetList(gadnum).buffstr)+1 then _
GadgetList(gadnum).ctrlc=len(GadgetList(gadnum).buffstr)+1
SetSelect (gadnum,1)
case HTrackbar
SetPos(gadnum,MOUSEX- GadgetList(gadnum).posx)
SetSelect (gadnum,1)
case VTrackbar
SetPos(gadnum,MOUSEY- GadgetList(gadnum).posy)
SetSelect (gadnum,1)
end select
end sub
'Wie soll das Gadget bei Release verändert werden
'verändert werden nur bestimmte GadgetList()records des Gadgets
'jede Typennummer kann dabei seine eigene Routine haben
'diese Sub muss entsprechend neuer Gadgets erweitert werden
sub ModifyRelease (gadnum as integer)
select case GadgetList(gadnum).gadtype
case SimpleGadget
SetSelect(gadnum,0)
case TextOptionGadget,CheckmarkGadget
if GetSelect(gadnum)=1 then SetSelect(gadnum,0) else SetSelect(gadnum,1)
case StringGadget
'nothing to do
case HTrackbar,VTrackbar
SetSelect(gadnum,0)
end select
end sub
'Zeichnet das Gadget
'und gleichzeitig Zuordnung der gfxSubs zur entsprechenden Typnummer
'diese Sub muss entsprechend neuer Gadgets erweitert werden
sub DrawGadget(gadnum as integer)
select case GadgetList(gadnum).gadtype
case SimpleGadget
DrawSimpleGadget(gadnum)
case StringGadget
DrawStringGadget(gadnum)
case TextOptionGadget
DrawTextOptionGadget(gadnum)
case HTrackbar
DrawHTrackbar(gadnum)
case VTrackbar
DrawVTrackbar(gadnum)
case CheckmarkGadget
DrawCheckmarkGadget(gadnum)
end select
end sub
'******************************************************************************
'******************************************************************************
'Hilfsfunktionen und Subs für alle Gadgets
'intern
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
function GetGadgetMsg (gadnum as integer) as integer
Function=GadgetList(gadnum).msg
end function
'öffentlich
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
end sub
sub GadgetOn (gadnum as integer)
GadgetList(gadnum).act=1
DrawGadget(gadnum)
end sub
sub GadgetSleep (gadnum as integer)
GadgetList(gadnum).act=2
DrawGadget(gadnum)
end sub
sub GadgetOff (gadnum as integer)
GadgetList(gadnum).act=0
DrawGadget(gadnum)
end sub
'******************************************************************************
'******************************************************************************
'Font & Vars
'öffentlich
sub SetGlobVars
Screeninfo (ScreenWidth,ScreenHeight)
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=&ha0a0a0 '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
'End SimpleGUIm.bi
'##############################################################################
'##############################################################################