'##############################################################################
'##############################################################################
'Begin GFXAdds.bas

'globale GFX Variablen
dim shared as integer contrast,fontheight,CustomColors
dim shared as uinteger TextColor,BackGroundColor,GadgetTextColor,GadgetColor,CursorColor
dim shared as uinteger MenuColor,MenuTextColor,MenuHiliteColor,MenuGhostedColor
const as uinteger black=&h000000,white=&hffffff

CustomColors=0
contrast=96'stellt tatsächlich eine Art Kontrast-Variable dar
           'wer will,kann gerne mal mit rumspielen, es geht nichts kaputt :)
           'hab die 96 als angenehmsten empfunden

declare function GetFontHeight as integer
declare sub InitGFX

declare function ShiftRGB (col as uinteger,shift as integer) as uinteger
declare sub ClearBox (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger=BackGroundColor)
declare sub FrameA (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger)
declare sub FrameB (xpos as integer, ypos as integer, fwidth as integer, fheight as integer,switch as integer)
declare sub FrameC (xpos as integer, ypos as integer)
declare sub FrameD (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger,switch as integer)
declare sub FrameE (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger)
declare sub FrameT (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, txt as string="")
declare sub FillA (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger,switch as integer)
declare sub FillB (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger,switch as integer)
declare sub Tick (xpos as integer,ypos as integer, col as uinteger)
declare sub Dot (xpos as integer,ypos as integer, col as uinteger)
declare sub Arrow (xpos as integer,ypos as integer,size as integer,d as integer,col as uinteger)
declare sub Slot (xpos as integer, ypos as integer, sl as integer,hv as integer)
declare sub BarA (xpos as integer, ypos as integer, bwidth as integer, bheight as integer, col as uinteger)
declare sub Separator (xpos as integer,ypos as integer,swidth as integer)
declare sub FrameStrip (xpos as integer, ypos as integer, fwidth as integer, fheight as integer,col as uinteger)

sub InitGFX
	fontheight=GetFontHeight
	if CustomColors=0 then
    BackGroundColor	=&HC8C8C8
    TextColor				=black
    GadgetColor			=&HFFAF00
    GadgetTextColor	=black
    CursorColor			=&H3388DD
    MenuColor       =BackGroundColor
    MenuTextColor   =black
    MenuHiliteColor =GadgetColor'&H80D0FF
    MenuGhostedColor=ShiftRGB (MenuColor,-contrast/2)
  end if
	color TextColor,BackGroundColor
  cls
end sub



'nach einer Idee von Volta
'ermittelt die benutzte Fonthöhe und gibt sie zurück
'siehe http://forum.qbasic.at/viewtopic.php?t=6065&highlight=fonth%F6he
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


'******************************************************************************
'******************************************************************************
'******************************************************************************
'es folgen alle Grafikelemente und Farbroutinen, die in irgend einer Weise in den Gadgets benutzt werden (können)
'also eine Art Grafik-Baukasten



'erhöht/verringert die RGB Werte einer Farbe um den Wert shift
'eine einfache Additions/Subtraktionsvariante
function ShiftRGB (col as uinteger,shift as integer) as uinteger
  dim as integer red,green,blue
  'RGB Splitting
  'mal wieder Volta
  'siehe http://forum.qbasic.at/viewtopic.php?t=4274&highlight=rgb
  red  =((col shr 16) and &HFF)+shift
	green=((col shr 8) and &HFF )+shift
	blue =(col and &HFF         )+shift
	if red<0 then red=0
  if green<0 then green=0
  if blue<0 then blue=0
	if red>255 then red=255
  if green>255 then green=255
  if blue>255 then blue=255
  function=rgb(red,green,blue)
end function



'von allen Gadgets als Reinigungsdienst benutzt
sub ClearBox (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger=BackGroundColor)
	line (xpos,ypos)-(xpos+fwidth-1,ypos+fheight-1),col,BF
end sub


'farbiger Rahmen, ungefüllt
'CheckmarkGadget,StringGadget
sub FrameA (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger)
	line (xpos,ypos)-(xpos+fwidth-1,ypos+fheight-1),col,B
end sub



