'##############################################################################
'##############################################################################
'Begin sGUI.bas



'Konstanten für die Beschreibung des Maustastenstatus
const as integer HIT=3      'Taste grad frisch gedrückt
const as integer HOLD=1     'Taste gehalten
const as integer RELEASE=2  'Taste grad losgelassen
const as integer RELEASED=0 'Taste ist losgelassen



'******************************************************************************
'Forward Referencing
'mit Dank an ThePuppetMaster,Cherry und OneCypher für die Tipps
'http://forum.qbasic.at/viewtopic.php?t=6550
type _Gadget as Gadget
type _EventHandle as EventHandle
type _SubEventHandle as SubEventHandle
type _MenuHeader as MenuHeader
type _MenuItem as MenuItem

'sobald das betreffende Type vollständig definiert ist, wird die "Fwd Ref"
'im weiteren Quelltext nicht mehr benutzt, also ohne Unterstrich!!!
'also nur so lange wie nötig
'******************************************************************************



'******************************************************************************
declare function CreateSubEventHandle () as _SubEventHandle ptr
declare sub DestroySubEventHandle (subevent as _SubEventHandle ptr)

declare function CreateEventHandle as _EventHandle ptr
declare sub DestroyEventHandle (event as _EventHandle ptr)

declare sub GadgetOn    (gad as _Gadget ptr)
declare sub GadgetSleep (gad as _Gadget ptr)
declare sub GadgetOff   (gad as _Gadget ptr)
declare function GetSelect (gad as _Gadget ptr) as integer
declare sub SetSelect (gad as _Gadget ptr,selection as integer)
declare sub DrawGadget(gad as _Gadget ptr)
declare sub SaveBackGround(gad as _Gadget ptr)

declare function UImport(s as string) as string
declare function UExport(s as string) as string
'******************************************************************************



'******************************************************************************
type Gadget
  event       as _EventHandle ptr'Zeiger auf den EventHandle dem dieses Gadget bei Erstellung zugeordnet worden ist
  nextGadget  as _Gadget      ptr'Zeiger aufs nächste Gadget
  sel         as integer   'Gadget Selektion
  act         as integer   'Gadget Aktivierung
  posx        as integer   'PositionX
  posy        as integer   'PositionY
  gadw        as integer   'Gadgetbreite
  gadh        as integer   'Gadgethöhe

  text        as string    'TextPuffer/GadgetText
  value       as integer   'WertePuffer

  textalt     as string    'alternativer TextPuffer/GadgetText
  valuealt    as integer   'alternativer WertePuffer

  Ca          as integer   'Steuerungsvariablen, je nach Gadgettyp unterschiedlich oder auch gar nicht genutzt
  Cb          as integer
  Cc          as integer
  Cd          as integer
  Ce          as integer
  Cf          as integer
  Cg          as integer
  Ch          as integer


  ImageUnselected as integer ptr 'Zeiger auf ein Image nicht angewählter Zustand
  ImageSelected 	as integer ptr 'Zeiger auf ein Image angewählter Zustand
  ImageGhosted		as integer ptr 'Zeiger auf ein Image inaktiver Zustand
  ImageGhostedAlt as integer ptr 'Zeiger auf ein Image inaktiver Zustand(alternativ)
  ImageMask				as integer ptr 'Zeiger auf ein Image das als Maske dient

  BackGroundImage as integer ptr 'Zeiger auf ein Image welches den ursprünglichen Hintergrund "unter" dem Gadget puffert

	subevent		as _SubEventHandle ptr

  DoDraw      as sub      (hitgad as Gadget ptr)                                  'Platzhalter Zeichenroutine
  DoHit       as function (hitgad as Gadget ptr,junk as Gadget ptr) as integer    'Platzhalter HIT Event Routine
  DoHold      as function (hitgad as Gadget ptr,holdgad as Gadget ptr) as integer 'Platzhalter HOLD Event Routine
  DoRelease   as function (hitgad as Gadget ptr,relgad as Gadget ptr) as integer  'Platzhalter RELEASE Event Routine
  DoKeyStream as function (keystream as Gadget ptr) as integer                    'Platzhalter Tastatureingabe Routine
end type
'******************************************************************************



