[Gambas-user] A little feature request about checkboxes

[adamnt42 at ...626...]

On Wed, 4 Mar 2015 11:35:27 +0100
Jorge Carrión <shordi at ...626...> wrote:

> Ok.
> 
> I'll try to do user control who extend the class then.
> 
> Regards.
> 
> 
> 
> 2015-03-04 11:32 GMT+01:00 Benoît Minisini <gambas at ...1...>:
> 
> > Le 04/03/2015 11:27, Jorge Carrión a écrit :
> > > I don't like the checkbox always at left of text. Is posible add a
> > > propertie Invert like hboxes has?
> > >
> > > It would be great.
> > >
> > > Regards
> >
> > I don't think so. At least I didn't see any property to do that in Qt
> > the last time I checked.
> >
> > --
> > Benoît Minisini
> >
> >
> > ------------------------------------------------------------------------------
> > Dive into the World of Parallel Programming The Go Parallel Website,
> > sponsored
> > by Intel and developed in partnership with Slashdot Media, is your hub for
> > all
> > things parallel software development, from weekly thought leadership blogs
> > to
> > news, videos, case studies, tutorials and more. Take a look and join the
> > conversation now. http://goparallel.sourceforge.net/
> > _______________________________________________
> > Gambas-user mailing list
> > Gambas-user at lists.sourceforge.net
> > https://lists.sourceforge.net/lists/listinfo/gambas-user
> >
> ------------------------------------------------------------------------------
> Dive into the World of Parallel Programming The Go Parallel Website, sponsored
> by Intel and developed in partnership with Slashdot Media, is your hub for all
> things parallel software development, from weekly thought leadership blogs to
> news, videos, case studies, tutorials and more. Take a look and join the 
> conversation now. http://goparallel.sourceforge.net/
> _______________________________________________
> Gambas-user mailing list
> Gambas-user at lists.sourceforge.net
> https://lists.sourceforge.net/lists/listinfo/gambas-user


The following may get you started.

' Gambas class file

