'SystemIncludes
#include once "file.bi"

'**************************************************************************************************
'**************************************************************************************************
'MainTypes*****************************************************************************************


'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

'Konstanten für die Beschreibung der Ereignisse von Controls
'Stehen in Abhängigkeit zu den Maustasten
const as integer GADGET_HIT=1         'Control grad frisch gedrückt
const as integer GADGET_HOLD=2        'Control wird gehalten, Maus über dem Control
const as integer GADGET_HOLDOFF=3     'Control wird gehalten, Maus neben dem Control
const as integer GADGET_RELEASE=4     'Control regulär losgelassen
const as integer GADGET_RELEASEOFF=5  'Control losgelassen, dabei ist Maus neben dem Control
const as integer GADGET_KEYBOARD=6    'Control verarbeitet die Tastatureingaben
const as integer GADGET_KEYBOARDOFF=7 'Abbruch der Verarbeitung der Tastatureingaben eines Controls

'Konstanten für MessageBoxen
'Typen:
const as integer MBType_OK=1
const as integer MBType_YESNO=2
const as integer MBType_CANCELRETRYIGNORE=3
const as integer MBType_OKCANCEL=4
const as integer MBType_RETRYCANCEL=5
const as integer MBType_YESNOCANCEL=6

'Button Returnwerte
const as integer MBButton_OK=1
const as integer MBButton_CANCEL=2
const as integer MBButton_RETRY=3
const as integer MBButton_IGNORE=4
const as integer MBButton_YES=5
const as integer MBButton_NO=6

'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 _MenuHeader as MenuHeader
type _MenuItem as MenuItem

type _TextObject as TextObject
'sobald das betreffende Type vollständig definiert ist, wird die "Fwd Ref"
'im weiteren Quelltext nicht mehr benutzt, also ohne Unterstrich!!!



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
  oldact      as integer   'alte Gadget Aktivierung zum Restaurieren des vorhergehenden Zustandes
  posx        as integer   'PositionX
  posy        as integer   'PositionY
  gadw        as integer   'Gadgetbreite
  gadh        as integer   'Gadgethöhe
  
  caption     as string    'GadgetText
  captionalt  as string    'alternativer GadgetText

  'das Textobjekt dient in erster Linie der Verwaltung und dem Editieren von mehrzeiligen Text
  'es kümmert sich nicht um die Darstellung des Textes
  'vielleicht wird in Zukunft auch die Beschriftung (caption,captionalt) in das Textobjekt wandern
  texto       as _TextObject ptr'mehrzeiliges TextObjekt
  affiliation as integer   'wenn false darf das TO nicht aus diesem Control heraus gelöscht werden, es ist also noch in einem anderen Control verankert



  Ctrl(15)    as integer   'Steuerungsvariablen, je nach Gadgettyp unterschiedlich oder auch gar nicht genutzt
                           'auch als Regelwert puffer nutzbar, die höchsten Indexnummern sollten dafür genutzt werden
  Images(3)   as integer ptr
  'Indizes 0 und 1 werden weitesgehend von sGUI kontrolliert und sind daher reserviert
  '0=Zeiger auf ein Image welches den ursprünglichen Hintergrund "unter" dem Gadget puffert
  '1=Zeiger auf ein Image das als Maske dient, wird von sGUI abgefragt um "formsensitives" Klicken zu ermöglichen

  'ab Index 2 gilt folgendes (alternative Nutzung möglich):
  '2=Zeiger auf ein Image nicht angewählter Zustand
  '3=Zeiger auf ein Image angewählter Zustand
  'steht nicht mehr zur Verfügung !!! '4=Zeiger auf ein Image inaktiver Zustand
  'steht nicht mehr zur Verfügung !!! '5=Zeiger auf ein Image inaktiver Zustand(alternativ)

	subevent as _EventHandle ptr
	gad(7) as Gadget ptr

  DoDraw      as sub      (gad as Gadget ptr)                                     'Platzhalter Zeichenroutine
  DoAction    as function (refgad as Gadget ptr, action as integer) as integer    'Platzhalter für Ereignis-Routine
  DoUpdate    as sub      (gad as Gadget ptr)                                     'Platzhalter Update
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


'**************************************************************************************************
'**************************************************************************************************
'TO************************************************************************************************
#include "TextObject.bas"
#include "TOGadgetBindings.bas"