'******************************************************************************
type MenuItem
  event       as _EventHandle ptr'Zeiger auf den EventHandle dem dieser Menüitem bei Erstellung zugeordnet worden ist
  nextMenuItem  as _MenuItem  ptr'Zeiger auf nächsten Item
  act         as integer   'Aktivierung
  hact        as integer   'Aktivierung des Headers, wenn die 0 dann kompletter Strip inaktiv
  itemtype    as integer   'umgeschlüsselter Typ normaler MenuItem,Häkchen,Separator (1,2,4)
  posx        as integer   'PositionX
  posy        as integer   'PositionY
  itemw       as integer   'Itembreite
  itemh       as integer   'Itemhöhe

  text        as string    'Text

  HeaderID    as integer   'Menünummer
  ItemID      as integer   'Eintragnummer

  DoDraw      as sub      (hititem as MenuItem ptr, hilite as integer)                'Platzhalter Zeichenroutine
end type
'******************************************************************************



'******************************************************************************
type MenuHeader
  event       as _EventHandle ptr'Zeiger auf den EventHandle dem dieser MenüHeader bei Erstellung zugeordnet worden ist
  nextMenuHeader as _MenuHeader ptr'Zeiger auf nächsten Header
  act         as integer   'Aktivierung
  posx        as integer   'PositionX
  headerw     as integer   'Headerbreite
  headerh     as integer   'Headerhöhe

  text        as string    'Text

  HeaderID    as integer   'MenuNummer

  stripw      as integer   'Stripbreite
  striph      as integer   'Striphöhe

  StripBuffer      as integer ptr

  firstMenuItem as MenuItem ptr
  lastMenuItem  as MenuItem ptr

  PullUp      as sub (event as _EventHandle ptr,header as _MenuHeader ptr)
  PullDown    as sub (event as _EventHandle ptr,header as _MenuHeader ptr)

  DoDraw      as sub      (hitheader as MenuHeader ptr, hilite as integer)               'Platzhalter Zeichenroutine
end type
'******************************************************************************



'******************************************************************************
type SubEventHandle
	event as _EventHandle ptr
	gad(7) as Gadget ptr
end type
'******************************************************************************


'******************************************************************************
'Erzeugen und Löschen eines SubEventHandles
function CreateSubEventHandle () as SubEventHandle ptr
	function=0
  dim as SubEventHandle ptr tmpevent
  tmpevent=new SubEventHandle
  if tmpevent then
  	tmpevent->event = CreateEventHandle
		function=tmpevent
	end if
end function



sub DestroySubEventHandle (subevent as SubEventHandle ptr)
  'vorher Suche in allen SubGadgets(gad()) nach weiteren SubEvents(rekursiver Aufruf von DestroySubEventHandle)
	for i as integer=0 to ubound(subevent->gad(0))
		if subevent->gad(i)>0  then
			if subevent->gad(i)->subevent>0 then
				DestroySubEventHandle(subevent->gad(i)->subevent)
			end if
		end if
	next i

	'event ist ein normaler EventHandle, der auch die Gadgets mitlöscht
	DestroyEventHandle (subevent->event)
  delete subevent
end sub
'******************************************************************************



'******************************************************************************
type EventHandle
'Eigenschaften
public:
  'Tastatur
  KEY           as string
  ASCCODE       as integer
  EXTENDED      as integer
  'Maus
  MOUSEX        as integer
  MOUSEY        as integer
  LMB           as integer
  MMB           as integer
  RMB           as integer

  'Gadgets
  GADGETMESSAGE as Gadget ptr'Nummer(genauer Pointer) des Gadgets, welches nen "Ping" von sich gibt

  'Menü
  MENUMESSAGE as integer 'true wenn Menüpunkt angewählt
  MENUNUMBER  as integer
  ITEMNUMBER    as integer

  EXITEVENT   as integer

  'GadgetListe(Verwaltung)
  firstGadget as Gadget ptr
  lastGadget  as Gadget ptr

