PureBasic Forums - English

Posted: **Fri Apr 12, 2019 2:22 pm**

mk-soft wrote:BaseClass extended version
No longer supported.
The only difference was that the method names were saved.
Last edited by mk-soft on Sun Apr 07, 2019 1:41 pm, edited 9 times in total.

Hello mk-soft,
do I understand correctly that there is only the small version left?
I only ask because then I can clean up my code templates and delete the big version.

Regards, Kurzer

Posted: **Fri Apr 12, 2019 6:56 pm**

There shouldn't be any problems.

But it may be that I annoyed you, because now the interface name for ClassExtends is entered when inheriting a class.
This is because now the interface name is used to manage the classes, and no longer the module name.

If you have any problems, please contact us directly as PM.

On my WebSpace is still the small version v1.09, where the module name is used for the internal management.

P.S.
I'm also not sure it was a good idea to change the management from module name to interface name!

Posted: **Wed May 01, 2019 4:36 pm**

Update v1.11
- Change Debug Output CheckInterface

New Example own ButtonColorGadget

Code: Select all

;-TOP
; Comment : Object ButtonColorGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.05
; Create  : 01.05.2019
; Update  : 29.07.2019 (DPI)
; OS      : All

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

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

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

;- Public

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 = $000000, BackColor = $F5F5F5, Flags = 0)
  
EndDeclareModule

;- Private