''' A checkbox with the label on the left hand side!

Export

Inherits UserControl
'=================================================================
'====                 Control Infrastructure                  ====
'=================================================================
'Property declaration for the IDE (*=show all "UserContainer" Properties)
Public Const _Properties As String = "*,"
                                     "Action,"
                                     "Offset{Range}=15,"
                                     "LabelText,"
                                     "LabelColon=True,"
                                     "ReadOnly=False,"
                                     "TriState=False,"
                                     "Value{CheckBox.*}=False,"
                                     "-Expand"

Public Const _IsControl As Boolean = True
Public Const _Family As String = "Form"
Public Const _Group As String = "Paddys-Hill"
Public Const _DefaultSize As String = "25,3"        'These are in pixels/7
Public Const _DefaultEvent As String = "Changed"    'Set the default event handler
Public Const _IsContainer As Boolean = True

' Public Const _DrawWith As String = "CheckBox"    'Still cant get what we want here AND THIS CRASHES THE IDE

'=================================================================
'====                   Event Declarations                    ====
'=================================================================
Event Activate()
Event Changed()
Event Click()

'=================================================================
'====                 Property Declarations                   ====
'=================================================================
Property Offset As Integer          ' Sets or retuns the width of the label
Property LabelText As String        ' Sets or returns the label text
Property LabelColon As Boolean      ' Sets or returns whether the label is automatically "colonised"
Property Background As Integer      ' Sets or returns the checkbox background  ???

' New properties
Property ReadOnly As Boolean        ' Returns or sets whether the checkbox is readonly

' Native properties that need exposing
Property Value As Integer           ' Returns or sets the value of the check-box.
Property TriState As Boolean        ' Sets or returns whether null values are allowed

'=================================================================
'====                Local Property Variables                 ====
'=================================================================
Private $offset As Integer = 15
Private $labeltext As String
Private $labelcolon As Boolean = True
Private $readonly As Boolean = False                              '' Needs to be handled locally, native checkbox has no ReadOnly property

'=================================================================
'====                     Local Variables                     ====
'=================================================================
' 1)  Contained items
Private $hbox As HBox                   ' This will act as the "_Container"
Private $label As Label                 ' The label
Private $innercheckbox As CheckBox      ' The real checkbox
' Private $fakecheckbox As PictureBox     ' The displayed checkbox (to be considered later)

' 2) Some event control items
Private $selfobserver As Observer       ' Allows us to get at our own events
Private $originalvalue As Boolean       '
Private $innerBackground As Integer     ' used to save the set color
Private $innerForeground As Integer     ' used to save the set color
Private $allowclick As Boolean          ' used to control whether a Click will Click or SetFocus

'=================================================================
'====                      Special Methods                    ====
'=================================================================
Public Sub _new()
'' Constructor, wherein we create the control

  $selfobserver = New Observer(Me) As "SELF"

  $hbox = New HBox(Me)
  $hbox.Spacing = 2
'   $hbox.Expand = True 'Disabled Feb 2014 Not sure why it was ever set

  $label = New Label($hbox) As "InnerLabel"
  With $label
    .Alignment = Align.Right
    If MStandards.ShrinkLabelFont Then .Font = Font["-1"]
    If MStandards.ItaliciseLabelFont Then .Font.Italic = True
  End With

  $innercheckbox = New CheckBox($hbox) As "InnerCheckBox"
  With $innercheckbox
    .Text = ""
    .Width = 3 * Desktop.Scale
'     .Height = 3 * Desktop.Scale
  End With

  Me.Proxy = $innercheckbox

End

'=================================================================
'====                     Public Methods                      ====
'=================================================================

'=================================================================
'====                    Private Methods                      ====
'=================================================================
Private Sub SetupLabel()

  Dim wklabel As String

  wklabel = $labeltext
  If $labelcolon Then
    wklabel &= ":"
    Inc $offset
  Endif
  $label.Text = wklabel

End

'=================================================================
'====                   Property Accessors                    ====
'=================================================================
Private Function Value_Read() As Integer

  Return $innercheckbox.Value

End

Private Sub Value_Write(Value As Integer)

  $innercheckbox.Value = Value

End

Private Function Offset_Read() As Integer

  Return $offset

End

Private Sub Offset_Write(Value As Integer)

  $offset = Value

End

Private Function LabelText_Read() As String

  Return $labeltext

End

Private Sub LabelText_Write(Value As String)

  $labeltext = Value
  SetupLabel

End

Private Function LabelColon_Read() As Boolean

  Return $labelcolon

End

Private Sub LabelColon_Write(Value As Boolean)

  $labelcolon = Value
  SetupLabel

End

Private Function TriState_Read() As Boolean

  Return $innercheckbox.Tristate

End

Private Sub TriState_Write(Value As Boolean)

  $innercheckbox.Tristate = Value

End

Private Function Background_Read() As Integer

  Return $innercheckbox.Background

End

Private Sub Background_Write(Value As Integer)

  $innercheckbox.Background = Value

End

Private Function ReadOnly_Read() As Boolean

  Return $readonly

End

Private Sub ReadOnly_Write(Value As Boolean)

  $readonly = Value
  $innercheckbox.NoTabFocus = Value
  $innercheckbox.Enabled = Not Value
  
End

'=================================================================
'====                      Event Handlers                     ====
'=================================================================
Public Sub SELF_Arrange()

  $label.Width = $offset * Desktop.Scale
  $innercheckbox.x = $offset * Desktop.Scale + 2
  Me.Height = 3 * Desktop.Scale
  
  ' $innerBackground = $innercheckbox.Background
  ' $innerForeground = Me.Foreground

End

Public Sub SELF_KeyPress()


  If Key.Code = Key.Return Then 
    Stop Event
    If Key.Shift Then
      MUtil.PrevActiveControl(Me).SetFocus
    Else
      MUtil.NextActiveControl(Me).SetFocus
    Endif
  Else
    Raise Click
  Endif

  ' Dim hTarget As Control
  ' 
  ' ' 1) Make [Enter] emulate a [Tab]
  ' If Key.Code = Key.Return Then
  ' 
  '   If Key.Shift Then
  '     If Me.Previous Then 
  '       hTarget = Me.Previous
  '     Else
  '       hTarget = Me.Parent.Children[Me.Parent.Children.Count - 1]
  '     Endif
  '   Else
  '     If Me.Next Then 
  '       hTarget = Me.Next
  '     Else
  '       hTarget = Me.Parent.Children[0]
  '     Endif
  '   Endif
  ' 
  '   While hTarget.NoTabFocus
  '     If Key.Shift Then
  '       hTarget = hTarget.Previous
  '       If Not hTarget Then hTarget = Me.Parent.Children[Me.Parent.Children.Count - 1]
  '     Else
  '       hTarget = hTarget.Next
  '       If Not hTarget Then hTarget = Me.Parent.Children[0]
  '     Endif
  '   Wend
  ' 
  '   hTarget.SetFocus
  ' 
  ' Endif
  ' 
  ' ' 2) Make Arrows emulate a [Tab] This may not be a good idea in general as arrows have uses in list controls!
  ' If Key.Code = Key.Down Then
  '   hTarget = Me.Next
  '   While hTarget.NoTabFocus
  '     hTarget = hTarget.Next
  '     If Not hTarget Then hTarget = Me.Parent.Children[0]
  '   Wend
  '   hTarget.SetFocus
  '   Return
  ' Endif
  ' 
  ' If Key.Code = Key.Up Then
  '   hTarget = Me.Previous
  '   While hTarget.NoTabFocus
  '     hTarget = hTarget.Previous
  '     If Not hTarget Then hTarget = Me.Parent.Children[Me.Parent.Children.Count - 1]
  '   Wend
  '   hTarget.SetFocus
  '   Return 
  ' Endif
  ' 
  ' ' 3) Make [Ctrl]+Z provide an undo
  ' ' If Key.Code = Key["Z"] And Key.Control Then
  ' '   Stop Event
  ' '   $innertextbox.Text = $originaltext
  ' '   Return
  ' ' Endif

End

Public Sub SELF_Enter()
  
  If MStandards.HighlightRollover Then 
    If Not $innercheckbox.HasFocus Then $label.Foreground = Color.Green
  Endif
  
End

Public Sub SELF_Leave()
  
  If MStandards.HighlightRollover Then 
    If Not $innercheckbox.HasFocus Then $label.Foreground = Color.Default
  Endif
  
End

Public Sub InnerCheckBox_GotFocus()
'   Debug Me.Name, $innercheckbox.HasFocus

  'If $readonly Then Object.Lock($innercheckbox)
'   $allowclick = True
  $innercheckbox.Background = Color.Lighter($innercheckbox.Background)
'   If MUtil.IsQT4 Then $innercheckbox.Background = Color.Lighter($innercheckbox.Background)
  $label.Foreground = Color.Red
  $originalvalue = $innercheckbox.Value
  
End

Public Sub InnerCheckBox_LostFocus()

'   $allowclick = False
'   Debug Me.Name, $innercheckbox.HasFocus
  Me.Background = $innerBackground
  $label.Foreground = Color.Default
  If $innercheckbox.Value <> $originalvalue Then
    Raise Changed
  Endif

End
Public Sub InnerCheckBox_Enter()
  
'   Debug Me.Name, $innercheckbox.HasFocus
  If $innercheckbox.HasFocus Then
    $allowclick = True
  Else
    $allowclick = False
  Endif
  
End

Public Sub InnerCheckBox_MouseDown()

  If Not Me.HasFocus Then 
    Print "Already consumed"
    Me.SetFocus
    Stop Event
    Return 
  Else
    Stop Event
    Me.Value = Not Me.Value
    Me.SetFocus
  Endif

End

Public Sub InnerCheckBox_Click()

'' If this is a readonly checkbox then just ignore clicks
'' This is really messy as the click is detected by qt4 before
'' we can trap it. Maybe need to lock the innercheckbox in _GotFocus?
'' No. That means this will never fire, but the visual still occurs.
  If $readonly Then 
    Object.Lock($innercheckbox)
    $innercheckbox.Value = Not $innercheckbox.Value
    Stop Event
    Object.Unlock($innercheckbox)
    Return
  Endif
  
'' THIS DOESN"T WORK!
  If $allowclick Then
    Raise Click
  Else
    Stop Event
    $innercheckbox.SetFocus
  Endif

End

Public Sub InnerLabel_MouseDown()
  
'     Debug Me.Name, $innercheckbox.HasFocus

  Me.SetFocus
  
End

' Public Sub InnerLabel_Enter()
' '     Debug Me.Name, $innercheckbox.HasFocus
' 
'   If Not $innercheckbox.HasFocus Then $label.Foreground = Color.Green
'   
' End


-- 
B Bruen <adamnt42 at ...3379... (sort of)>