private:
  '(alte Vergleichswerte)
  oldMOUSEX     as integer
  oldMOUSEY     as integer
  oldLMB        as integer
  oldMMB        as integer
  oldRMB        as integer


  'Gadget Zeugs
  hitgad        as Gadget ptr
  holdgad       as Gadget ptr
  relgad        as Gadget ptr
  keystreamto   as Gadget ptr

  'Menü Zeugs
   Menuonoff     as integer 'Menühauptschalter

  'MenuHeaderListe(Verwaltung)
  firstMenuHeader as MenuHeader ptr
  lastMenuHeader  as MenuHeader ptr

  strippedheader  as MenuHeader ptr
  holdstrip       as integer
  hitheader       as MenuHeader ptr
  holdheader      as MenuHeader ptr
  relheader       as MenuHeader ptr
  reldheader      as MenuHeader ptr
  hiliteheader    as MenuHeader ptr
  hititem         as MenuItem ptr
  relitem         as MenuItem ptr
  relditem        as MenuItem ptr
  hiliteitem      as MenuItem ptr

  MenuBarBuffer   as integer ptr 'Grafik Puffer um Hintergrund des MenüBars zu sichern
public:
'Konstruktor
  declare constructor ()
'Destruktor
' n/a
'Methoden
  declare sub xSleep (eventmode as integer,XButton as integer=1)
  declare sub ChainGadget (gad as Gadget ptr)
  declare sub ChainMenuHeader (header as MenuHeader ptr)
  declare sub MenuSwitch(switch as integer)
  declare function GetMenuStatus as integer
  declare function GetfirstMenuHeader as MenuHeader ptr
  declare function GetlastMenuHeader as MenuHeader ptr
  declare function GetMenuBarBuffer as integer ptr
  declare sub SetMenuBarBuffer (buffer as integer ptr)
  declare sub DeleteGadgetsAndMenu
  
  declare sub PullUpMenu
private:
  declare sub GadgetControl
  declare function GetGadgetPointer as Gadget ptr

  declare sub MenuControl
  declare function GetMenuHeaderPointer as MenuHeader ptr
  declare function GetMenuItemPointer (header as MenuHeader ptr) as MenuItem ptr
  declare sub Hiliter (overheader as MenuHeader ptr)
end type



'Konstruktor
constructor EventHandle()
end constructor



'Methoden
sub EventHandle.xSleep (eventmode as integer,XButton as integer=1)
  dim as integer button

  KEY=""
  ASCCODE=-1
  EXTENDED=0

  do
'alte Werte vom vorhergehenden Loopdurchgang zu Vergleichszwecken sichern
    oldMOUSEX=MOUSEX
    oldMOUSEY=MOUSEY
    oldLMB=LMB
    oldMMB=MMB
    oldRMB=RMB

'Maus und Tastaturereignisse sammeln
    getmouse(MOUSEX,MOUSEY,,button)
    KEY=inkey

'Maustastenzustand festlegen
    if MOUSEX<0 or MOUSEY<0 then            'wenn die Maus ausserhalb des Screens ist

      if LMB<>RELEASED then                 'wenn LMB noch nicht RELEASED ist
        LMB=RELEASE                         'dann wird LMB in 2 Loops über RELEASE
        if oldLMB=RELEASE then LMB=RELEASED 'auf RELEASED gesetzt
      end if
      if MMB<>RELEASED then                 'wenn MMB noch nicht RELEASED ist
        MMB=RELEASE                         'dann wird MMB in 2 Loops über RELEASE
        if oldMMB=RELEASE then MMB=RELEASED 'auf RELEASED gesetzt
      end if
      if RMB<>RELEASED then                 'wenn RMB noch nicht RELEASED ist
        RMB=RELEASE                         'dann wird RMB in 2 Loops über RELEASE
        if oldRMB=RELEASE then RMB=RELEASED 'auf RELEASED gesetzt
      end if

    else                                    'wenn Maus im Screen und Screen hat den Fokus

      'LMB 4 Schaltzustände simulieren
      if button and 1 then
        if LMB=RELEASED or LMB=RELEASE then LMB=HIT else LMB=HOLD
      else
        if LMB=HOLD or LMB=HIT then LMB=RELEASE else LMB=RELEASED
      end if
      'MMB 4 Schaltzustände simulieren
      if button and 4 then
        if MMB=RELEASED or MMB=RELEASE then MMB=HIT else MMB=HOLD
      else
        if MMB=HOLD or MMB=HIT then MMB=RELEASE else MMB=RELEASED
      end if
      'RMB 4 Schaltzustände simulieren
      if button and 2 then
        if RMB=RELEASED or RMB=RELEASE then RMB=HIT else RMB=HOLD
      else
        if RMB=HOLD or RMB=HIT then RMB=RELEASE else RMB=RELEASED
      end if

    end if

