PureBoard
http://forums.purebasic.com/german/

Modul BaseClass (Modul als Objekt)
http://forums.purebasic.com/german/viewtopic.php?f=8&t=29343
Seite 6 von 6

Autor:  mk-soft [ 07.04.2019 14:10 ]
Betreff des Beitrags:  Re: Modul BaseClass (Modul als Objekt)

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.

Autor:  mk-soft [ 01.05.2019 19:52 ]
Betreff des Beitrags:  Re: Modul BaseClass (Modul als Objekt)

Update v1.12
- Change CheckInterface

Jetzt eine besser Auswertung im Debugger Modus.

Neues Beispiel ButtonColorGadget mit eingebauten Fehler
Code:
;-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

Autor:  mk-soft [ 03.05.2019 17:27 ]
Betreff des Beitrags:  Re: Modul BaseClass (Modul als Objekt)

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

Autor:  mk-soft [ 11.05.2019 15:54 ]
Betreff des Beitrags:  Re: Modul BaseClass (Modul als Objekt)

Update

Beschreibung aktualisiert :wink:
Link viewtopic.php?f=8&t=29343

Seite 6 von 6 Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/