It is currently Fri Jun 05, 2020 9:28 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 25 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: 2487
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: 2487
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: 3275
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: 2487
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: 2487
Location: Germany
SwitchGadget Update v1.06.0
Code:
;-TOP
; Comment : Object SwitchGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.06.0
; 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.f R1, G1, B1, R2, G2, B2
    Protected.f Blend1 = Scale / 100
    Protected.f Blend2 = 1.0 - Blend1
    R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
    R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
    ProcedureReturn RGB(R1*Blend1 + R2 * Blend2, G1*Blend1 + G2 * Blend2, B1*Blend1 + B2 * Blend2)
  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
        Protected UserDefaults, NSString
        Select Type
          Case #PB_Gadget_FrontColor
            ProcedureReturn NSColorByNameToRGB("controlTextColor")
          Case #PB_Gadget_BackColor
            UserDefaults = CocoaMessage(0, 0, "NSUserDefaults standardUserDefaults")
            NSString = CocoaMessage(0, UserDefaults, "stringForKey:$", @"AppleInterfaceStyle")
            If NSString And PeekS(CocoaMessage(0, NSString, "UTF8String"), -1, #PB_UTF8) = "Dark"
              ProcedureReturn BlendColor(NSColorByNameToRGB("controlBackgroundColor"), #White, 85)
            Else
              ProcedureReturn BlendColor(NSColorByNameToRGB("windowBackgroundColor"), #White, 85)
            EndIf 
          Case #PB_Gadget_LineColor
            ProcedureReturn #Gray
        EndSelect
    CompilerEndSelect
  EndProcedure
 
  ; ----
 
  Procedure DrawGadget(*this.sSwitchGadget)
    Protected x, y, dx, dy, radius
    Protected LineColor, FrontColor, BackColor, BlendColor
   
    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 = $FF5050
        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_Default)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, BlendColor(backColor, LineColor, 70))
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Default)
            Circle(x + radius + 1, x + radius + 1, radius, LineColor)
          Else
            DrawingMode(#PB_2DDrawing_Default)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, BlendColor(backColor, FrontColor, 70))
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Default)
            Circle(x + dx - radius - 2, y + radius + 1, radius, FrontColor)
          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_Default)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, BlendColor(BackColor, LineColor, 70))
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Default)
            Circle(x + radius + 1, y + dy - radius - 2, radius, LineColor)
          Else
            DrawingMode(#PB_2DDrawing_Default)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, BlendColor(BackColor, FrontColor, 70))
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Default)
            Circle(x + radius + 1, y + radius + 1, radius, FrontColor)
          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 Feb 29, 2020 12:48 pm, edited 2 times 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: 2487
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: 2487
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: 2487
Location: Germany
GaugeGadget Update v1.02.2
- Fix DesktopScaledXY with negative values
Code:
;-TOP
; Comment : Object GaugeGadget No 42 ;)
; Author  : mk-soft
; Version : v1.02.2
; Create  : 23.02.2020
; Update  : 26.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 Color
    Color_Background.i
    Color_Border.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
    ; Date Values
    Value.f
    Value_Min.f
    Value_Max.f
    Value_Range_Min.f
    Value_Range_Max.f
    Value_Step.f
    Value_Decimals.f
    ; Data
    BorderSize.i
    FontID.i
    Image.i
    Renew.i
    ; System
    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
          \Color_Background = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Border
          \Color_Border = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Text
          \Color_Text = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Center
          \Color_Center = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Pointer
          \Color_Pointer = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Scala
          \Color_Scala = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Range_Min
          \Color_Range_Min = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Range_Middle
          \Color_Range_Middle = Color | $FF000000
          \Renew = #True
        Case #GaugeColor_Range_Max
          \Color_Range_Max = Color | $FF000000
          \Renew = #True
      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 \Color_Background
        Case #GaugeColor_Border
          ProcedureReturn \Color_Border
        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
      Select Type
        Case #GaugeValue
          \Value = Value
        Case #GaugeValue_Min
          \Value_Min = Value
          \Renew = #True
        Case #GaugeValue_Max
          \Value_Max  = Value
          \Renew = #True
        Case #GaugeValue_Range_Min
          \Value_Range_Min = Value
          \Renew = #True
        Case #GaugeValue_Range_Max
          \Value_Range_Max = Value
          \Renew = #True
        Case #GaugeValue_Step
          \Value_Step = Value
          \Renew = #True
        Case #GaugeValue_Decimals
          \Value_Decimals = Value
          \Renew = #True
      EndSelect
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetValue)
 
  Procedure.f GetValue(*this.sGaugeGadget, Type)
    With *this
      Select Type
        Case #GaugeValue
          ProcedureReturn \Value
        Case #GaugeValue_Min
          ProcedureReturn \Value_Min
        Case #GaugeValue_Max
          ProcedureReturn \Value_Max
        Case #GaugeValue_Range_Min
          ProcedureReturn \Value_Range_Min
        Case #GaugeValue_Range_Max
          ProcedureReturn \Value_Range_Max
        Case #GaugeValue_Step
          ProcedureReturn \Value_Step
        Case #GaugeValue_Decimals
          ProcedureReturn \Value_Decimals
      EndSelect
    EndWith
  EndProcedure : AsMethode(GetValue)
 
  ; ----
 
  Procedure SetText(*this.sGaugeGadget, Text.s)
    With *this
      \Text = Text
      \Renew = #True
      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
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      \Renew = #True
      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
      If \Width > 0
        dx = DesktopScaledX(\Width)
      Else
        dx = 1
      EndIf
      If \Height > 0
        dy = DesktopScaledY(\Height)
      Else
        dy = 1
      EndIf
     
      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(\Color_Background)
          FillPath()
          ; Rahmen
          AddPathBox(0.0, 0.0, dx, dy)
          VectorSourceColor(\Color_Border)
          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)
         
          ; Range Defaults
          delta = delta_xy * 0.85
          strokewidth = delta_xy * 0.15
          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
          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.75
          strokewidth = delta_xy * 0.05
          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.2)
            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
        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
        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(\Color_Background)
        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
        ; Default Colors
        \Color_Background = $FFD3D3D3
        \Color_Border = $FF000000
        \Color_Text = $FF000000
        \Color_Center = $FF000000
        \Color_Pointer = $FF0000FF
        \Color_Scala = $FF000000
        \Color_Range_Min = $FF00C0F0
        \Color_Range_Middle = $FFFF9020
        \Color_Range_Max = $FF0040F0
        ; Default Values
        \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
        ; Default Properties
        \BorderSize = 1
        \FontID = #PB_Default
        \Image = 0
        \Renew = #True
        ; Init
        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)
      If Date() >> 2 & 1
        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_Step, 20.0)
        Gauge\SetValue(#GaugeValue_Range_Min, 0.0)
        Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
        Gauge\Redraw()
      Else
        Gauge = GaugeGadget::Create(#Gauge1, 10, 10, 380, 380, "POWER", #PB_Canvas_Border)
        Gauge\Redraw(#False)
        Gauge\SetValue(#GaugeValue_Min, -20.0)
        Gauge\SetValue(#GaugeValue_Max, 120.0)
        Gauge\SetValue(#GaugeValue_Step, 10.0)
        Gauge\SetValue(#GaugeValue_Range_Min, 0.0)
        Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
        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))
        Gauge\Redraw()
      EndIf
     
      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 Sun Mar 29, 2020 11:31 am, edited 6 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: 2487
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  
 Post subject: Re: Own Flat Gadgets as Object
PostPosted: Wed Feb 26, 2020 8:00 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2487
Location: Germany
GaugeGadget Update v1.02.0
- Optimize code

GaugeGadget Update v1.02.1
- Fix DesktopScaledXY with negative values

SwitchGadget Update v1.06.0
- Update Style

: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  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 25 posts ]  Go to page Previous  1, 2

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 25 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