Modul BaseClass (Modul als Objekt)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt)

Beitrag von mk-soft »

Update v1.10
- Geändert ClassName Management

Der Module name ist nicht mehr der interne Klassen name. Somit wird bei Vererbung jetzt der interface name angegeben, und nicht mehr der Module name.
Ist somit logischer.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt)

Beitrag von mk-soft »

Update v1.12
- Change CheckInterface

Jetzt eine besser Auswertung im Debugger Modus.

Neues Beispiel ButtonColorGadget mit eingebauten Fehler

Code: Alles auswählen

;-TOP
; Comment : Object ButtonColorGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.04
; Create  : 01.05.2019

; OS      : All

; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305
IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

; *****************************************************************************

DeclareModule ButtonColorGadget
  
  UseModule BaseClass
  
  Interface iButtonColorGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    SetText(Text.s)
    SetFont(FontID)
    SetColor(ColorType, Color)
    GetID()
    GetText.s()
    GetColor(ColorType)
  EndInterface
  
  UnuseModule BaseClass
  
  Declare Create(Gadget, x, y, Width, Height, Text.s, FrontColor, BackColor, Flags = 0)
  
EndDeclareModule

Module ButtonColorGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iButtonColorGadget)
  
  Structure sButtonColorGadget Extends sBaseClass
    Gadget.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    FrontColor.i
    BackColor.i
    Flags.i
    ; Data
    Image.i
    FontID.i
    LineColor.i
  EndStructure
  
  ; ----
  
  Procedure DrawButton(*this.sButtonColorGadget)
    With *this
      If ImageWidth(\Image) <> \Width Or ImageHeight(\Image) <> \Height
        FreeImage(\Image)
        \Image = CreateImage(#PB_Any, \Width, \Height, 32)
      EndIf
      If StartDrawing(ImageOutput(\Image))
        Box(0, 0, \Width, \Height, \LineColor)
        Box(1, 1, \Width - 2 , \Height - 2, \BackColor)
        DrawingFont(\FontID)
        DrawText(\Width / 2 - TextWidth(\Text) /2, \Height / 2 - TextHeight(\Text) / 2, \Text, \FrontColor, \BackColor)
        StopDrawing()
        SetGadgetAttribute(\Gadget, #PB_Button_Image, ImageID(\Image))
      EndIf  
    EndWith
    
  EndProcedure
  
  ; ----
  
  Procedure SetText(*this.sButtonColorGadget, Text.s)
    With *this
      \Text = Text
      DrawButton(*this)
    EndWith
  EndProcedure : AsMethode(SetText)
  
  ; ----
  
  Procedure SetFont(*this.sButtonColorGadget, FontID)
    With *this
      \FontID = FontID 
      DrawButton(*this)
    EndWith
  EndProcedure : AsMethode(SetFont)
  
  ; ----
  
  Procedure SetColor(*this.sButtonColorGadget, ColorType, Color)
    With *this
      Select ColorType
        Case #PB_Gadget_FrontColor
          \FrontColor = Color
        Case #PB_Gadget_BackColor
          \BackColor = Color
        Case #PB_Gadget_LineColor
          \LineColor = Color
      EndSelect
      DrawButton(*this)
    EndWith
  EndProcedure : AsMethode(SetColor)
  
  ; ----
  
  Procedure Resize(*this.sButtonColorGadget, x, y, Width, Height)
    With *this
      ResizeGadget(\Gadget, x, y, Width, Height)
      If x <> #PB_Ignore
        \x = x
      EndIf
      If y <> #PB_Ignore
        \y = y
      EndIf
      If Width <> #PB_Ignore
        \Width = Width
      EndIf
      If Height <> #PB_Ignore
        \Height = Height
      EndIf
      DrawButton(*this)
    EndWith
  EndProcedure : AsMethode(Resize)
  
  ; ----
  
  Procedure GetID(*this.sButtonColorGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
  
  ; ----
  
  Procedure.s GetText(*this.sButtonColorGadget)
    ProcedureReturn *this\Text
  EndProcedure : AsMethode(GetText)
  
  ; ----
  
  Procedure GetColor(*this.sButtonColorGadget, ColorType)
    Protected color
    With *this
      Select ColorType
        Case #PB_Gadget_FrontColor
          color = \FrontColor
        Case #PB_Gadget_BackColor
          color = \BackColor
        Case #PB_Gadget_LineColor
          color = \LineColor
      EndSelect
      ProcedureReturn color
    EndWith
  EndProcedure ; : AsMethode(GetColor)
  
  ; ----
  
  Procedure Initialize(*this.sButtonColorGadget)
    Protected result
    
    With *this
      result = ButtonImageGadget(\Gadget, \x, \y, \Width, \Height, 0, \Flags)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \FontID = #PB_Default
        \LineColor = #Gray
        \Image = CreateImage(#PB_Any, \Width, \Height, 32, #Gray)
        DrawButton(*this)
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sButtonColorGadget)
    With *this
      If \Image
        FreeImage(\Image)
      EndIf
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor, BackColor, Flags = 0)
    Protected *object.sButtonColorGadget
    
    With *object
      AllocateObject(*object, sButtonColorGadget)
      If *object
        \Gadget = Gadget
        \x = x
        \y = y
        \Width = Width
        \Height = Height
        \Text = Text
        \FrontColor = FrontColor
        \BackColor = BackColor
        \Flags = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
  
  ; ----
  
  CheckInterface()
  
EndModule

; *****************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #Button
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration

  LoadFont(0, "Courier New", 20, #PB_Font_Bold)
  
  Procedure Main()
    ; Define button object
    Protected btn.ButtonColorGadget::iButtonColorGadget
    Protected btnID
      
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object ButtonColorGadget Number 42 ;)" , #PB_Window_SystemMenu)
      btn = ButtonColorGadget::Create(#Button, 10, 10, 120, 30, "My Button", #Yellow, #Red)
      
      btnID = btn\GetID()
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button
                If GadgetWidth(#Button) <= 120
                  btn\Resize(#PB_Ignore, #PB_Ignore, 240, 60)
                  btn\SetText("My Big Button")
                  btn\SetFont(FontID(0))
                  btn\SetColor(#PB_Gadget_BackColor, #Green)
                  btn\SetColor(#PB_Gadget_FrontColor, #Black)
                  btn\SetColor(#PB_Gadget_LineColor, #Red)
                Else
                  btn\Resize(#PB_Ignore, #PB_Ignore, 120, 30)
                  btn\SetText("My Button")
                  btn\SetFont(#PB_Default)
                  btn\SetColor(#PB_Gadget_BackColor, #Red)
                  btn\SetColor(#PB_Gadget_FrontColor, #Yellow)
                  btn\SetColor(#PB_Gadget_LineColor, #Gray)
                EndIf
            EndSelect
            
        EndSelect
      ForEver
      
      btn\Release()
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf
[/size]
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt)

Beitrag von mk-soft »

Update v1.13
- CheckInterface optimiert

Habe mal die Debugger Funktion CheckInterface in eine Procedure gekapselt und optimiert.

Diese wir nur mit eingeschalteten debugger im Programm eingebunden und sollte immer am ende des Modules aufgerufen werden um Fehler beim zuweisen der Methoden für das Interface zu vermeiden.


P.S. Update alle Beispiele
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt)

Beitrag von mk-soft »

Update

Beschreibung aktualisiert :wink:
Link viewtopic.php?f=8&t=29343
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten