It is currently Wed Feb 26, 2020 11:05 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 24 posts ]  Go to page Previous  1, 2
Author Message
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Thu Jan 09, 2020 6:02 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
Module BaseClassSmall

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.

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sun Jan 12, 2020 4:04 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
ClockGadget Update v1.04
- Optimize DoTimerEvent

NumberGadget Update v1.02
- Added DoTimerEvent for cursor
- New cursor and edit functions

:wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sun Jan 12, 2020 5:09 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3206
Location: Boston, MA
Nice 8)
Add this to the textbox example: TextBox\SetFont(FontID(0))

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sun Jan 12, 2020 5:43 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
TextBoxGadget Update v1.05.1
- Added check TextBox\SetFont(0)
- Update example

Thanks Skywalk :wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sat Jan 18, 2020 3:31 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
SwitchGadget Update v1.05.1
Code:
;-TOP
; Comment : Object SwitchGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.05.1
; Create  : 01.05.2019
; Update  : 18.01.2020
; OS      : All

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

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

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

;- Module Public

DeclareModule SwitchGadget
 
  UseModule BaseClass
 
  Interface iSwitchGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetState(State)
    GetState()
    SetUserData(UserData)
    GetUserData()
  EndInterface
 
  UnuseModule BaseClass
 
  Declare Create(Gadget, x, y, Width, Height, FrontColor = #PB_Default, LineColor = #PB_Default, Flags = 0)
 
EndDeclareModule

;- Module Private

Module SwitchGadget
 
  EnableExplicit
 
  UseModule BaseClass
 
  NewClass(iSwitchGadget)
 
  Structure sSwitchGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    LineColor.i
    FrontColor.i
    BackColor.i
    Flags.i
    ; Data
    Redraw.i
    Event.i
    State.i
  EndStructure
 
  Declare DrawGadget(*this)
 
  ;-- Public Object Function
 
  Procedure Resize(*this.sSwitchGadget, x, y, Width, Height)
    With *this
      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
      ResizeGadget(\Gadget, \x, \y, \Width, \Height)
    EndWith
  EndProcedure : AsMethode(Resize)
 
  ; ----
 
  Procedure Redraw(*this.sSwitchGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
 
  ; ----
 
  Procedure GetID(*this.sSwitchGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
 
  ; ----
 
  Procedure SetColor(*this.sSwitchGadget, 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
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetColor)
 
  Procedure GetColor(*this.sSwitchGadget, 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 SetState(*this.sSwitchGadget, State)
    With *this
      \State = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetState)
 
  Procedure GetState(*this.sSwitchGadget)
    With *this
      ProcedureReturn \State
    EndWith
  EndProcedure : AsMethode(GetState)
 
  ; ----
 
  Procedure SetUserData(*this.sSwitchGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
 
  Procedure GetUserData(*this.sSwitchGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
 
  ;-- Drawing and Events Functions
 
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    Procedure NSColorByNameToRGB(NSColorName.s)
      Protected.cgfloat red, green, blue
      Protected nscolorspace, rgb
      nscolorspace = CocoaMessage(0, CocoaMessage(0, 0, "NSColor " + NSColorName), "colorUsingColorSpaceName:$", @"NSCalibratedRGBColorSpace")
      If nscolorspace
        CocoaMessage(@red, nscolorspace, "redComponent")
        CocoaMessage(@green, nscolorspace, "greenComponent")
        CocoaMessage(@blue, nscolorspace, "blueComponent")
        rgb = RGB(red * 255.0, green * 255.0, blue * 255.0)
        ProcedureReturn rgb
      EndIf
    EndProcedure
  CompilerEndIf
 
  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 GetSystemColor(Type)
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        Select Type
          Case #PB_Gadget_FrontColor
            ProcedureReturn GetSysColor_(#COLOR_WINDOWTEXT)
          Case #PB_Gadget_BackColor
            ProcedureReturn GetSysColor_(#COLOR_3DFACE)
          Case #PB_Gadget_LineColor
            ProcedureReturn #Gray
        EndSelect
      CompilerCase #PB_OS_Linux
        Select Type
          Case #PB_Gadget_FrontColor
            ProcedureReturn #Black
          Case #PB_Gadget_BackColor
            ProcedureReturn $F8F8F8
          Case #PB_Gadget_LineColor
            ProcedureReturn #Gray
        EndSelect
      CompilerCase #PB_OS_MacOS
        Select Type
          Case #PB_Gadget_FrontColor
            ProcedureReturn NSColorByNameToRGB("controlTextColor")
          Case #PB_Gadget_BackColor
            ProcedureReturn BlendColor(NSColorByNameToRGB("controlBackgroundColor"), #White, 85)
          Case #PB_Gadget_LineColor
            ProcedureReturn #Gray
        EndSelect
    CompilerEndSelect
  EndProcedure
 
  ; ----
 
  Procedure DrawGadget(*this.sSwitchGadget)
    Protected x, y, dx, dy, radius
    Protected LineColor, FrontColor, BackColor
   
    With *this
      Select \Event
        Case #PB_EventType_LeftButtonUp
          If \State
            \State = #False
          Else
            \State = #True
          EndIf
          \Event = 0
          PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change, \State)
        EndSelect
       
      If StartDrawing(CanvasOutput(\Gadget))
       
        LineColor  = \LineColor
        FrontColor = \FrontColor
        BackColor  = \BackColor
       
        If FrontColor = #PB_Default
          FrontColor = $FF4040
        EndIf
        If LineColor = #PB_Default
          LineColor = #Gray
        EndIf
       
        dx = DesktopScaledX(\Width)
        dy = DesktopScaledY(\Height)
       
        ; Hintergrund
        Box(0, 0, dx, dy, BackColor)
       
        ; Schalter
        If dx > dy
          If dy & 1 = 0
            dy - 1
          EndIf
          ; Draw Border
          If \Flags = #PB_Canvas_Border
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(0, 0, dx, dy, #Gray)
            x = 2
            y = 2
            dx - 4
            dy - 4
          EndIf
          radius = (dy - 2) / 2
          If Not \State
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(LineColor)
            BackColor(BlendColor(LineColor, #White, 35))
            CircularGradient(x + radius + 1 + 1, y + radius + 1, radius)
            Circle(x + radius + 1, x + radius + 1, radius)
          Else
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(FrontColor)
            BackColor(BlendColor(FrontColor, #White, 35))
            CircularGradient(x + dx - radius - 2 + 1, y + radius + 1, radius)
            Circle(x + dx - radius - 2, y + radius + 1, radius)
          EndIf
        Else
          If dx & 1 = 0
            dx - 1
          EndIf
          ; Draw Border
          If \Flags = #PB_Canvas_Border
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(0, 0, dx, dy, #Gray)
            x = 2
            y = 2
            dx - 4
            dy - 4
          EndIf
          radius = (dx - 2) / 2
          If Not \State
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(LineColor)
            BackColor(BlendColor(LineColor, #White, 35))
            CircularGradient(x + radius + 1, y + dy - radius - 2 - 1, radius)
            Circle(x + radius + 1, y + dy - radius - 2, radius)
          Else
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(FrontColor)
            BackColor(BlendColor(FrontColor, #White, 35))
            CircularGradient(x + radius + 1, y + radius + 1 - 1, radius)
            Circle(x + radius + 1, y + radius + 1, radius)
          EndIf
        EndIf
       
        StopDrawing()
       
      EndIf
    EndWith
   
  EndProcedure
 
  ; ----
 
  Procedure DoEvents()
    Protected *this.sSwitchGadget = GetGadgetData(EventGadget())
    Protected event, update
   
    With *this
      If *this
        event = EventType()
        Select event
          Case #PB_EventType_MouseEnter
          Case #PB_EventType_MouseLeave
          Case #PB_EventType_MouseMove
          Case #PB_EventType_MouseWheel
          Case #PB_EventType_LeftButtonDown : update = #True
          Case #PB_EventType_LeftButtonUp : update = #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 : update = #True
            \x = GadgetX(\Gadget)
            \y = GadgetY(\Gadget)
            \Width = GadgetWidth(\Gadget)
            \Height = GadgetHeight(\Gadget)
        EndSelect
        If update
          \Event = event
          DrawGadget(*this)
        EndIf
      EndIf
    EndWith
  EndProcedure
 
  ;-- Object Functions
 
  Procedure Initialize(*this.sSwitchGadget)
    Protected result
   
    With *this
      result = CanvasGadget(\Gadget, \x, \y, \Width, \Height)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \Redraw = #True
        \Event = #Null
        \BackColor = GetSystemColor(#PB_Gadget_BackColor)
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
 
  ; ----
 
  Procedure Dispose(*this.sSwitchGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
 
  ; ----
 
  Procedure Create(Gadget, x, y, Width, Height, FrontColor = #PB_Default, LineColor = #PB_Default, Flags = 0)
    Protected *object.sSwitchGadget
   
    With *object
      AllocateObject(*object, sSwitchGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \FrontColor = FrontColor
        \LineColor  = LineColor
        \Flags      = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
 
  ; ----
 
  CheckInterface()
 
EndModule

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

;- Example

CompilerIf #PB_Compiler_IsMainFile
 
  Enumeration Windows
    #Main
  EndEnumeration
 
  Enumeration Gadgets 10
    #Button10
    #Button11
    #Button12
  EndEnumeration
 
  Enumeration Status
    #MainStatusBar
  EndEnumeration
 
  Procedure Main()
    Protected.SwitchGadget::iSwitchGadget btn10, btn11, btn12
    Protected i, state, color
   
    Dim btn.SwitchGadget::iSwitchGadget(9)
   
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object SwitchGadget Number 42 ;)", #PB_Window_SystemMenu)
     
      FrameGadget(#PB_Any, 5, 5, 470, 75, "Switches")
      TextGadget(#PB_Any, 15, 25, 35, 20, "On")
      TextGadget(#PB_Any, 15, 50, 35, 20, "Off")
     
      For i = 0 To 9
        btn(i) = SwitchGadget::Create(i, i * 30 + 50, 25, 24, 40, #Blue, #Gray, #PB_Canvas_Border)
      Next
     
      TextGadget(#PB_Any, 10, 94, 120, 20, "FrontColor Green")
      TextGadget(#PB_Any, 10, 129, 120, 20, "LineColor Red")
      btn10 = SwitchGadget::Create(#Button10, 140, 95, 40, 20)
      btn11 = SwitchGadget::Create(#Button11, 140, 125, 40, 20)
     
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case 0 To 9
               
              Case #Button10
                If EventType() = #PB_EventType_Change
                  If btn10\GetState()
                    color = $008D00 ; #Green
                  Else
                    color = #PB_Default
                  EndIf
                  For i = 0 To 9
                    btn(i)\SetColor(#PB_Gadget_FrontColor, color)
                  Next
                EndIf
               
              Case #Button11
                If EventType() = #PB_EventType_Change
                  If EventData() ; State
                    color = #Red
                  Else
                    color = #Gray
                  EndIf
                  For i = 0 To 9
                    btn(i)\SetColor(#PB_Gadget_LineColor, Color)
                  Next
                EndIf
               
            EndSelect
           
        EndSelect
      ForEver
     
      For i = 0 To 9
        btn(i)\Release()
      Next
     
    EndIf
   
  EndProcedure : Main()
 
CompilerEndIf

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sat Jan 18, 2020 10:20 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sat Jan 18, 2020 8:24 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
SwitchGadget Update v1.05
- Border owner draw

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Sat Feb 22, 2020 3:16 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
NumberGadget Update v1.03.1
- Bugfix
- Added event left double click

:wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Tue Feb 25, 2020 8:35 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
GaugeGadget Update v1.01.3
- Bugfix free image
- Bugfix text position
Code:
;-TOP
; Comment : Object GaugeGadget No 42 ;)
; Author  : mk-soft
; Version : v1.01.3
; Create  : 23.02.2020
; Update  : 25.02.2020
; OS      : All

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

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

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

;- Global

Enumeration
  #GaugeValue
  #GaugeValue_Min
  #GaugeValue_Max
  #GaugeValue_Range_Min
  #GaugeValue_Range_Max
  #GaugeValue_Step
  #GaugeValue_Decimals
EndEnumeration

Enumeration
  #GaugeColor_Background
  #GaugeColor_Border
  #GaugeColor_Text
  #GaugeColor_Center
  #GaugeColor_Pointer
  #GaugeColor_Scala
  #GaugeColor_Range_Min
  #GaugeColor_Range_Middle
  #GaugeColor_Range_Max
EndEnumeration

;- Module Public

DeclareModule GaugeGadget
 
  UseModule BaseClass
 
  Enumeration
    #GaugeValue
    #GaugeValue_Min
    #GaugeValue_Max
    #GaugeValue_Range_Min
    #GaugeValue_Range_Max
    #GaugeValue_Step
    #GaugeValue_Decimals
  EndEnumeration
 
  Enumeration
    #GaugeColor_Background
    #GaugeColor_Border
    #GaugeColor_Text
    #GaugeColor_Center
    #GaugeColor_Pointer
    #GaugeColor_Scala
    #GaugeColor_Range_Min
    #GaugeColor_Range_Middle
    #GaugeColor_Range_Max
  EndEnumeration
 
  Interface iGaugeGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetValue(Type, Value.f)
    GetValue.f(Type)
    SetText(Text.s)
    GetText.s()
    SetFont(FontID)
    GetFont()
    SetUserData(UserData)
    GetUserData()
  EndInterface
 
  UnuseModule BaseClass
 
  Declare Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
 
EndDeclareModule

;- Module Private

Module GaugeGadget
 
  EnableExplicit
 
  UseModule BaseClass
 
  NewClass(iGaugeGadget)
 
  Structure sGaugeGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    Flags.i
    ; Data
    BackColor.i
    BorderColor.i
    BorderSize.i
    ;
    Color_Text.i
    Color_Center.i
    Color_Pointer.i
    Color_Scala.i
    Color_Range_Min.i
    Color_Range_Middle.i
    Color_Range_Max.i
    ;
    Value.f
    Value_Min.f
    Value_Max.f
    Value_Range_Min.f
    Value_Range_Max.f
    Value_Step.f
    Value_Decimals.f
    ;
    FontID.i
    Image.i
    Renew.i
    ;
    Redraw.i
    Event.i
  EndStructure
 
  Global DefaultFont = LoadFont(#PB_Any, "", 11)
 
  Declare DrawGadget(*this)
 
  ;-- Public Object Function
 
  Procedure Resize(*this.sGaugeGadget, x, y, Width, Height)
    With *this
      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
      ResizeGadget(\Gadget, \x, \y, \Width, \Height)
    EndWith
  EndProcedure : AsMethode(Resize)
 
  ; ----
 
  Procedure Redraw(*this.sGaugeGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
 
  ; ----
 
  Procedure GetID(*this.sGaugeGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
 
  ; ----
 
  Procedure SetColor(*this.sGaugeGadget, ColorType, Color)
    With *this
      \Renew = #True
      Select ColorType
        Case #GaugeColor_Background
          \BackColor = Color | $FF000000
        Case #GaugeColor_Border
          \BorderColor = Color | $FF000000
        Case #GaugeColor_Text
          \Color_Text = Color | $FF000000
        Case #GaugeColor_Center
          \Color_Center = Color | $FF000000
        Case #GaugeColor_Pointer
          \Color_Pointer = Color | $FF000000
        Case #GaugeColor_Scala
          \Color_Scala = Color | $FF000000
        Case #GaugeColor_Range_Min
          \Color_Range_Min = Color | $FF000000
        Case #GaugeColor_Range_Middle
          \Color_Range_Middle = Color | $FF000000
        Case #GaugeColor_Range_Max
          \Color_Range_Max = Color | $FF000000
      EndSelect
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetColor)
 
  Procedure GetColor(*this.sGaugeGadget, ColorType)
    Protected color
    With *this
      Select ColorType
        Case #GaugeColor_Background
          ProcedureReturn \BackColor
        Case #GaugeColor_Border
          ProcedureReturn \BorderColor
        Case #GaugeColor_Text
          ProcedureReturn \Color_Text
        Case #GaugeColor_Center
          ProcedureReturn \Color_Center
        Case #GaugeColor_Pointer
          ProcedureReturn \Color_Pointer
        Case #GaugeColor_Scala
          ProcedureReturn \Color_Scala
        Case #GaugeColor_Range_Min
          ProcedureReturn \Color_Range_Min
        Case #GaugeColor_Range_Middle
          ProcedureReturn \Color_Range_Middle
        Case #GaugeColor_Range_Max
          ProcedureReturn \Color_Range_Max
      EndSelect
      ProcedureReturn 0
    EndWith
  EndProcedure : AsMethode(GetColor)
 
  ; ----
 
  Procedure SetValue(*this.sGaugeGadget, Type, Value.f)
    With *this
      \Renew = #True
      Select Type
        Case #GaugeValue
          \Value = Value
          \Renew = #False
        Case #GaugeValue_Min
          \Value_Min = Value
        Case #GaugeValue_Max
          \Value_Max  = Value
        Case #GaugeValue_Range_Min
          \Value_Range_Min = Value
        Case #GaugeValue_Range_Max
          \Value_Range_Max = Value
        Case #GaugeValue_Step
          \Value_Step = Value
        Case #GaugeValue_Decimals
          \Value_Decimals = Value
      EndSelect
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetValue)
 
  Procedure.f GetValue(*this.sGaugeGadget, Type)
    Protected r1.f
    With *this
      Select Type
        Case #GaugeValue
          r1 = \Value
        Case #GaugeValue_Min
          r1 = \Value_Min
        Case #GaugeValue_Max
          r1 = \Value_Max
        Case #GaugeValue_Range_Min
          r1 = \Value_Range_Min
        Case #GaugeValue_Range_Max
          r1 = \Value_Range_Max
        Case #GaugeValue_Step
          r1 = \Value_Step
        Case #GaugeValue_Decimals
          r1 = \Value_Decimals
      EndSelect
    EndWith
    ProcedureReturn r1
  EndProcedure : AsMethode(GetValue)
 
  ; ----
 
  Procedure SetText(*this.sGaugeGadget, Text.s)
    With *this
      \Text = Text
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetText)
 
  Procedure.s GetText(*this.sGaugeGadget)
    With *this
      ProcedureReturn \Text
    EndWith
  EndProcedure : AsMethode(GetText)
 
  ; ----
 
  Procedure SetFont(*this.sGaugeGadget, FontID)
    With *this
      \Renew = #True
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetFont)
 
  Procedure GetFont(*this.sGaugeGadget)
    With *this
      ProcedureReturn \FontID
    EndWith
  EndProcedure : AsMethode(GetFont)
 
  ; ----
 
  Procedure SetUserData(*this.sGaugeGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
 
  Procedure GetUserData(*this.sGaugeGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
 
  ;-- Drawing and Events Functions
 
  Procedure DrawGadget(*this.sGaugeGadget)
    Protected.d x, y, dx, dy, center_x, center_y, delta_xy, delta, x1, x2, strokewidth, fontsize
    Protected.d range, angle0, angle1, angle2, steps
    Protected text.s, FontID
   
    With *this
     
      ; Grundwerte
      dx = DesktopScaledX(\Width)
      dy = DesktopScaledY(\Height)
     
      center_x = dx * 0.5
      center_y = dy * 0.5
     
      If dy > dx
        delta_xy = dx * 0.5
      Else
        delta_xy = dy * 0.5
      EndIf
     
      range = \Value_Max - \Value_Min
     
      If \Renew
        \Renew = #False
        ; Altes Image löschen
        If \Image
          FreeImage(\Image)
        EndIf
        ; Neues Image anlegen
        \Image = CreateImage(#PB_Any, dx, dy)
        If Not \Image
          ProcedureReturn 0
        EndIf
        ; Image neu zeichnen
        If StartVectorDrawing(ImageVectorOutput(\Image))
          ; Schrift auswählen
          If \FontID = #PB_Default
            FontID = FontID(DefaultFont)
          Else
            FontID = \FontID
          EndIf
          ; Hintergrund
          AddPathBox(0.0, 0.0, dx, dy)
          VectorSourceColor(\BackColor)
          FillPath()
          ; Rahmen
          AddPathBox(0.0, 0.0, dx, dy)
          VectorSourceColor(\BorderColor)
          StrokePath(\BorderSize)
          ; Text
          fontsize = delta_xy * 0.15
          VectorFont(FontID, fontsize)
          VectorSourceColor(\Color_Text)
          x = center_x - VectorTextWidth(\Text) / 2
          y = center_y + delta_xy * 0.75 - VectorTextHeight(\Text) / 2
          MovePathCursor(x, y)
          DrawVectorText(\Text)
         
          delta = delta_xy * 0.85
          strokewidth = delta_xy * 0.15 + 0.5
          RotateCoordinates(center_x, center_y, 120.0)
         
          ; Range Min
          angle1 = 0.0
          angle2 = (\Value_Range_Min - \Value_Min) / range * 300.0
          AddPathCircle(center_x, center_y, delta, angle1, angle2)
          VectorSourceColor(\Color_Range_Min)
          StrokePath(strokewidth)
         
          ; Range Middle
          angle1 = angle2
          angle2 = (\Value_Range_Max - \Value_Min) / range * 300.0
          AddPathCircle(center_x, center_y, delta, angle1, angle2)
          VectorSourceColor(\Color_Range_Middle)
          StrokePath(strokewidth)
         
          ; Range Max
          angle1 = angle2
          angle2 = 300.0
          AddPathCircle(center_x, center_y, delta, angle1, angle2)
          VectorSourceColor(\Color_Range_Max)
          StrokePath(strokewidth)
         
          ; Teile 0.5
          delta = delta_xy * 0.85
          strokewidth = delta_xy * 0.15 + 0.5
         
          ResetCoordinates()
          RotateCoordinates(center_x, center_y, 120.0)
         
          angle1 = 0.0
          steps = \Value_Step / range * 150.0
          While angle1 < 300.01
            AddPathCircle(center_x, center_y, delta, angle1 - 0.2, angle1 + 0.2)
            angle1 + steps
          Wend
         
          VectorSourceColor(\Color_Scala)
          StrokePath(strokewidth)
         
          ; Teile 1.0
          delta = delta_xy * 0.80
          strokewidth = delta_xy * 0.15 + 0.5
         
          ResetCoordinates()
          RotateCoordinates(center_x, center_y, 120.0)
         
          angle1 = 0.0
          steps = \Value_Step / range * 300.0
          While angle1 < 300.01
            AddPathCircle(center_x, center_y, delta, angle1 - 0.2, angle1 + 0.20)
            angle1 + steps
          Wend
         
          VectorSourceColor(\Color_Scala)
          StrokePath(strokewidth)
         
          ; Zahlen
          delta = delta_xy * 0.60
          fontsize = delta_xy * 0.12
          ResetCoordinates()
          VectorFont(FontID, fontsize)
          VectorSourceColor(\Color_Text)
         
          angle1 = 0.0
          steps = \Value_Step / range * 300.0
          While angle1 < 300.01
            text = StrF(range * angle1 / 300.0 + \Value_Min, \Value_Decimals)
            angle0 = Radian(angle1 + 120.0)
            x = Cos(angle0) * delta - VectorTextWidth(text) / 2.0
            y = Sin(angle0) * delta - VectorTextHeight(text) / 2.0
            MovePathCursor(center_x + x, center_y + y)
            DrawVectorText(text)
            angle1 + steps
          Wend
         
          StopVectorDrawing()
        EndIf
      EndIf
     
      If StartVectorDrawing(CanvasVectorOutput(\Gadget))
        ; Hintergrund
        DrawVectorImage(ImageID(\Image))
        ; Zeiger Aussen
        angle1 = (\Value - \Value_Min) / range * 300 + 30.0
        x = delta_xy * 0.04
        y = delta_xy * 0.60
        strokewidth = delta_xy * 0.01 + 0.5
        ResetCoordinates()
        RotateCoordinates(center_x, center_y, angle1)
        MovePathCursor(center_x - x, center_y)
        AddPathLine(center_x, center_y + y)
        AddPathLine(center_x + x, center_y)
        VectorSourceColor(\Color_Center)
        StrokePath(strokewidth, #PB_Path_RoundEnd)
        ; Zeiger Innen
        delta = delta_xy * 0.7
        strokewidth = delta_xy * 0.015 + 0.5
        MovePathCursor(center_x, center_y)
        AddPathLine(center_x, center_y + delta)
        VectorSourceColor(\Color_Pointer)
        StrokePath(strokewidth, #PB_Path_RoundEnd)
        ; Zeiger Mitte
        ResetCoordinates()
        delta = delta_xy * 0.06
        AddPathCircle(center_x, center_y, delta)
        VectorSourceColor(\Color_Center)
        FillPath()
        delta = delta_xy * 0.03
        AddPathCircle(center_x, center_y, delta)
        VectorSourceColor(\BackColor)
        FillPath()
       
        StopVectorDrawing()
      EndIf 
    EndWith
   
  EndProcedure
 
  ; ----
 
  Procedure DoEvents()
    Protected *this.sGaugeGadget = GetGadgetData(EventGadget())
    Protected event, update
   
    With *this
      If *this
        event = EventType()
        Select event
          Case #PB_EventType_Resize : update = #True
            \x = GadgetX(\Gadget)
            \y = GadgetY(\Gadget)
            \Width = GadgetWidth(\Gadget)
            \Height = GadgetHeight(\Gadget)
            \Renew = #True
        EndSelect
        If update
          \Event = event
          DrawGadget(*this)
        EndIf
      EndIf
    EndWith
  EndProcedure
 
  ;-- Object Functions
 
  Procedure Initialize(*this.sGaugeGadget)
    Protected result
   
    With *this
      result = CanvasGadget(\Gadget, \x, \y, \Width, \Height, \Flags)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \Redraw = #True
        \Event = #Null
       
        \BackColor = $FFD3D3D3
        \BorderColor = $FF000000
        \BorderSize = 2
        \Color_Text = $FF000000
        \Color_Center = $FF000000
        \Color_Pointer = $FF0000FF
        \Color_Scala = $FF000000
        \Color_Range_Min = $FF00D7FF
        \Color_Range_Middle = $FFFF901E
        \Color_Range_Max = $FF0045FF
       
        \Value = 0.0
        \Value_Min = 0.0
        \Value_Max = 100.0
        \Value_Range_Min = 0.0
        \Value_Range_Max = 100.0
        \Value_Step = 10.0
        \Value_Decimals = 0.0
       
        \FontID = #PB_Default
        \Image = 0
        \Renew = #True
       
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
 
  ; ----
 
  Procedure Dispose(*this.sGaugeGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
      If IsImage(\Image)
        FreeImage(\Image)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
 
  ; ----
 
  Procedure Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
    Protected *object.sGaugeGadget
   
    With *object
      AllocateObject(*object, sGaugeGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \Text       = Text
        \Flags      = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
 
  ; ----
 
  CheckInterface()
 
EndModule

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

;- Example

CompilerIf #PB_Compiler_IsMainFile
 
  Enumeration Windows
    #Main
  EndEnumeration
 
  Enumeration Gadgets
    #Gauge1
  EndEnumeration
 
  Enumeration Status
    #MainStatusBar
  EndEnumeration
 
  Procedure UpdateWindow()
    ResizeGadget(#Gauge1, 10, 10, WindowWidth(#Main) - 20, WindowHeight(#Main) - 20)
  EndProcedure
 
  Procedure Main()
    ; Define button object
    Protected.GaugeGadget::iGaugeGadget Gauge
    Protected font
    Protected Value.f, Value2.f = 2.0
   
    ;font = LoadFont(0, "Courier New", 11)
    ;font = LoadFont(0, "Tahoma", 11)
    font = LoadFont(0, "Comic Sans MS", 11)
   
    #MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
   
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 400, 400, "Object GaugeGadget No 42 ;)", #MainStyle)
      Gauge = GaugeGadget::Create(#Gauge1, 10, 10, 380, 380, "POWER")
     
      Gauge\Redraw(#False)
     
      Gauge\SetValue(#GaugeValue_Min, -20.0)
      Gauge\SetValue(#GaugeValue_Max, 120.0)
      Gauge\SetValue(#GaugeValue_Range_Min, 0.0)
      Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
     
      If Date() >> 2 & 1
        Gauge\SetColor(#GaugeColor_Background, $1F1F1F)
        Gauge\SetColor(#GaugeColor_Text, $0000EE)
        Gauge\SetColor(#GaugeColor_Center, $FF0000)
        Gauge\SetColor(#GaugeColor_Scala, $696969)
        Gauge\SetColor(#GaugeColor_Range_Min, $00C9EE)
        Gauge\SetColor(#GaugeColor_Range_Middle, $CD7418)
        Gauge\SetColor(#GaugeColor_Range_Max, $2C2CEE)
        Gauge\SetFont(FontID(0))
      EndIf
     
      Gauge\Redraw()
     
      BindEvent(#PB_Event_SizeWindow, @UpdateWindow())
     
      AddWindowTimer(#Main, 1, 100)
     
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Gauge1
                If EventType() = #PB_EventType_LeftClick
                EndIf
            EndSelect
          Case #PB_Event_Timer
            If EventTimer() = 1
              Value + Value2
              If Value >= 110.0
                Value2 = -2.0
              ElseIf Value <= -10
                Value2 = 2.0
              EndIf
              Gauge\SetValue(#GaugeValue, value)
            EndIf
           
        EndSelect
      ForEver
     
      Gauge\Release()
     
    EndIf
   
  EndProcedure : Main()
 
CompilerEndIf

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Tue Feb 25, 2020 10:12 pm, edited 3 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Tue Feb 25, 2020 8:41 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2235
Location: Germany
New gadget added. A simple gauge control. :wink:

The background will only be redrawn when creating and resizing.
This saves about 20% cpu resources of the program.

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 24 posts ]  Go to page Previous  1, 2

All times are UTC + 1 hour


Who is online

Users browsing this forum: idle and 5 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye