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.
Modul BaseClass (Modul als Objekt)
Re: Modul BaseClass (Modul als Objekt)
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Modul BaseClass (Modul als Objekt)
Update v1.12
- Change CheckInterface
Jetzt eine besser Auswertung im Debugger Modus.
Neues Beispiel ButtonColorGadget mit eingebauten Fehler
[/size]
- 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
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
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
- 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
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Re: Modul BaseClass (Modul als Objekt)
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive