OOP...

[X0r]

Hallo,
ich bin gerade dabei die ganzen PB libs "OOP-fähig" zu machen.
Nun komm ich an einer Stelle nicht weiter.

Erstmal der Code:

(Original von inc.. Ich habs verbessert und die Gadget|Button-Klasse eingebaut)

Code: Alles auswählen

;{
Class WINDOW
WINDOW(x.l = #PB_Ignore, y.l = #PB_Ignore, width.l = #PB_Ignore, height.l = #PB_Ignore, Titel.s = "", flags.l = #False, ParentWindowID.l = #False)
Release()

  Flex Close()
  Flex IsInitialized()
  Flex GetID()
  Flex SetActive()
  Flex Disable(Status.l)
  Flex Hide(Status.l)
  Flex Show(Status.l)
  Flex SmartRefresh(Status.l)
  Flex Sticky(Status.l)
 

  Flex Height(height.l)
  Flex Width(width.l)
  Flex MouseX()
  Flex MouseY()
  Flex OutputID()
  Flex XPos(x.l)
  Flex YPos(y.l)

  Flex Move(x.l= #PB_Ignore, y.l = #PB_Ignore)
  Flex NewSize(width.l= #PB_Ignore, height.l= #PB_Ignore)
  Flex Resize(x.l = #PB_Ignore, y.l = #PB_Ignore, width.l= #PB_Ignore, height.l= #PB_Ignore)

  Flex Color(Color.l = #False)
  Flex State(Status.l = #False)
  Flex Title.s(Title.s = "")

  Flex WaitEvent(Timeout.l = 0)
  Flex Event()
  Flex EventGadget()
  Flex EventMenu()
  Flex EventType()
  Flex EventWindow()

  Flex AddKeyboardShortcut(Shortcut.l, Event.l)
  Flex RemoveKeyboardShortcut(Shortcut.l)

  Flex SetCallback(*CallbackProcedure)
  
  hwnd.l
  wndID.l
EndClass
  

Procedure WINDOW.Release()
  If IsWindow(This->wndID)
    CloseWindow(This->wndID)
  EndIf
  This->hwnd = 0
EndProcedure

Procedure WINDOW.WINDOW(x.l = #PB_Ignore, y.l = #PB_Ignore, width.l = #PB_Ignore, height.l = #PB_Ignore, Titel.s = "", flags.l = #False, ParentWindowID.l = #False)
  This->wndID = OpenWindow(#PB_Any, x.l, y.l, width.l, height.l, Titel.s, flags.l, ParentWindowID.l)
  This->hwnd  = WindowID(This->wndID)
  CreateGadgetList(This->hwnd)
  ProcedureReturn This->hwnd
EndProcedure

Procedure WINDOW.AddKeyboardShortcut(Shortcut.l, Event.l)
  ProcedureReturn AddKeyboardShortcut(This->wndID, Shortcut, Event)
EndProcedure

Procedure WINDOW.Close()
  ProcedureReturn CloseWindow(This->wndID)
EndProcedure

Procedure WINDOW.Disable(Status.l)
  ProcedureReturn DisableWindow(This->wndID, Status.l)
EndProcedure

Procedure WINDOW.EventGadget()
  ProcedureReturn EventGadget()
EndProcedure

Procedure WINDOW.EventMenu()
  ProcedureReturn EventMenu()
EndProcedure

Procedure WINDOW.EventType()
  ProcedureReturn EventType()
EndProcedure

Procedure WINDOW.EventWindow()
  ProcedureReturn EventWindow()
EndProcedure

Procedure WINDOW.Color(Color.l = #False)
  If Color
    ProcedureReturn SetWindowColor(This->wndID, Color)
  Else
    ProcedureReturn GetWindowColor(This->wndID)
  EndIf
EndProcedure

Procedure WINDOW.State(Status.l = #False)
  If Status
    ProcedureReturn SetWindowState(This->wndID, Status)
  Else
    ProcedureReturn GetWindowState(This->wndID)
  EndIf
EndProcedure

Procedure.s WINDOW.Title(Title.s = "")
  If Title
    SetWindowTitle(This->wndID, Title)
  Else
    ProcedureReturn GetWindowTitle(This->wndID)
  EndIf
EndProcedure

Procedure WINDOW.Hide(Status.l)
  ProcedureReturn HideWindow(This->wndID, 1)
EndProcedure

Procedure WINDOW.Show(Status.l)
  ProcedureReturn HideWindow(This->wndID, 0)
EndProcedure

Procedure WINDOW.IsInitialized()
  ProcedureReturn IsWindow(This->wndID)
EndProcedure

Procedure WINDOW.Move(x.l= #PB_Ignore, y.l = #PB_Ignore)
  ProcedureReturn ResizeWindow(This->wndID, x.l, y.l, #PB_Ignore, #PB_Ignore)
EndProcedure

Procedure WINDOW.NewSize(width.l= #PB_Ignore, height.l= #PB_Ignore)
  ProcedureReturn ResizeWindow(This->wndID, #PB_Ignore, #PB_Ignore, width.l, height.l)
EndProcedure

Procedure WINDOW.Resize(x.l = #PB_Ignore, y.l = #PB_Ignore, width.l= #PB_Ignore, height.l= #PB_Ignore)
  ProcedureReturn ResizeWindow(This->wndID, x.l, y.l, width.l, height.l)
EndProcedure

Procedure WINDOW.RemoveKeyboardShortcut(Shortcut.l)
  ProcedureReturn RemoveKeyboardShortcut(This->wndID, Shortcut.l)
EndProcedure

Procedure WINDOW.SetActive()
  ProcedureReturn SetActiveWindow(This->wndID)
EndProcedure

Procedure WINDOW.SetCallback(*CallbackProcedure)
  ProcedureReturn SetWindowCallback(*CallbackProcedure, This->wndID)
EndProcedure

Procedure WINDOW.SmartRefresh(Status.l)
  ProcedureReturn SmartWindowRefresh(This->wndID, Status)
EndProcedure

Procedure WINDOW.Sticky(Status.l)
  ProcedureReturn StickyWindow(This->wndID, Status)
EndProcedure

Procedure WINDOW.WaitEvent(Timeout.l=0)
   If EventWindow()=this->wndID
    ProcedureReturn WaitWindowEvent()
  EndIf
EndProcedure

Procedure WINDOW.Event()
  ProcedureReturn WindowEvent()
EndProcedure

Procedure WINDOW.GetID()
  ProcedureReturn WindowID(This->wndID)
EndProcedure

Procedure WINDOW.Height(height.l)
    ProcedureReturn WindowHeight(This->wndID)
EndProcedure

Procedure WINDOW.Width(width.l)
    ProcedureReturn WindowWidth(This->wndID)
EndProcedure

Procedure WINDOW.MouseX()
  ProcedureReturn WindowMouseX(This->wndID)
EndProcedure

Procedure WINDOW.MouseY()
  ProcedureReturn WindowMouseY(This->wndID)
EndProcedure

Procedure WINDOW.OutputID()
  ProcedureReturn WindowOutput(This->wndID)
EndProcedure

Procedure WINDOW.XPos(x.l)
    ProcedureReturn ResizeWindow(This->wndID, x, #PB_Ignore, #PB_Ignore, #PB_Ignore)
EndProcedure

Procedure WINDOW.YPos(y.l)
    ProcedureReturn WindowY(This->wndID)
EndProcedure
;}

Class Abstract GADGET
GADGET()
CountItems()
Disable(Status.l)
Free()
GetHeight()
GetHandle()
ToolTip(Text.s)
GetType()
GetWidth()
GetX()
GetY()
GetAttribute(Type.l)
GetColor(Type.l)
GetData()
GetFont()
GetState()
GetText.s()
Hide()
Show()
Is()
Resize(x.l=#PB_Ignore,y.l=#PB_Ignore,width.l=#PB_Ignore,height.l=#PB_Ignore)
SetColor(Type.l,Color.l)
SetText(Text.s)
AddEvent(*Proc)
GetID()
GetProcA()

gad.l
Handle.l
*ProcA.l
EndClass

Global NewList gadgets.GADGET() 

;{
Procedure GADGET.GADGET()
  
EndProcedure

Procedure GADGET.CountItems()
  ProcedureReturn CountGadgetItems(This->gad)
EndProcedure

Procedure GADGET.Disable(Status.l)
  DisableGadget(This->gad,Status)
EndProcedure

Procedure GADGET.Free()
  FreeGadget(This->gad)
EndProcedure

Procedure GADGET.GetHeight()
  FreeGadget(This->gad)
EndProcedure

Procedure GADGET.GetHandle()
  ProcedureReturn Handle
EndProcedure

Procedure GADGET.Tooltip(Text.s)
  GadgetToolTip(This->gad,Text)
EndProcedure

Procedure GADGET.GetType()
  ProcedureReturn GadgetType(This->gad)
EndProcedure

Procedure GADGET.GetWidth()
  ProcedureReturn GadgetWidth(This->gad)
EndProcedure

Procedure GADGET.GetX()
  ProcedureReturn GadgetX(This->gad)
EndProcedure

Procedure GADGET.GetY()
  ProcedureReturn GadgetX(This->gad)
EndProcedure

Procedure GADGET.GetAttribute(Type.l)
  ProcedureReturn GetGadgetAttribute(This->gad,Type)
EndProcedure

Procedure GADGET.GetColor(Type.l)
  ProcedureReturn GetGadgetColor(This->gad,Type)
EndProcedure

Procedure GADGET.GetData()
  ProcedureReturn GetGadgetData(This->gad)
EndProcedure

Procedure GADGET.GetFont()
  ProcedureReturn GetGadgetFont(This->gad)
EndProcedure

Procedure GADGET.GetState()
  ProcedureReturn GetGadgetState(This->gad)
EndProcedure

Procedure.s GADGET.GetText()
  ProcedureReturn GetGadgetText(This->gad)
EndProcedure

Procedure GADGET.Show()
  HideGadget(This->gad,0)
EndProcedure

Procedure GADGET.Hide()
  HideGadget(This->gad,1)
EndProcedure

Procedure GADGET.Is()
  ProcedureReturn IsGadget(This->gad)
EndProcedure

Procedure GADGET.Resize(x.l=#PB_Ignore,y.l=#PB_Ignore,width.l=#PB_Ignore,height.l=#PB_Ignore)
  ResizeGadget(This->gad,x.l,y.l,width.l,height.l)
EndProcedure

Procedure GADGET.SetColor(Type.l,Color.l)
  SetGadgetColor(This->gad,Type,Color)
EndProcedure

Procedure GADGET.SetText(Text.s)
  SetGadgetText(This->gad,Text)
EndProcedure

Procedure GADGET.AddEvent(*Proc)
  AddElement(gadgets())
  gadgets() = This
  This->ProcA=*Proc
EndProcedure

Procedure GADGET.GetID()
  ProcedureReturn This->gad
EndProcedure

Procedure GADGET.GetProcA()
  ProcedureReturn This->ProcA
EndProcedure

;}


Class BUTTON Extends GADGET
BUTTON(x.l,y.l,w.l,h.l,Text.s)


EndClass




Procedure BUTTON.BUTTON(x.l,y.l,w.l,h.l,Text.s)
  This->gad=ButtonGadget(#PB_Any,x,y,w,h,Text)
  This->Handle=GadgetID(This->gad)
EndProcedure

Global Event

Procedure UpdateGadgets()
  If Event=#PB_Event_Gadget
  gev=EventGadget()
  
  ForEach gadgets()
    *obj.GADGET=gadgets()
    id=*obj->GetID()

    If gev=id
    proc=*obj->GetProcA()
    CallFunctionFast(proc,*obj)
      EndIf
    
    Next
    EndIf
EndProcedure


Declare Click(*obj.GADGET)




*Window.WINDOW = NewObject WINDOW(#PB_Ignore, #PB_Ignore, 400, 200 , "Here is the title", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
*Btn.BUTTON= NewObject BUTTON(10,10,100,20,"Button")
*Btn->AddEvent(@Click())





Repeat

Event=WaitWindowEvent()
    UpdateGadgets()
  Until Event = #PB_Event_CloseWindow

  *Window->Release()
  DeleteObject *Window

  
  
  
  
  
  Procedure Click(*obj.GADGET)
    MessageRequester("1","2")
    *obj->SetText("Text")
    
  EndProcedure

Das Problem ist das Event-Handling.

Ich dachte mir, den Gadgets könnte man ja einfach Prozeduren zuweisen.
Aber wie sieht das nun mit WaitwindowEvent und den Windows aus?
WaitwindowEvent benutze ich schon in der UpdateGadgets-Funktion.

inc. z.B hatte einfach ne WaitwindowEvent Methode eingebaut. Bringt ja aber nix, da das für alle Events gilt, und nicht für die Events von einem bestimmten Fenster.

Hätte jemand ne Idee?

Verbesserungsvorschläge zum obigen Code sind natürlich auch wilkommen(Und das Global Event bitte erstmal ignorieren.. )

[ts-soft]

http://www.purebasic.fr/german/viewtopi ... 0112#80112

[X0r]

Clever!

Aber ich suche erstmal ne Lösung für die Windows.

[X0r]

Irgendwie kompliziert das ganze...
Vielleicht kann mir ja ein OOP-Freak bei meinem Problem helfen.

Code: Alles auswählen

Class frame
FRAME()
test()

*Btn.BUTTON
*Btna.BUTTON
EndClass

  
Procedure FRAME.Test()
  this->Btna->SetText("saasj")
EndProcedure
  


Procedure FRAME.frame()
  
  *Window.WINDOW = NewObject WINDOW(#PB_Ignore, #PB_Ignore, 400, 200 , "Here is the title", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  


  *Window->AddEvent(@Click() , #PB_Event_CloseWindow)
  
  This->Btn= NewObject BUTTON(10,10,100,20,"Button")
  This->Btn->AddEvent(@this->test(), #PB_EventType_LostFocus  )
  
  This->Btna= NewObject BUTTON(10,50,100,20,"Button A")
  
EndProcedure


*myframe.frame= NewObject FRAME()


Repeat

  Event=WaitWindowEvent()
  UpdateWindows(Event)
  If Event=#PB_Event_Gadget
    UpdateGadgets()
  EndIf
  


ForEver

So ähnlich stell ich mir das vor. Wenn man auf Btn klickt, soll der Text in Btna geändert werden. Aber wie ist das zu realisieren?

[Danilo]

Irgendwie kompliziert das ganze...
Vielleicht kann mir ja ein OOP-Freak bei meinem Problem helfen.

Bei mir (PB4.20) geht 'class' nicht, aber ich habe trotzdem mal schnell
einen kleinen Beispielcode für Standard-PB4.20 gemacht:

Code: Alles auswählen

Structure EventTable
  on_click.l
EndStructure

Structure Gadget
  id.l
  events.EventTable
EndStructure


Procedure.l ID(*x.Gadget)
  If *x
    ProcedureReturn *x\id
  EndIf
EndProcedure


Procedure.l BUTTON(x,y,w,h,title$)
  *mem.Gadget = AllocateMemory(SizeOf(Gadget))
  *mem\id = ButtonGadget(#PB_Any,x,y,w,h,title$)
  SetGadgetData(*mem\id,*mem)
  ProcedureReturn *mem
EndProcedure


Procedure.l TRACK(x,y,w,h,min,max)
  *mem.Gadget = AllocateMemory(SizeOf(Gadget))
  *mem\id = TrackBarGadget(#PB_Any,x,y,w,h,min,max)
  SetGadgetData(*mem\id,*mem)
  ProcedureReturn *mem
EndProcedure


Procedure.l LIST(x,y,w,h)
  *mem.Gadget = AllocateMemory(SizeOf(Gadget))
  *mem\id = ListViewGadget(#PB_Any,x,y,w,h)
  SetGadgetData(*mem\id,*mem)
  ProcedureReturn *mem
EndProcedure


Procedure SetEvent(*gadget.Gadget,EventType,proc)
  If *gadget
    *mem.Gadget = GetGadgetData(*gadget\id)
    If *mem
      Select EventType
        Case #PB_EventType_LeftClick
          *mem\events\on_click = proc
      EndSelect
    EndIf
  EndIf
EndProcedure


Procedure DoEvents()
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        ProcedureReturn
      Case #PB_Event_Gadget
        Select EventType()
          Case #PB_EventType_LeftClick
            *mem.Gadget = GetGadgetData(EventGadget())
            If *mem
              If *mem\events\on_click
                CallFunctionFast(*mem\events\on_click,*mem\id)
              EndIf
            EndIf
        EndSelect
    EndSelect
  ForEver
EndProcedure

;----------------------------------------------------
;--[ PROGRAM ]---------------------------------------
;----------------------------------------------------

Procedure Btn1_Click(Sender)
  Shared Btn1_ClickCount
  Btn1_ClickCount + 1
  SetGadgetText(Sender,Str(Btn1_ClickCount))
EndProcedure

Procedure All_Click(Sender)
  MessageRequester("INFO","You clicked gadget: "+GetGadgetText(Sender))
EndProcedure

Procedure Slider_Click(Sender)
  Beep_(500+GetGadgetState(Sender)*20,50)
EndProcedure

Procedure List_Click(Sender)
  MessageRequester("INFO","You clicked item: "+GetGadgetItemText(Sender,GetGadgetState(Sender)))
EndProcedure


If OpenWindow(0,0,0,640,480,"Test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CreateGadgetList(WindowID(0))

  btn1 = BUTTON(10,10,100,20,"Button 1")
       : SetEvent(btn1, #PB_EventType_LeftClick, @Btn1_Click())

  btn2 = BUTTON(10,40,100,20,"Button 2")
       : SetEvent(btn2, #PB_EventType_LeftClick, @All_Click())

  btn3 = BUTTON(10,70,100,20,"Button 3")
       : SetEvent(btn3, #PB_EventType_LeftClick, @All_Click())

  trck = TRACK(120,10,100,20,1,100)
       : SetEvent(trck, #PB_EventType_LeftClick, @Slider_Click())

  list = LIST(120,40,100,100)
       : SetEvent(list, #PB_EventType_LeftClick, @List_Click())
       : For i=1 To 100 : AddGadgetItem(ID(list),-1,Str(i)) : Next



  DoEvents()

EndIf

Vielleicht bekommst Du so eine Idee wie Du das in Dein Zeug
integrieren kannst.
Letztendlich geht es nur darum für jedes Window/Gadget einen eigenen
EventTable anzulegen. Dazu dann ein DoEvents(), von dem aus die
einzelnen Event-Prozeduren aufgerufen werden.

Du kannst dort beliebige Events hinzufügen in den Table und in DoEvents().

Für Fenster gehts genauso, nur mußt Du dann einige Events (OnRightClick, OnFocus etc.)
eventuell in einem WindowCallback abfangen und von dort aus die Event-Prozeduren aufrufen.

hope it helps

[HeX0R]

*Augenreib*

[X0r]

>*Augenreib*
?

@Danilo:

Erstmal Danke für deine Antwort!
Ich verwende PureObject von inc., daher auch der "class"-Befehl.

Aber leider hat mir das nicht geholfen. Ich will ja den Text eines anderen Button-Objekts verändern. An dieses komme ich aber leider nicht ran.

[HeX0R]

Entschuldige, ich war nur etwas geplättet wieder von Danilo zu hören, kommt nicht wieder vor

[inc.]

Hier ein Beispiel wie ich mir ein setzen von Events vorstelle.

Werde dies auch als OOP Version bei Gelegenheit umsetzen.

Code: Alles auswählen

EnableExplicit

Structure EventTable
  id.l
  
  ; Gadget Event Table
  on_LeftClick.l
  on_RightClick.l
  on_LeftDoubleClick.l
  on_RightDoubleClick.l
  on_Focus.l
  on_LostFocus.l
  on_Change.l
  on_DragStart.l
  
  ; Window Event Table
  on_Move.l
  on_Repaint.l
  on_Resize.l
  on_Activate.l
  on_Close.l
  on_Drop.l
EndStructure ;}

Global NewList __Gadgets.EventTable()
Global NewList __MenueItem.EventTable()
Global NewList __Window.EventTable()

Macro GetElement(__element__, __value__)
  If CountList(__element__#)
    ForEach __element__#
      If __element__#\id = __value__#
        Break
      EndIf
    Next
    If Not __element__#\id = __value__#
      AddElement(__element__#)
      __element__#\id = __value__#
    EndIf
  Else
    AddElement(__element__#)
    __element__#\id = __value__#
  EndIf
EndMacro

Macro GotoElement(__element__, __value__)
  ForEach __element__#
    If __element__#\id = __value__#
      Break
    EndIf
  Next
EndMacro

Procedure SetEvent(Num.l, *Proc, Event.l = #PB_Event_Gadget, EventType.l = #PB_EventType_LeftClick)
  If *Proc
    If Event = #PB_Event_Gadget And IsGadget(Num) 
      GetElement(__Gadgets(), Num)
      Select EventType
        Case #PB_EventType_LeftClick
          __Gadgets()\on_LeftClick = *Proc
        Case #PB_EventType_RightClick
          __Gadgets()\on_RightClick = *Proc
        Case #PB_EventType_LeftDoubleClick
          __Gadgets()\on_LeftDoubleClick = *Proc
        Case #PB_EventType_RightDoubleClick
          __Gadgets()\on_RightDoubleClick = *Proc
        Case #PB_EventType_Focus
          __Gadgets()\on_Focus = *Proc
        Case #PB_EventType_LostFocus
          __Gadgets()\on_LostFocus = *Proc
        Case #PB_EventType_Change
          __Gadgets()\on_Change = *Proc
        Case #PB_EventType_DragStart
          __Gadgets()\on_DragStart = *Proc
      EndSelect
      
    ElseIf Event = #PB_Event_Menu
      GetElement(__MenueItem(), Num)
      __MenueItem()\on_LeftClick = *Proc
      
    ElseIf IsWindow(Num) ; // If its not a gadget event or a menu event then its a window event
      GetElement(__Window(), Num)
      If Event = #PB_Event_MoveWindow
        __Window()\on_Move = *Proc
      ElseIf Event = #PB_Event_Repaint
        __Window()\on_Repaint = *Proc
      ElseIf Event = #PB_Event_SizeWindow
        __Window()\on_Resize = *Proc
      ElseIf Event = #PB_Event_ActivateWindow
        __Window()\on_Activate = *Proc
      ElseIf Event = #PB_Event_CloseWindow
        __Window()\on_Close = *Proc
      ElseIf Event = #PB_Event_WindowDrop
        __Window()\on_Drop = *Proc
        EnableWindowDrop(__Window()\id, #PB_Drop_Files, #PB_Drag_Copy) ; // Should be optimzed for more options
      EndIf
      
    Else
      ProcedureReturn #False
    EndIf
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure RemoveEvent(Num.l, Event.l = #PB_Event_Gadget, EventType.l = #PB_EventType_LeftClick)
  If Event = #PB_Event_Gadget And IsGadget(Num)
    GotoElement(__Gadgets(), Num)
    If __Gadgets()\id = Num
      Select EventType
        Case #PB_EventType_LeftClick
          __Gadgets()\on_LeftClick = 0
        Case #PB_EventType_RightClick
          __Gadgets()\on_RightClick = 0
        Case #PB_EventType_LeftDoubleClick
          __Gadgets()\on_LeftDoubleClick = 0
        Case #PB_EventType_RightDoubleClick
          __Gadgets()\on_RightDoubleClick = 0
        Case #PB_EventType_Focus
          __Gadgets()\on_Focus = 0
        Case #PB_EventType_LostFocus
          __Gadgets()\on_LostFocus = 0
        Case #PB_EventType_Change
          __Gadgets()\on_Change = 0
        Case #PB_EventType_DragStart
          __Gadgets()\on_DragStart = 0
      EndSelect
    EndIf 
    
  ElseIf Event = #PB_Event_Menu
    GotoElement(__MenueItem(), Num)
    If __MenueItem()\id = Num
      __MenueItem()\on_LeftClick = 0
    EndIf
    
  ElseIf IsWindow(Num)
    GotoElement(__Window(), Num)
    If __Window()\id = Num
      If Event = #PB_Event_MoveWindow
        __Window()\on_Move = 0
      ElseIf Event = #PB_Event_Repaint
        __Window()\on_Repaint = 0
      ElseIf Event = #PB_Event_SizeWindow
        __Window()\on_Resize = 0
      ElseIf Event = #PB_Event_ActivateWindow
        __Window()\on_Activate = 0
      ElseIf Event = #PB_Event_CloseWindow
        __Window()\on_Close = 0
      ElseIf Event = #PB_Event_WindowDrop
        __Window()\on_Drop = 0
      EndIf
    EndIf
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure RunApp()
  Protected Event.l, Window.l
  Repeat
    Event = WaitWindowEvent()
    Window = EventWindow()
    
    GotoElement(__Window(), Window)
    If Not __Window()\id = Window ; // Window not found
      Debug "Could not find Window "+Str(Window)+" in Proc 'RunApp()'."
      ProcedureReturn #False
    EndIf
    
    Select Event
      Case #PB_Event_Gadget
        GotoElement(__Gadgets(), EventGadget())
        If __Gadgets()\id = EventGadget()
          Select EventType()
            Case #PB_EventType_LeftClick
              If __Gadgets()\on_LeftClick
                CallFunctionFast(__Gadgets()\on_LeftClick, __Gadgets()\id)
              EndIf
            Case #PB_EventType_RightClick
              If __Gadgets()\on_RightClick
                CallFunctionFast(__Gadgets()\on_RightClick, __Gadgets()\id)
              EndIf
            Case #PB_EventType_LeftDoubleClick
              If __Gadgets()\on_LeftDoubleClick
                CallFunctionFast(__Gadgets()\on_LeftDoubleClick, __Gadgets()\id)
              EndIf
            Case #PB_EventType_RightDoubleClick
              If __Gadgets()\on_RightDoubleClick
                CallFunctionFast(__Gadgets()\on_RightDoubleClick, __Gadgets()\id)
              EndIf
            Case #PB_EventType_Focus
              If __Gadgets()\on_Focus
                CallFunctionFast(__Gadgets()\on_Focus, __Gadgets()\id)
              EndIf
            Case #PB_EventType_Change
              If __Gadgets()\on_Change
                CallFunctionFast(__Gadgets()\on_Change, __Gadgets()\id)
              EndIf
            Case #PB_EventType_DragStart
              If __Gadgets()\on_DragStart
                CallFunctionFast(__Gadgets()\on_DragStart, __Gadgets()\id)
              EndIf
          EndSelect
        Else
          Debug "Could not find Gadget "+Str(EventGadget())+" in Proc 'RunApp()'."
          ProcedureReturn #False
        EndIf
        
      Case #PB_Event_Menu
        GotoElement(__MenueItem(), EventMenu())
        If __MenueItem()\id = EventMenu() And __MenueItem()\on_LeftClick
          CallFunctionFast(__MenueItem()\on_LeftClick, __MenueItem()\id)
        EndIf
        
      Case #PB_Event_CloseWindow
        If __Window()\id = Window And  __Window()\on_Close
          CallFunctionFast(__Window()\on_Close, __Window()\id)
        Else
          ProcedureReturn #True
        EndIf
      Case #PB_Event_MoveWindow
        If __Window()\on_Move
          CallFunctionFast(__Window()\on_Move, EventWindow())
        EndIf
      Case #PB_Event_SizeWindow
        If __Window()\on_Resize
          CallFunctionFast(__Window()\on_Resize, EventWindow())
        EndIf
      Case #PB_Event_Repaint
        If __Window()\on_Repaint
          CallFunctionFast(__Window()\on_Repaint, EventWindow())
        EndIf
      Case #PB_Event_ActivateWindow
        If __Window()\on_Activate
          CallFunctionFast(__Window()\on_Activate, EventWindow())
        EndIf
      Case #PB_Event_WindowDrop
        If __Window()\on_Drop
          CallFunctionFast(__Window()\on_Drop, EventWindow())
        EndIf
    EndSelect
  ForEver
EndProcedure

DisableExplicit



; // Event Procedures ////////////////////////

Procedure Proc_ButtonGadget(sender.l)
  Debug "ButtonGadget No." + Str(sender) + " gedrückt"
EndProcedure

Procedure Proc_CheckBoxGadget(sender.l)
  Debug "CheckBoxGadget No." + Str(sender) + " gedrückt"
EndProcedure

Procedure Proc_DragNdrop(sender.l)
  Debug "One item dropped on window No." + Str(sender)
  Debug EventDropFiles()
EndProcedure

Procedure Proc_MenueEntry1(sender.l)
  Debug "MenueEintrag No." + Str(sender) + " gedrückt"
EndProcedure

Procedure Proc_MenueEntry2(sender.l)
  Debug "MenueEintrag No." + Str(sender) + " gedrückt"
EndProcedure

Procedure Proc_WindowMove(sender.l)
  Debug "Fenster No." + Str(sender) + " verschoben"
EndProcedure

Procedure Proc_WindowRepaint(sender.l)
  Debug "Fenster No." + Str(sender) + " erneuert"
EndProcedure

Procedure Proc_WindowResize(sender.l)
  Debug "Fenster No." + Str(sender) + " skaliert"
EndProcedure

Procedure Proc_WindowGetFocus(sender.l)
  Debug "Fenster No." + Str(sender) + " hat Focus erhalten"
EndProcedure

Procedure Proc_WindowClose(sender.l)
  Debug "Fenster No." + Str(sender) + " geschlossen"
  CloseWindow(sender)
EndProcedure




; // Example ////////////////////////

CompilerIf #PB_Compiler_Debugger = #False
  MessageRequester("Info", "Please run this example in debug mode")
  End
CompilerEndIf

Enumeration 666
  #Button  
  #Checkbox
EndEnumeration

Win  = OpenWindow(#PB_Any, 0, 0, 230, 90, " ", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
Win2 = OpenWindow(#PB_Any, 0, 0, 250, 60, " ", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)

SetWindowTitle(Win , "Window No. "+Str(Win ))
SetWindowTitle(Win2, "Window No. "+Str(Win2))

If Win And Win2
  
  If CreateGadgetList(WindowID(Win))
    ButtonGadget  (#Button,   10, 10, 200, 20, "Klick mich")
    CheckBoxGadget(#Checkbox, 10, 40, 200, 20, "Markiere mich")
  EndIf
  
  If CreateMenu(0, WindowID(Win))
    MenuTitle("Menu")
    MenuItem(1, "Eintrag 1")
    MenuItem(2, "Eintrag 2")
  EndIf
  
  SetEvent(#Button,   @Proc_ButtonGadget(),   #PB_Event_Gadget, #PB_EventType_LeftClick)
  SetEvent(#Checkbox, @Proc_CheckBoxGadget(), #PB_Event_Gadget, #PB_EventType_LeftClick)
  
  SetEvent(1, @Proc_MenueEntry1(), #PB_Event_Menu)
  SetEvent(2, @Proc_MenueEntry2(), #PB_Event_Menu)
  
  SetEvent(Win2, @Proc_DragNdrop(),      #PB_Event_WindowDrop)
  SetEvent(Win,  @Proc_WindowMove(),     #PB_Event_MoveWindow)
  SetEvent(Win,  @Proc_WindowRepaint(),  #PB_Event_Repaint)
  SetEvent(Win2, @Proc_WindowResize(),   #PB_Event_SizeWindow)
  SetEvent(Win,  @Proc_WindowGetFocus(), #PB_Event_ActivateWindow)
  SetEvent(Win,  @Proc_WindowClose(),    #PB_Event_CloseWindow)
  
  ; RemoveEvent(Win2, #PB_Event_WindowDrop) ; // Just for testing
  
  RunApp() ; // Application event loop
  
EndIf

[Danilo]

Code: Alles auswählen

; --------------------------------------------------------------------------------------------
; -[ HELPER ]---------------------------------------------------------------------------------
; --------------------------------------------------------------------------------------------


Structure Object
  vtable.l
  vars.l
EndStructure

Procedure AllocateObject( class, size, datasize )
  *mem.Object = AllocateMemory( SizeOf(Object) )
  If *mem
    *mem\vtable = AllocateMemory( size )
    *mem\vars   = AllocateMemory( datasize + 4 )
    CopyMemory(PeekL(class),*mem\vtable,size)
  EndIf
  ProcedureReturn *mem
EndProcedure

Procedure DeleteObject(*obj.Object)
  FreeMemory(*obj\vtable)
  FreeMemory(*obj\vars)
  FreeMemory(*obj)
EndProcedure

Macro Class( CLASS_NAME )
  DataSection
    CLASS_NAME#_class:
      Data.l ? CLASS_NAME#_methods
    CLASS_NAME#_methods:
  EndDataSection
EndMacro

Macro ClassData( CLASS_NAME )
  Structure CLASS_NAME#_Data
EndMacro

Macro EndClassData
  EndStructure
EndMacro

Macro Method
  Procedure
EndMacro

Macro UseClassVars( CLASS_NAME )
  *vars. CLASS_NAME#_Data = PeekL(*this+SizeOf(LONG))
EndMacro

Macro EndMethod( METHOD_NAME )
  EndProcedure
  DataSection
    Data.l @ METHOD_NAME ()
  EndDataSection
EndMacro

Macro EndClass
  ;EndDataSection
EndMacro


Macro New(__name__)
  AllocateObject( ?__name__#_class , SizeOf(__name__) , SizeOf( __name__#_Data ) )
  
  ;?__name__#_class : CompilerIf SizeOf( __name__#_Data ) : PokeL( ?__name__#_class+SizeOf(LONG) , AllocateMemory( SizeOf( __name__#_Data ) ) ) : CompilerEndIf
  ;Debug PeekL( ?__name__#_class+SizeOf(LONG) )
EndMacro


Macro Delete(__obj__)
  DeleteObject(__obj__) : __obj__ = 0 :
EndMacro


; --------------------------------------------------------------------------------------------
; -[ CLASSES ]--------------------------------------------------------------------------------
; --------------------------------------------------------------------------------------------


Interface Window
   Open.l(x,y,w,h,title$,flags=0)
   Move(x,y)
   getTitle.s()
   setTitle(title$)
EndInterface


Class(Window)

   ClassData(Window)
      id.l
      gadgetlist.l
   EndClassData
  
   Method.l Window_Open(*this.Window, x, y, w, h, title$, flags)
      UseClassVars(Window)
      *vars\id = OpenWindow(#PB_Any, x, y, w, h, title$, flags)
      *vars\gadgetlist = CreateGadgetList(WindowID(*vars\id))
      ProcedureReturn *vars\id
   EndMethod(Window_Open)
  
   Method   Window_Move(*this.Window, x, y)
      UseClassVars(Window)
      ResizeWindow(*vars\id,x,y,#PB_Ignore,#PB_Ignore)
   EndMethod(Window_Move)
  
   Method.s Window_getTitle(*this.Window)
      UseClassVars(Window)
      ProcedureReturn GetWindowTitle( *vars\id )
   EndMethod(Window_getTitle)

   Method   Window_setTitle(*this.Window, title$)
      UseClassVars(Window)
      SetWindowTitle( *vars\id, title$ )
   EndMethod(Window_setTitle)

EndClass




Interface Button
   Open.l(x,y,w,h,title$,flags=0)
   getText.s()
   setText(title$)
   OnClick(OnClick_Procedure)
EndInterface

Class(Button)

   ClassData(Button)
      id.l
      event_OnClick.l
      _data.l
   EndClassData

   Method.l Button_Open(*this.Button, x, y, w, h, text$)
     UseClassVars(Button)
     *vars\id = ButtonGadget(#PB_Any, x, y, w, h, text$)
     SetGadgetData(*vars\id,*this)
     ProcedureReturn *vars\id
   EndMethod(Button_Open)

   Method.s Button_getText(*this.Button)
      UseClassVars(Button)
      ProcedureReturn GetGadgetText( *vars\id )
   EndMethod(Button_getText)

   Method   Button_setText(*this.Button, title$)
      UseClassVars(Button)
      SetGadgetText( *vars\id, title$ )
   EndMethod(Button_setText)

   Method   Button_OnClick(*this.Button, OnClick_Procedure)
     UseClassVars(Button)
     *vars\event_OnClick = OnClick_Procedure
   EndMethod(Button_OnClick)

EndClass

; --------------------------------------------------------------------------------------------
; -[ EVENT HANDLER ]--------------------------------------------------------------------------
; --------------------------------------------------------------------------------------------

Procedure DoEvents()
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow
            Break
         Case #PB_Event_Gadget
            *obj = GetGadgetData(EventGadget())
            If *obj
               *btnVars.Button_Data = PeekL(*obj+SizeOf(LONG))
               If *btnVars
                 If *btnVars\event_OnClick
                   CallFunctionFast(*btnVars\event_OnClick, *obj)
                 EndIf
               EndIf
            EndIf
      EndSelect
   ForEver
EndProcedure

; -[ END INCLUDE ]-



; --------------------------------------------------------------------------------------------
; -[ PROGRAM ]--------------------------------------------------------------------------------
; --------------------------------------------------------------------------------------------

Procedure Btn_Click(*this.Button)
  UseClassVars(Button)
  *vars\_data + 1
  *this\setText("CLICKED: "+Str(*vars\_data))
EndProcedure


win1.Window = New(Window)
win1\Open(0,0,640,480,"test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
win1\Move(100,100)
win1\setTitle("My Window")

btn1.Button = New(Button)
btn1\Open(10,10,100,25,"Button 1")
btn1\OnClick( @Btn_Click() )

btn2.Button = New(Button)
btn2\Open(10,40,100,25,"Button 2")
btn2\OnClick( @Btn_Click() )

DoEvents()

Delete(win1)
Delete(btn1)
Delete(btn2)

; IDE Options = PureBasic 4.20 (Windows - x86)
; CursorPosition = 1
; Folding = ---
; EnableXP

War gerade mal dabei etwas mit Macros zu spielen.

Leider scheint es keine "CompilerVariablen" oder Konstanten zu geben, die
man mit einem "undefine" wieder löschen kann, um sie dann erneut verwenden
zu können.

Hat da jemand eine Idee, wie man sich einen Namen von einem Macro
zum nächsten merken kann, der aber veränderlich sein muss?

Zum Beispiel das man sich beim Macro 'Class(Button)' den Namen "Button"
bis zum 'EndClass' intern merken kann, und dann in 'ClassData( Button )' etc.
das "Button" weglassen könnte.
Mit Konstanten funktioniert es ja nicht, da dann beim Aufruf mit einem anderen
Namen ( 'Class(Window)' ) ein Fehler kommen würde.

Jemand eine Idee zum merken von Namen zwischen Macros?