'Ereignisse setzen---->wenn Ereignis dann Verlassen des Loops ==> eventmode=0
    'Event Mausposition + Mausbewegung
    if MOUSEX<>oldMOUSEX or MOUSEY<>oldMOUSEY then eventmode=0
    'Event LMB
    if LMB<>oldLMB then eventmode=0
    'Event MMB
    if MMB<>oldMMB then eventmode=0
    'Event RMB
    if RMB<>oldRMB then eventmode=0

    'Event Tastatur
    if KEY<>"" then
      if len(KEY)=2 then
        EXTENDED=asc(left(KEY,1))
        KEY=right(KEY,1)
      end if
      ASCCODE=asc(KEY)
      eventmode=0 'bei Tastendruck verlasse Loop
    end if

    'Event CloseButton
    if EXTENDED<>0 and ASCCODE=107 then
      if XButton then            'wenn gesetzt => CloseButton-Abfrage erlaubt
        EXITEVENT=1              'Setzen des ExitSignals für den EventLoop
        eventmode=0              'bei CloseButton verlasse Loop
      end if
    end if

    if Menuonoff then MenuControl          'nur wenn Menüschalter gesetzt dann Menüüberprüfung
    if strippedHeader=0 then GadgetControl 'verhindert das "Hineinlaufen" in die Gadgetüberprüfung wenn ein PullDown offen ist

    if GADGETMESSAGE then eventmode=0
    if MENUMESSAGE then eventmode=0

    sleep 1
  loop until eventmode=0
end sub



sub EventHandle.GadgetControl
  if firstGadget=0 then exit sub
  dim as integer result,junk
  GADGETMESSAGE=0

  if LMB=HIT then                          'wenn Maus grad gedrückt wurde
    hitgad=GetGadgetPointer'<--!!!           hole die GadgetNummer

    if hitgad then                         'ist es ein Gadget
      result=hitgad->DoHit(hitgad,0)       'rufe seine DoHit-Routine auf
      if result then GADGETMESSAGE=hitgad

      if keystreamto then                                           'sollte irgend ein Control noch den "Tastaturstrom" haben dann
        if keystreamto<>hitgad then junk=keystreamto->DoRelease(0,keystreamto)'release
        keystreamto=0                                               'dann deaktiviere den Tastaturstrom
      end if
    end if

    if result=-2 then    'sollte DoHit Tastaturstrom (bei -2) verlangen
      keystreamto=hitgad 'Keystream setzen
      hitgad=0           'hitgad wird gelöscht,damit wird das Hineinlaufen in DoHold und DoRelease unterbunden
      GADGETMESSAGE=0
    end if

  end if

  if LMB=HOLD then                         'wenn Maus gehalten
    holdgad=GetGadgetPointer'<--!!!        hole die GadgetNummer
    if hitgad then
      result=hitgad->DoHold(hitgad,holdgad)'wenn Hit gesetzt,rufe seine DoHold-Routine auf
      if result then GADGETMESSAGE=hitgad
    end if
  end if

  if LMB=RELEASE then                        'wenn Maus grad losgelassen
    relgad=GetGadgetPointer'<--!!!            'hole Gadgetnummer
    if hitgad then                           'wenn Hit gesetzt,
      result=hitgad->DoRelease(hitgad,relgad)'rufe seine DoRelease-Routine auf
      if result then GADGETMESSAGE=hitgad    'die DoRelease-Routinen entscheiden selbst
    end if                                   'ob es sich nur um eine Aufräum-Aktion oder
                                             'um nen "echten" Release überm Gadget handelt
                                             '(durch Vergleich von hitgad mit relgad)
  end if

  if LMB=RELEASED then 'nicht mehr gedrückt
    hitgad=0           'Variablen zurücksetzen
    holdgad=0
    relgad=0
    result=0
    GADGETMESSAGE=0
  end if

  if keystreamto then
    result=keystreamto->DoKeyStream(keystreamto)
    if result=-1 then
      junk=keystreamto->DoRelease(0,keystreamto)
      GADGETMESSAGE=keystreamto
      keystreamto=0
    elseif result=-2 then             'HoldFocus
      GADGETMESSAGE=keystreamto
    end if
  end if