'**************************************************************************************************
'**************************************************************************************************
'EventHandle***************************************************************************************

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



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

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

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

  'Gadget Zeugs
  refgad          as Gadget ptr 'Referenz Gadget, auf dem der Rest des Clickvorganges basiert
  actgad         as Gadget ptr
  keygad          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,eventoccurred
  
  KEY=""
  ASCCODE=-1
  EXTENDED=0

  eventoccurred=0

  do
    'eventmode=1 mit SLEEP(1), Warten auf Ereignis
    'eventmode=0 mit SLEEP(1), kein Warten auf Ereignis -> Durchlauf
    'eventmode=-1 kein SLEEP(1), keine Warten auf Ereignis -> Durchlauf
    if eventmode>-1 then sleep 1
    if eventmode<1 then eventoccurred=1
'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 ==> eventoccurred=1
    'Event Mausposition + Mausbewegung
    if MOUSEX<>oldMOUSEX or MOUSEY<>oldMOUSEY then eventoccurred=1
    'Event LMB
    if LMB<>oldLMB then eventoccurred=1
    'Event MMB
    if MMB<>oldMMB then eventoccurred=1
    'Event RMB
    if RMB<>oldRMB then eventoccurred=1

    'Event Tastatur
    if KEY<>"" then
      if len(KEY)=2 then
        EXTENDED=asc(left(KEY,1))
        KEY=right(KEY,1)
      end if
      ASCCODE=asc(KEY)
      eventoccurred=1 '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 EventHandle/EventLoop
        eventoccurred=1          '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 eventoccurred=1
    if MENUMESSAGE then eventoccurred=1

  loop until eventoccurred
end sub



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

  'wenn result>0  dann ist dies eine GADGETMESSAGE
  'wenn result=-1 dann will dieses Control die Tastatureingaben auswerten

  GADGETMESSAGE=0
  select case LMB

    case HIT 'wenn Maus grad gedrückt wurde
      refgad=0           'Variablen zurücksetzen
      actgad=0
      result=0
      refgad=GetGadgetPointer
      if refgad then action=GADGET_HIT
    
    case HOLD
      if refgad then
        actgad=GetGadgetPointer
        if actgad=refgad then action=GADGET_HOLD else action=GADGET_HOLDOFF
      end if

    case RELEASE
      if refgad then
        actgad=GetGadgetPointer
        if actgad=refgad then action=GADGET_RELEASE else action=GADGET_RELEASEOFF
      end if

    case RELEASED
      'hat sich warscheinlich als Event erübrigt, ist aber noch nicht ausgetestet!!!!
  end select

  if refgad then result=refgad->DoAction(refgad,action)
  if (result>0) then GADGETMESSAGE=refgad

  if (keygad>0) and (refgad>0) and (refgad<>keygad) then
    keygad->DoAction(keygad,GADGET_KEYBOARDOFF)
    keygad=0
  end if
  if result=-1 then keygad=refgad

  if (KEY<>"") and (keygad>0) then
    if (keygad->act=1) then result=keygad->DoAction(keygad,GADGET_KEYBOARD)
    if (result<>0) then GADGETMESSAGE=keygad
    if (result=-1) then 
      keygad->DoAction(keygad,GADGET_KEYBOARDOFF)
      keygad=0
    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 in Images(1) existiert, dann ausschliessen ob die Maus-Position
					'nicht über einem Pixel mit der Farbe RGB(255,0,255) ist!
					if gad->Images(1) then
            col=point(MOUSEX-gad->posx,MOUSEY-gad->posy,gad->Images(1))
            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

  select case LMB
    case HIT
      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
  
    case HOLD
      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
  
  
    case RELEASE
      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)
  
    case RELEASED
      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 select
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
      for i as integer=0 to ubound(gad->Images)
        if gad->Images(i) then imagedestroy gad->Images(i)
      next i
      if (gad->texto>0) and (gad->affiliation=1) then delete gad->texto 'TextObject hat einen eigenen Destruktor für das Löschen der Zeilen

      'Falls ein SubEvent(der eine eigene Gadgetliste haben wird!) im Gadget  existiert,
      'wird rekursiv 'DeleteGadgetsAndMenu' aufgerufen um die Subhandles und deren Gadgets zu löschen
      if gad->subevent then
        gad->subevent->DeleteGadgetsAndMenu
        delete gad->subevent
      end if

      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



'******************************************************************************
'******************************************************************************
'Activation********************************************************************

declare sub GadgetOn overload (gad as Gadget ptr)
declare sub GadgetOn (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)

declare sub GadgetSleep overload (gad as Gadget ptr)
declare sub GadgetSleep (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)

declare sub GadgetOff   overload (gad as Gadget ptr)
declare sub GadgetOff (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)

declare sub RestoreActivation overload (gad as Gadget ptr)
declare sub RestoreActivation (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)

declare sub GadOn    (gad as Gadget ptr)
declare sub GadSleep (gad as Gadget ptr)
declare sub GadOff   (gad as Gadget ptr)