Module ButtonColorGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iButtonColorGadget)
  
  Structure sButtonColorGadget Extends sBaseClass
    Gadget.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    FontID.i
    LineColor.i
    FrontColor.i
    BackColor.i
    Flags.i
    ; Data
    Redraw.i
    State.i
  EndStructure
  
  ; ----
  
  Procedure.i BlendColor(Color1.i, Color2.i, Scale.i = 50) ; Thanks to Thorsten
    Protected.i R1, G1, B1, R2, G2, B2
    Protected.f Blend = Scale / 100
    R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
    R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
    ProcedureReturn RGB((R1*Blend) + (R2 * (1 - Blend)), (G1*Blend) + (G2 * (1 - Blend)), (B1*Blend) + (B2 * (1 - Blend)))
  EndProcedure
  
  ; ----
  
  Procedure DrawButton(*this.sButtonColorGadget)
    Protected LineColor, FrontColor, BackColor
    Protected Width, Height
    With *this
      Select \State
        Case #Null
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_MouseEnter
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $FFFFFF, 80)
          BackColor  = BlendColor(\BackColor, $FFFFFF, 80)
        Case #PB_EventType_MouseLeave
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_LeftButtonDown
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $000000, 80)
          BackColor  = BlendColor(\BackColor, $000000, 80)
        Case #PB_EventType_LeftButtonUp
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $FFFFFF, 80)
          BackColor  = BlendColor(\BackColor, $FFFFFF, 80)
      EndSelect
      
      Width = DesktopScaledX(\Width)
      Height = DesktopScaledY(\Height)
      If StartDrawing(CanvasOutput(\Gadget))
        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()
      EndIf
    EndWith
    
  EndProcedure
  
  ; ----
  
  Procedure DoEvents()
    Protected *this.sButtonColorGadget = GetGadgetData(EventGadget())
    Protected state, redraw
    
    With *this
      If *this
        state = EventType()
        Select state
          Case #PB_EventType_MouseEnter : redraw = #True
          Case #PB_EventType_MouseLeave : redraw = #True
          Case #PB_EventType_MouseMove
          Case #PB_EventType_MouseWheel
          Case #PB_EventType_LeftButtonDown : redraw = #True
          Case #PB_EventType_LeftButtonUp : redraw = #True
          Case #PB_EventType_LeftClick
          Case #PB_EventType_LeftDoubleClick
          Case #PB_EventType_RightButtonDown
          Case #PB_EventType_RightButtonUp
          Case #PB_EventType_RightClick
          Case #PB_EventType_RightDoubleClick
          Case #PB_EventType_MiddleButtonDown
          Case #PB_EventType_MiddleButtonUp
          Case #PB_EventType_Focus
          Case #PB_EventType_LostFocus
          Case #PB_EventType_KeyDown
          Case #PB_EventType_KeyUp
          Case #PB_EventType_Input
          Case #PB_EventType_Resize
        EndSelect
        If redraw
          \State = state
          DrawButton(*this)
        EndIf
      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 = CanvasGadget(\Gadget, \x, \y, \Width, \Height, \Flags)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \FontID    = #PB_Default
        \LineColor = #Gray
        DrawButton(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sButtonColorGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $F5F5F5, 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
    #Button1
    #Button2
    #Button3
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  LoadFont(0, "Courier New", 20, #PB_Font_Bold)
  
  Procedure Main()
    ; Define button object
    Protected.ButtonColorGadget::iButtonColorGadget btn, btn2, btn3
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object ButtonColorGadget Number 42 ;)", #PB_Window_SystemMenu)
      btn  = ButtonColorGadget::Create(#Button1, 10, 10, 120, 30, "My Button", #Yellow, #Red)
      btn2 = ButtonColorGadget::Create(#Button2, 10, 80, 120, 30, "My Button 2")
      btn3 = ButtonColorGadget::Create(#Button3, 10, 120, 120, 30, "My Button 3")
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button1
                If EventType() = #PB_EventType_LeftClick
                  If GadgetWidth(#Button1) <= 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
                EndIf
            EndSelect
            
        EndSelect
      ForEver
      
      btn\Release()
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

Posted: **Wed May 01, 2019 6:46 pm**

Update v1.12
- Change CheckInterface

Now better debugging information

Posted: **Wed May 01, 2019 6:51 pm**

Wohoo I can't keep up with updating your module files on my hard drive.
As we say in German: It comes stroke on stroke, like baking pretzels.

LOL

Posted: **Fri May 03, 2019 4:26 pm**

Update v1.13
- Optimize CheckInterface

I once encapsulated the debugger function CheckInterface in a procedure and optimized it.

This is only included in the program with the debugger switched on and should always be called at the end of the module to avoid errors when assigning the methods for the interface.

P.S. Update all examples

Posted: **Sun May 05, 2019 2:50 pm**

Description of the module BaseClassSmall

Link: viewtopic.php?f=12&t=64305#p478264

Posted: **Sat May 11, 2019 2:04 pm**

Update descriptions

The smallest module to create an object with Purebasic.

Posted: **Thu Jan 09, 2020 6:07 pm**

Module BaseClass Small

Update v1.14.1
- Change name of Macro 'dq' to '_dq_'
- Update method QueryInterface with default result 'IUnknown'

This adjustment has no effect on the examples and other codes.

Posted: **Sun Feb 02, 2020 9:00 pm**

Thank you for the update, mk-soft.

Kurzer

Posted: **Sat Feb 08, 2020 12:30 pm**

Update v1.15
- Update method QueryInterface with default result for 'IUnknown'

Sorry, I forgot to update my code online

P.S.
Update Example 10 - Overwrite Method QueryInterface

Posted: **Sat Feb 08, 2020 2:41 pm**

Update v1.16
- Update Method QueryInterface with default result for 'IUnknown'
- Optimize code

Posted: **Mon Mar 02, 2020 7:36 pm**

Many thanks for the update mk-soft.

A short question about the examples, because I can't assign all files anymore: Do the 5 examples here in the thread belong exclusively to the current version 1.16?

Since your first release I have archived 13 examples in total. Three of them only work with BaseClass 1.10 or older.

I should tidy this up.

I thought that I keep each BaseClass version separately, but meanwhile I can't assign your old examples to the individual BaseClass versions anymore.

Posted: **Mon Mar 02, 2020 10:21 pm**

@Kurzer

I once updated the files for the BaseClassSmall on my FTP server. Show on my WebSpace
Old and no longer working examples are removed.
The best thing to do is to synchronize with this folder.

P.S. Safari (macOS) cannot open FTP folders anymore.
Try another browser.

Posted: **Tue Mar 03, 2020 8:54 am**

Excellent, thank you very much.

The ZIP archive contains 6 files with a file size of 4096 bytes and a partly binary content (see screenshot).
I think these are special files from your Mac OS and I can delete them.

PureBasic Forums - English

Module BaseClass (Module as Object)

Re: Module BaseClass (OOP)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)

Re: Module BaseClass (Module as Object)