end sub



function EventHandle.GetGadgetPointer as Gadget ptr
  dim as Gadget ptr gad,nextgad,over
  dim as uinteger col
  function=0
  over=0
  gad=firstGadget
  if gad then
    do
      if gad->act=1 then'nur bei Activation=1 gibt es eine Antwort
        if  (MOUSEX>=gad->posx) and (MOUSEX<gad->posx+gad->gadw) and (MOUSEY>=gad->posy) and (MOUSEY<gad->posy+gad->gadh) then
					'wenn eine Maske(Imagemask) existiert, dann ausschliessen ob die Maus-Position
					'nicht über einem Pixel mit der Farbe RGB(255,0,255) ist!
					if gad->ImageMask then
            col=point(MOUSEX-gad->posx,MOUSEY-gad->posy,gad->ImageMask)
            if col<>&HFFFF00FF then over=gad
					else'ohne Maske
						over=gad
					end if
      	end if
			end if
      if over then exit do
      nextgad=gad->nextGadget
      gad=nextgad
    loop until gad=0
    function=over
  end if
end function



sub EventHandle.MenuControl
  if firstMenuHeader=0 then exit sub

  if LMB=HIT then
    hitheader=GetMenuHeaderPointer

    if hitheader>0 then
      if strippedheader=0 then holdstrip=1 else holdstrip=0
    end if

    if hitheader=0 then
      if strippedheader then
        hititem=GetMenuItemPointer(strippedheader)
        if hititem=0 then
          strippedheader->PullUp(@this,strippedheader)
          strippedheader=0
          holdstrip=0
          Hiliter(hitheader)
        end if
      end if
    end if
  end if

  if LMB=HOLD then
    holdheader=GetMenuHeaderPointer
    if holdstrip then
      if holdheader>0 then
        if strippedheader<>holdheader then
          if strippedheader then strippedheader->PullUp(@this,strippedheader)
          holdheader->PullDown(@this,holdheader)
          strippedheader=holdheader
        end if
      end if
      Hiliter(holdheader)
    end if
  end if

  if LMB=RELEASE then
    relheader=GetMenuHeaderPointer
    if relheader then
      if holdstrip=0 then
        if strippedheader then strippedheader->PullUp(@this,strippedheader)
        strippedheader=0
      end if
    else
      if strippedheader then
        relitem=GetMenuItemPointer(strippedheader)
        if relitem then
          if relitem->act=1 and strippedheader->act=1 then
            MENUMESSAGE=cast(integer,relitem)
            MENUNUMBER=cast(integer,relitem->headerID)
            ITEMNUMBER=cast(integer,relitem->itemID)
            strippedheader->PullUp(@this,strippedheader)
            strippedheader=0
            holdstrip=0
          end if
        else
          strippedheader->PullUp(@this,strippedheader)
          strippedheader=0
          holdstrip=0
        end if
      end if
    end if
    Hiliter(reldheader)
  end if

  if LMB=RELEASED then
    reldheader=GetMenuHeaderPointer
    if reldheader then
      if strippedheader then
        if strippedheader<>reldheader then
          strippedheader->PullUp(@this,strippedheader)
          reldheader->PullDown(@this,reldheader)
          strippedheader=reldheader
        end if
      end if
    end if

    Hiliter(reldheader)

    MENUMESSAGE=0
    MENUNUMBER=0
    ITEMNUMBER=0
  end if
end sub



function EventHandle.GetMenuHeaderPointer as MenuHeader ptr
  function=0
  dim as MenuHeader ptr header,over
  over=0
  header=firstMenuHeader
  if header>0 then 'wenn Header existiert
    do
      if  MOUSEX>=header->posx and MOUSEX<header->posx+header->headerw and _
        MOUSEY>=0 and MOUSEY<header->headerh then over=header
      if over then exit do
      header=header->nextMenuHeader
    loop until header=0
    if over then function=over
  end if
end function



function EventHandle.GetMenuItemPointer (header as MenuHeader ptr) as MenuItem ptr
  function=0
  dim as MenuItem ptr item,over
  item=header->firstMenuItem
  over=0
  if item then
    do
      if  MOUSEX>=item->posx and MOUSEX<item->posx+item->itemw and _
        MOUSEY>=item->posy and MOUSEY<item->posy+item->itemh then over=item
      if over then exit do
      item=item->nextMenuItem
    loop until item=0
    if over then function=over
  end if