'Rahmen(hintergrundbezogen) in zwei Schaltzuständen, ungefüllt
'SimpleGadget,ToggleGadget,CheckmarkGadget
sub FrameB (xpos as integer, ypos as integer, fwidth as integer, fheight as integer,switch as integer)
	dim as uinteger topleft,bottomright,corner

  'Farben für Hintergrundfase berechnen
  topleft=ShiftRGB(BackGroundColor,-contrast)
  if switch then
    bottomright=ShiftRGB(BackGroundColor,contrast/3)
    corner=BackGroundColor
  else
    'bottomright=ShiftRGB(BackGroundColor,-contrast)'topleft'ShiftRGB(BackGroundColor,contrast/6)
  	'corner=ShiftRGB(BackGroundColor,-contrast/2)'BackGroundColor
    bottomright=topleft
  	corner=topleft
	end if

  line (xpos,ypos)-(xpos+fwidth-2,ypos),topleft
  pset (xpos+fwidth-1,ypos),corner
  line (xpos+fwidth-1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),bottomright
  line (xpos+fwidth-2,ypos+fheight-1)-(xpos+1,ypos+fheight-1),bottomright
  pset (xpos,ypos+fheight-1),corner
  line (xpos,ypos+fheight-2)-(xpos,ypos+1),topleft
end sub



'Rahmen(hintergrundbezogen), gefüllt
'Radiobutton  12x12 px
sub FrameC (xpos as integer, ypos as integer)
	dim as uinteger toplefta,topleftb,bottomrighta,bottomrightb,body

  'Farben für Hintergrundfase berechnen
  toplefta=ShiftRGB(BackGroundColor,-contrast)
  topleftb=ShiftRGB(BackGroundColor,-contrast/5)
  bottomrighta=ShiftRGB(BackGroundColor,contrast/3)
  bottomrightb=ShiftRGB(BackGroundColor,contrast/7)
  body=BackGroundColor


	line(xpos+3,ypos)-(xpos+8,ypos),toplefta
	pset(xpos+9,ypos+1),topleftb
	pset(xpos+10,ypos+2),bottomrightb
  line(xpos+11,ypos+3)-(xpos+11,ypos+8),bottomrighta
  line(xpos+10,ypos+9)-(xpos+9,ypos+10),bottomrighta
  line(xpos+8,ypos+11)-(xpos+3,ypos+11),bottomrightb
	pset(xpos+2,ypos+10),bottomrightb
	pset(xpos+1,ypos+9),topleftb
  line(xpos,ypos+8)-(xpos,ypos+3),toplefta
  line(xpos+1,ypos+2)-(xpos+2,ypos+1),toplefta
end sub



'farbiger Rahmen in zwei Schaltzuständen
'StringGadget
sub FrameD (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger,switch as integer)
	dim as uinteger topleft,bottomright,corner
	topleft=ShiftRGB(col,contrast)
  bottomright=ShiftRGB(col,-contrast)
	if switch then swap topleft,bottomright
	corner=topleft
  line (xpos,ypos)-(xpos+fwidth-2,ypos),topleft
  pset (xpos+fwidth-1,ypos),corner
  line (xpos+fwidth-1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),bottomright
  line (xpos+fwidth-2,ypos+fheight-1)-(xpos+1,ypos+fheight-1),bottomright
  pset (xpos,ypos+fheight-1),corner
  line (xpos,ypos+fheight-2)-(xpos,ypos+1),topleft
end sub

sub FrameE (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, col as uinteger)
	line (xpos,ypos)-(xpos+fwidth-1,ypos+fheight-1),col,BF
end sub




'Rahmen (hintergrundbezogen) mit Text, gefüllt, für Gliederung der Oberfläche
sub FrameT (xpos as integer, ypos as integer, fwidth as integer, fheight as integer, txt as string="")
	dim as uinteger lite,dark

	'Farben für Hintergrundfase berechnen
  lite=ShiftRGB(BackGroundColor,contrast)'RGBwerte anheben
  dark=ShiftRGB(BackGroundColor,-contrast)'RGBwerte absenken

	line (xpos+1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),lite,b
  line (xpos,ypos)-(xpos+fwidth-2,ypos+fheight-2),dark,b
  line (xpos+2,ypos+2)-(xpos+fwidth-3,ypos+fheight-3),BackGroundColor,bf 'Löschen des Frameinneren

	if len(txt) then
    line(xpos+8,ypos-fontheight/2)-(xpos+8+8*len(txt),ypos-fontheight/2+fontheight),BackGroundColor,bf
    draw string (xpos+8,ypos-fontheight/2),txt,TextColor
  end if