sub GadgetOn (gad as Gadget ptr)
  GadOn (gad)
end sub



sub GadgetSleep (gad as Gadget ptr)
  GadSleep (gad)
end sub



sub GadgetOff (gad as Gadget ptr)
  GadOff (gad)
end sub



sub GadgetOn (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)
  dim as Gadget ptr gad
  dim as integer exitloop=0
  gad=gadblockstart
  do
    GadOn (gad)
    if gad=gadblockend then exitloop=1
    gad=gad->nextGadget
    if gad=0 then exitloop=1
  loop until exitloop
end sub



sub GadgetSleep (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)
  dim as Gadget ptr gad
  dim as integer exitloop=0
  gad=gadblockstart
  do
    GadSleep (gad)
    if gad=gadblockend then exitloop=1
    gad=gad->nextGadget
    if gad=0 then exitloop=1
  loop until exitloop
end sub



sub GadgetOff (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)
  dim as Gadget ptr gad
  dim as integer exitloop=0
  gad=gadblockstart
  do
    GadOff (gad)
    if gad=gadblockend then exitloop=1
    gad=gad->nextGadget
    if gad=0 then exitloop=1
  loop until exitloop
end sub



sub RestoreActivation overload (gad as Gadget ptr)
  dim oa as integer=gad->oldact
  select case oa
    case 0
      GadOff (gad)
    case 1
      GadOn (gad)
    case 2
      GadSleep (gad)
  end select
end sub



sub RestoreActivation (gadblockstart as Gadget ptr, gadblockend as Gadget ptr)
  dim as Gadget ptr gad
  dim as integer oa
  dim as integer exitloop=0
  gad=gadblockstart
  do
    oa=gad->oldact
    select case oa
      case 0
        GadOff (gad)
      case 1
        GadOn (gad)
      case 2
        GadSleep (gad)
    end select
    if gad=gadblockend then exitloop=1
    gad=gad->nextGadget
    if gad=0 then exitloop=1
  loop until exitloop
end sub



'Dies waren bisher die "echten" Befehle
'sind jetzt zu Gunsten einer überladenen Variante oben gekapselt worden
sub GadOn (gad as Gadget ptr)
  gad->oldact=gad->act'alten Zustand merken
  gad->act=1
  gad->DoDraw (gad)
	'wenn SubEvent vorhanden(rekursiv)
	if gad->subevent then
		for i as integer=0 to ubound(gad->gad)
			if gad->gad(i)>0 then
				GadOn (gad->gad(i))
			end if
		next i
	end if
end sub



sub GadSleep (gad as Gadget ptr)
  gad->oldact=gad->act'alten Zustand merken
  gad->act=2
  gad->DoDraw (gad)

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



sub GadOff (gad as Gadget ptr)
  gad->oldact=gad->act'alten Zustand merken
  gad->act=0
  gad->DoDraw (gad)

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



'**************************************************************************************************
'**************************************************************************************************
'Selection*****************************************************************************************

declare function GetSelect (gad as Gadget ptr) as integer
declare sub SetSelect (gad as Gadget ptr,selection as integer)



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



'**************************************************************************************************
'**************************************************************************************************
'Refresh*******************************************************************************************

declare sub DrawGadget(gad as _Gadget ptr)
declare sub SaveBackGround(gad as _Gadget ptr)
declare sub UpdateGadget(gad as _Gadget ptr)
declare sub UpdateGadgetDummy(gad as _Gadget ptr)
declare sub SetCaption(gad as _Gadget ptr,txt as string)

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



sub SaveBackGround(gad as _Gadget ptr)
	gad->Images(0)=imagecreate(gad->gadw,gad->gadh)
  if gad->Images(0) then
    get(gad->posx,gad->posy)-(gad->posx+gad->gadw-1,gad->posy+gad->gadh-1),gad->Images(0)
  	'Wenn ein Masken-Image existiert, dann dessen Tranparenz-Farbe übertragen
		if gad->Images(1)>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->Images(1))=&HFFFF00FF then pset gad->Images(0),(i,k),&HFFFF00FF
				next i
			next k
		end if
	else
    gad->Images(0)=0
  end if
end sub



sub UpdateGadget(gad as _Gadget ptr)
  gad->DoUpdate(gad)
end sub



sub UpdateGadgetDummy(gad as _Gadget ptr)
end sub



sub SetCaption(gad as _Gadget ptr,txt as string)
  gad->caption=txt
  UpdateGadget(gad)
end sub


'**************************************************************************************************
'**************************************************************************************************
'sGUI Includes*************************************************************************************
#include "sGUI_Drawing.bas"
#include "sGUI_Adds.bas"