end function



sub EventHandle.Hiliter (overheader as MenuHeader ptr)
  dim as MenuItem ptr overitem
  if strippedheader then
    if hiliteheader<>strippedheader then
      if hiliteheader then hiliteheader->DoDraw(hiliteheader,0)
      strippedheader->DoDraw(strippedheader,1)
      hiliteheader=strippedheader
      hiliteitem=0'Striphighlighting
    end if

    'Block Striphighlighting
    overitem=GetMenuItemPointer(strippedheader)
    if overitem then
      if hiliteitem<>overitem and strippedheader->act=1 then
        if hiliteitem then hiliteitem->DoDraw(hiliteitem,0)
        overitem->DoDraw(overitem,1)
        hiliteitem=overitem
      end if
    else
      if hiliteitem then hiliteitem->DoDraw(hiliteitem,0)
      hiliteitem=0
    end if
    'Ende Block Striphighlighting

  else
     if overheader>0 then
      if hiliteheader<>overheader then
        if hiliteheader then hiliteheader->DoDraw(hiliteheader,0)
        overheader->DoDraw(overheader,1)
        hiliteheader=overheader
      end if
    else
      if hiliteheader>0 then
        hiliteheader->DoDraw(hiliteheader,0)
        hiliteheader=0
      end if
    end if
    hiliteitem=0'Striphighlighting
  end if
end sub



sub EventHandle.ChainGadget (gad as Gadget ptr)
  if firstGadget=0 then firstGadget=gad
  if lastGadget then lastGadget->nextGadget=gad'sich selbst als Nachfolger ins vorhergehende eintragen
  lastGadget=gad                               'sich selbst als letztes definieren
end sub



sub EventHandle.ChainMenuHeader (header as MenuHeader ptr)
  if firstMenuHeader=0 then firstMenuHeader=header
  if lastMenuHeader then lastMenuHeader->nextMenuHeader=header'sich selbst als Nachfolger ins vorhergehende eintragen
  lastMenuHeader=header                                       'sich selbst als letzten definieren
end sub



sub EventHandle.MenuSwitch(switch as integer)
  menuonoff=switch
end sub

function EventHandle.GetMenuStatus as integer
  function=menuonoff
end function



function EventHandle.GetfirstMenuHeader as MenuHeader ptr
  function=firstMenuHeader
end function



function EventHandle.GetlastMenuHeader as MenuHeader ptr
  function=lastMenuHeader
end function



function EventHandle.GetMenuBarBuffer as integer ptr
  function=MenuBarBuffer
end function



sub EventHandle.SetMenuBarBuffer (buffer as integer ptr)
  MenuBarBuffer=buffer
end sub



sub EventHandle.DeleteGadgetsAndMenu
  dim as Gadget ptr gad,ngad
  dim as MenuHeader ptr header,nheader
  dim as MenuItem ptr item,nitem

  'Gadgets Löschen
  gad=firstGadget          'erstes Gadget(aus dem Event) holen
  if gad then              'wenn eines existiert
    do
      ngad=gad->nextGadget 'Nachfolger aus aktuellem Gadget holen

			'falls vorhanden-> Images löschen
      if gad->ImageMask then imagedestroy gad->ImageMask
			if gad->ImageSelected then imagedestroy gad->ImageSelected
      if gad->ImageUnselected then imagedestroy gad->ImageUnselected
      if gad->ImageGhosted then imagedestroy gad->ImageGhosted
      if gad->ImageGhostedAlt then imagedestroy gad->ImageGhostedAlt
      if gad->BackGroundImage then imagedestroy gad->BackGroundImage

      if gad->subevent  then DestroySubEventHandle (gad->subevent)' rekursiv subevents löschen

      delete gad           'Löschen des aktuellen Gadgets
      gad=ngad             'Nachfolger zum Aktuellen machen
    loop until gad=0       'wenn kein Nachfolger existiert(dann ist gad=0), verlasse Loop
  end if

  'Menü Löschen
  'MenüHeader Löschen
  header=firstMenuHeader      'Löschvorgang für Header nach Gadget-Muster ^^
  if header then
    do
      nheader=header->nextMenuHeader

      if header->StripBuffer then imagedestroy header->StripBuffer 'falls noch ein Image zugeordnet ist, löschen

      'MenüItem Löschen
      item=header->firstMenuItem
      if item then                   'Löschvorgang für die Items eines Headers nach Gadget-Muster ^^
        do
          nitem=item->nextMenuItem
          delete item
          item=nitem
        loop until item=0
      end if

      delete header
      header=nheader
    loop until header=0
  end if

  if MenuBarBuffer then imagedestroy MenuBarBuffer 'falls noch ein Image zugeordnet ist löschen