end sub



'gefüllte farbige Box in zwei Schaltzuständen
'SimpleGadget,ToggleGadget,CheckmarkGadget
Sub FillA (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger,switch as integer)
  dim as integer i
  dim as uinteger topleft,bottomright,corner,tmpcol
	dim as single shiftstp,tmpshift

  if switch then
    col=ShiftRGB(col,-16)
    shiftstp=-(contrast/3)/(fheight-2)
    tmpshift=-contrast/6

    bottomright=ShiftRGB(col,-contrast/2)	'col
    topleft=ShiftRGB(col,-contrast/2)			'ShiftRGB(bottomright,-contrast/2)
    corner=topleft
  else
    shiftstp=(contrast/3)/(fheight-2)
    tmpshift=contrast/6

    topleft=ShiftRGB(col,contrast/2)
    bottomright=ShiftRGB(col,-contrast/2)
    corner=col
  end if

  line (xpos,ypos)-(xpos+fwidth-2,ypos),topleft
  pset (xpos+fwidth-1,ypos),corner
  line (xpos+fwidth-1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),bottomright
  line (xpos+fwidth-2,ypos+fheight-1)-(xpos+1,ypos+fheight-1),bottomright
  pset (xpos,ypos+fheight-1),corner
  line (xpos,ypos+fheight-2)-(xpos,ypos+1),topleft

  for i=0 to fheight-3
    line(xpos+1,ypos+1+i)-(xpos+fwidth-2,ypos+1+i),ShiftRGB(col,int(tmpshift))
    tmpshift -=shiftstp
  next i
end sub



Sub FillB (xpos as integer,ypos as integer,fwidth as integer,fheight as integer,col as uinteger,switch as integer)
  dim as integer i
  dim as uinteger topleft,bottomright,corner,tmpcol
	dim as single shiftstp,tmpshift

  if switch then col=ShiftRGB(col,-contrast/6)

  shiftstp=(contrast/3)/(fheight-2)
  tmpshift=contrast/6

  topleft=ShiftRGB(col,contrast/2)
  bottomright=ShiftRGB(col,-contrast/2)
  corner=col

  line (xpos,ypos)-(xpos+fwidth-2,ypos),topleft
  pset (xpos+fwidth-1,ypos),corner
  line (xpos+fwidth-1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),bottomright
  line (xpos+fwidth-2,ypos+fheight-1)-(xpos+1,ypos+fheight-1),bottomright
  pset (xpos,ypos+fheight-1),corner
  line (xpos,ypos+fheight-2)-(xpos,ypos+1),topleft

  for i=0 to fheight-3
    line(xpos+1,ypos+1+i)-(xpos+fwidth-2,ypos+1+i),ShiftRGB(col,int(tmpshift))
    tmpshift -=shiftstp
  next i
end sub



'farbiges Symbol
'"Häkchen" für CheckMarkGadget 8x9 px
sub Tick (xpos as integer,ypos as integer, col as uinteger)
  line(xpos+1,ypos+4)-(xpos+4,ypos+7),col
  line(xpos,ypos+4)-(xpos+3,ypos+7),col

  line(xpos+4,ypos+7)-(xpos+7,ypos),col
  line(xpos+3,ypos+7)-(xpos+6,ypos),col
end sub