end sub



sub EventHandle.PullUpMenu
  if strippedheader then strippedheader->PullUp(@this,strippedheader)
  if hiliteheader then hiliteheader->DoDraw(hiliteheader,0)
  strippedheader  =0
  holdstrip       =0
  hitheader       =0
  holdheader      =0
  relheader       =0
  reldheader      =0
  hiliteheader    =0
  hititem         =0
  relitem         =0
  relditem        =0
  hiliteitem      =0
end sub
'******************************************************************************



'******************************************************************************
'Erzeugen und Löschen eines EventHandles
function CreateEventHandle as EventHandle ptr
  function=0
  dim as EventHandle ptr tmpevent
  tmpevent=new EventHandle
  if tmpevent then function=tmpevent
end function

sub DestroyEventHandle (event as EventHandle ptr)
  event->DeleteGadgetsAndMenu
  delete event             'zum Schluss noch eigentlichen Event löschen - fertisch!!!
end sub
'******************************************************************************



'******************************************************************************
sub GadgetOn (gad as Gadget ptr)
  gad->act=1
  gad->DoDraw (gad)
	'wenn SubEvent vorhanden(rekursiv)
	if gad->subevent then
		for i as integer=0 to ubound(gad->subevent->gad(0))
			if gad->subevent->gad(i)>0 then
				GadgetOn(gad->subevent->gad(i))
			end if
		next i
	end if
end sub

sub GadgetSleep (gad as Gadget ptr)
  gad->act=2
  gad->DoDraw (gad)

	'wenn SubEvent vorhanden(rekursiv)
	if gad->subevent then
		for i as integer=0 to ubound(gad->subevent->gad(0))
			if gad->subevent->gad(i)>0 then
				GadgetSleep(gad->subevent->gad(i))
			end if
		next i
	end if
end sub

sub GadgetOff (gad as Gadget ptr)
  gad->act=0
  gad->DoDraw (gad)

	'wenn SubEvent vorhanden(rekursiv)
	if gad->subevent then
		for i as integer=0 to ubound(gad->subevent->gad(0))
			if gad->subevent->gad(i)>0 then
				GadgetOff(gad->subevent->gad(i))
			end if
		next i
	end if
end sub

function GetSelect (gad as Gadget ptr) as integer
  function=gad->sel
end function

sub SetSelect (gad as Gadget ptr,selection as integer)
  gad->sel=selection
  gad->DoDraw (gad)
end sub

sub DrawGadget(gad as Gadget ptr)
  gad->DoDraw (gad)
end sub

sub SaveBackGround(gad as Gadget ptr)
	gad->BackGroundImage=imagecreate(gad->gadw,gad->gadh)
  if gad->BackGroundImage then
    get(gad->posx,gad->posy)-(gad->posx+gad->gadw-1,gad->posy+gad->gadh-1),gad->BackGroundImage
  	'Wenn ein Masken-Image existiert, dann dessen Tranparenz-Farbe übertragen
		if gad->ImageMask>0 then
  		for k as integer=0 to gad->gadh-1
  			for i as integer=0 to gad->gadw-1
  				if point(i,k,gad->ImageMask)=&HFFFF00FF then pset gad->BackGroundImage,(i,k),&HFFFF00FF
				next i
			next k
		end if
	else
    gad->BackGroundImage=0
  end if
end sub

'******************************************************************************



#include "GFXAdds.bas" 'Einbindung der GFX Prozeduren und Variablen
#include "CommonAdds.bas" 'Einbindung allgemeiner Prozeduren
'End sGUI.bas
'##############################################################################
'##############################################################################