'farbiges Symbol
'RadiobuttonDot  8x8 px
sub Dot (xpos as integer,ypos as integer, col as uinteger)
  dim as uinteger topleft,bottomright

	topleft=ShiftRGB(col,contrast/2)
  bottomright=ShiftRGB(col,-contrast/2)

	line(xpos+2,ypos)-(xpos+5,ypos),topleft
  pset(xpos+6,ypos+1),col
  line(xpos+7,ypos+2)-(xpos+7,ypos+5),bottomright
  pset(xpos+6,ypos+6),bottomright
  line(xpos+5,ypos+7)-(xpos+2,ypos+7),bottomright
	pset(xpos+1,ypos+6),col
  line(xpos,ypos+5)-(xpos,ypos+2),topleft
  pset(xpos+1,ypos+1),topleft


  line(xpos+1,ypos+2)-(xpos+2,ypos+1),ShiftRGB(col,contrast*2)
  line(xpos+1,ypos+3)-(xpos+3,ypos+1),ShiftRGB(col,contrast)
  line(xpos+1,ypos+4)-(xpos+4,ypos+1),ShiftRGB(col,contrast/2)
  line(xpos+1,ypos+5)-(xpos+5,ypos+1),ShiftRGB(col,contrast/4)

  line(xpos+2,ypos+5)-(xpos+5,ypos+2),col

  line(xpos+2,ypos+6)-(xpos+6,ypos+2),ShiftRGB(col,-contrast/4)
  line(xpos+3,ypos+6)-(xpos+6,ypos+3),ShiftRGB(col,-contrast/2)
  line(xpos+4,ypos+6)-(xpos+6,ypos+4),ShiftRGB(col,-contrast/1.5)
  line(xpos+5,ypos+6)-(xpos+6,ypos+5),ShiftRGB(col,-contrast)
end sub



'farbiges Symbol
'Pfeil
sub Arrow (xpos as integer,ypos as integer,size as integer,d as integer,col as uinteger)
  dim as integer i
  for i=0 to size
    if d=0 then line(xpos+size-i,ypos+i)-(xpos+size-i,ypos+2*size-i),col
    if d=1 then line(xpos+i,ypos+i)-(xpos+i,ypos+2*size-i),col
    if d=2 then line(xpos+i,ypos+size-i)-(xpos+2*size-i,ypos+size-i),col
    if d=3 then line(xpos+i,ypos+i)-(xpos+2*size-i,ypos+i),col
  next i
end sub



'Slot
'Trackbar hv 0=horizontal 1=vertikal
sub Slot (xpos as integer, ypos as integer, sl as integer,hv as integer)
	dim as integer topleft,bottomright

  topleft=ShiftRGB(BackGroundColor,-contrast)
  bottomright=ShiftRGB(BackGroundColor,contrast/2)
  if hv then
    if sl>=1 then
      line(xpos,ypos)-(xpos,ypos+sl-1),topleft
      line(xpos+1,ypos)-(xpos+1,ypos+sl-1),bottomright
    end if
  else
    if sl>=1 then
      line(xpos,ypos)-(xpos+sl-1,ypos),topleft
      line(xpos,ypos+1)-(xpos+sl-1,ypos+1),bottomright
    end if
  end if
end sub



sub BarA (xpos as integer,ypos as integer,bwidth as integer,bheight as integer,col as uinteger)
  dim as integer k
	dim as single shiftstp,tmpshift
  shiftstp=(contrast/2)/(bheight-2)
  tmpshift=contrast/4

  line(xpos,ypos)-(xpos+bwidth-1,ypos),ShiftRGB(col,contrast/2)
  for k=0 to bheight-3
    line(xpos,ypos+1+k)-(xpos+bwidth-1,ypos+1+k),ShiftRGB(col,int(tmpshift))
    tmpshift -=shiftstp
  next k
  line(xpos,ypos+bheight-1)-(xpos+bwidth-1,ypos+bheight-1),ShiftRGB(col,-contrast/2)
end sub



sub Separator (xpos as integer,ypos as integer,swidth as integer)
  line(xpos,ypos)-(xpos+swidth-1,ypos),ShiftRGB(BackGroundColor,-contrast)
  line(xpos,ypos+1)-(xpos+swidth-1,ypos+1),ShiftRGB(BackGroundColor,contrast)
end sub



sub FrameStrip (xpos as integer, ypos as integer, fwidth as integer, fheight as integer,col as uinteger)
  dim as uinteger topleft,bottomright

  topleft=ShiftRGB(col,contrast)
  bottomright=ShiftRGB(col,-contrast)

  line (xpos,ypos)-(xpos+fwidth-2,ypos),topleft
  pset (xpos+fwidth-1,ypos),col
  line (xpos+fwidth-1,ypos+1)-(xpos+fwidth-1,ypos+fheight-1),bottomright
  line (xpos+fwidth-2,ypos+fheight-1)-(xpos+1,ypos+fheight-1),bottomright
  pset (xpos,ypos+fheight-1),col
  line (xpos,ypos+fheight-2)-(xpos,ypos+1),topleft

end sub

'End GFXAdds.bas
'##############################################################################
'##############################################################################
