COMPONENTE ESTILO MOEDA

DAMASCENO.CESAR 24/09/2023 09:39:51
#501780
Bom dia pessoal, não sei se é o local correto aqui, se não for, por favor me avisem!
Personalizei um componente (usando inherits) para usar o formato moeda, fiz vários testes e acho que está completo.
Vou postar o código aqui e gostaria que vocês o testassem também, para ver se há algum erro ainda.
Este código foi baseado em um exemplo que encontrei aqui no VBM em VBA e adaptei.
devido ao fato de que o componente pode ser preenchido via código, e não só digitando, vai aparecer alguns POGs, como diz nosso amigo KERPLUNK.
Segue o código abaixo:
  Partial Public Class TxtMoeda
        Inherits TextBox
        Dim ddvalor As Boolean
        Dim Tcl As Integer
        Protected Overrides Sub OnCreateControl()
            MyBase.OnCreateControl()
            CType(Me, TextBox).TextAlign = HorizontalAlignment.Right
        End Sub

        Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
            MyBase.OnKeyPress(e)
            If Len(CType(Me, TextBox).Text) > 22 Then e.KeyChar = ""
            CType(Me, TextBox).SelectionStart = Len(CType(Me, TextBox).Text)
            Tcl = Asc(e.KeyChar)
            If Asc(e.KeyChar) = 44 And InStr(1, CType(Me, TextBox).Text, ",") = 0 Then Exit Sub
            If Asc(e.KeyChar) > (47) And Asc(e.KeyChar) < (58) Then
                Exit Sub
            End If
            If Asc(e.KeyChar) = 8 Then
                Exit Sub
            End If
            e.KeyChar = ""
            If e.KeyChar = Chr(13) Then
                SendKeys.Send("{TAB}")
                e.Handled = True
            End If
        End Sub

        Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
            MyBase.OnKeyDown(e)
            CType(Me, TextBox).SelectionStart = Len(CType(Me, TextBox).Text)
            If e.KeyCode = 46 Or e.KeyCode = 8 Then
                Exit Sub
            End If
            If e.KeyCode = 13 Then
                SendKeys.Send("{TAB}")
            End If
            e.Handled = True
        End Sub

        Protected Overrides Sub OnTextChanged(e As EventArgs)
            MyBase.OnTextChanged(e)
            If ddvalor = True Then Exit Sub
            Dim ddValor2 As String
            ddvalor = True
            ddValor2 = CType(Me, TextBox).Text
            'testar se não digitou numeros ou backspace
            If Not Tcl = 8 Then
                If Not (Tcl > 47 And Tcl < 58) Then
                    If InStr(1, ddValor2, ",") = Nothing Then
                        ddValor2 &= "00"
                    End If
                    If Len(ddValor2) - InStr(1, ddValor2, ",") = 1 Then
                        ddValor2 &= "0"
                    End If
                End If
            End If
            ddValor2 = ddValor2.Replace(",", "")
            ddValor2 = ddValor2.Replace(".", "")
            'Colocar as casas decimais
            ddValor2 = Val(ddValor2) / 100
            If ddValor2 = "0" Then ddValor2 = "0,00"
            ddValor2 = FormatNumber(ddValor2, 2)
            'mandar o foco para o final do controle
            CType(Me, TextBox).Text = ddValor2
            CType(Me, TextBox).SelectionStart = Len(CType(Me, TextBox).Text)
            ddvalor = False
            Tcl = 0
        End Sub

        Protected Overrides Sub OnGotFocus(e As EventArgs)
            MyBase.OnGotFocus(e)
            CType(Me, TextBox).SelectionStart = Len(CType(Me, TextBox).Text)
        End Sub

        Protected Overrides Sub OnClick(e As EventArgs)
            MyBase.OnClick(e)
            CType(Me, TextBox).SelectionStart = Len(CType(Me, TextBox).Text)
        End Sub
    End Class
KERPLUNK 24/09/2023 23:18:58
#501783 Resposta escolhida
Adicionadas propriedades para customizar várias coisas:

Partial Public Class TxtMoeda
    Inherits TextBox
    Private ddvalor As Boolean
    Private WithEvents decimalCharacter As New NumericUpDown()
    Private _tcl As Integer

    ' definindo códigos de tecla default
    Private DefaultDecimalKeyCodes As New List(Of Keys) From {Keys.Decimal, Keys.Oemcomma}
    Private DefaultBackspaceKeyCodes As New List(Of Keys) From {Keys.Back}
    Private DefaultTabKeyCodes As New List(Of Keys) From {Keys.Enter}

    ' Teclas customizáveis
    Public Property DecimalKeyCodes As List(Of Keys) = DefaultDecimalKeyCodes
    Public Property BackspaceKeyCodes As List(Of Keys) = DefaultBackspaceKeyCodes
    Public Property TabKeyCodes As List(Of Keys) = DefaultTabKeyCodes

    ' Formato customizado
    Public Property FormatPattern As String = "0.00"

    ' Decimal customizado
    Public Property DecimalSeparator As Char = ","c

    Private Property Tcl As Integer
        Get
            Return _tcl
        End Get
        Set(value As Integer)
            _tcl = value
        End Set
    End Property

    Protected Overrides Sub OnCreateControl()
        MyBase.OnCreateControl()
        Me.TextAlign = HorizontalAlignment.Right
    End Sub

    Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
        MyBase.OnKeyPress(e)

        If Me.Text.Length > 22 Then
            e.KeyChar = Chr(0)
        End If

        Me.SelectionStart = Me.Text.Length
        Tcl = Asc(e.KeyChar)

        If DecimalKeyCodes.Contains(CType(e.KeyChar, Keys)) AndAlso Not Me.Text.Contains(DecimalSeparator) Then
            Exit Sub
        End If

        If Asc(e.KeyChar) < 48 OrElse Asc(e.KeyChar) > 57 Then
            If Not BackspaceKeyCodes.Contains(CType(e.KeyChar, Keys)) Then
                e.KeyChar = Chr(0)
            End If
        End If

        If TabKeyCodes.Contains(CType(e.KeyChar, Keys)) Then
            SendKeys.Send("{TAB}")
            e.Handled = True
        End If
    End Sub

    Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
        MyBase.OnKeyDown(e)
        Me.SelectionStart = Me.Text.Length

        If BackspaceKeyCodes.Contains(e.KeyCode) Then
            Exit Sub
        End If

        If TabKeyCodes.Contains(e.KeyCode) Then
            SendKeys.Send("{TAB}")
        End If

        e.Handled = True
    End Sub

    Protected Overrides Sub OnTextChanged(e As EventArgs)
        MyBase.OnTextChanged(e)

        If ddvalor Then Exit Sub

        ddvalor = True
        Dim ddValor2 As String = Me.Text

        If Tcl <> 8 AndAlso (Tcl < 48 OrElse Tcl > 57) Then
            If Not Me.Text.Contains(DecimalSeparator) Then
                ddValor2 &= "00"
            End If

            If Me.Text.Length - Me.Text.IndexOf(DecimalSeparator) = 1 Then
                ddValor2 &= "0"
            End If
        End If

        ddValor2 = ddValor2.Replace(DecimalSeparator, "")
        ddValor2 = ddValor2.Replace(".", "")
        ddValor2 = Val(ddValor2) / 100

        If ddValor2 = "0" Then ddValor2 = "0.00"
        ddValor2 = FormatNumber(ddValor2, FormatPattern)

        Me.Text = ddValor2
        Me.SelectionStart = Me.Text.Length
        ddvalor = False
        Tcl = 0
    End Sub

    Protected Overrides Sub OnGotFocus(e As EventArgs)
        MyBase.OnGotFocus(e)
        Me.SelectionStart = Me.Text.Length
    End Sub

    Protected Overrides Sub OnClick(e As EventArgs)
        MyBase.OnClick(e)
        Me.SelectionStart = Me.Text.Length
    End Sub
End Class
DAMASCENO.CESAR 25/09/2023 09:14:13
#501785
Obrigado KERP!!
Fiz uns testes aqui e precisei fazer algumas alterações básicas.
Ao usar a constante do formato numérico que você criou, me retornava 0, por isso usei o padrão anterior.
As outras alterações estão marcadas no código abaixo.


  Partial Public Class TxtMoeda
        Inherits TextBox
        Private ddvalor As Boolean
        Private WithEvents decimalCharacter As New NumericUpDown()
        Private _tcl As Integer

        ' definindo códigos de tecla default
        Private DefaultDecimalKeyCodes As New List(Of Keys) From {Keys.Decimal, Keys.Oemcomma}
        Private DefaultBackspaceKeyCodes As New List(Of Keys) From {Keys.Back}
        Private DefaultTabKeyCodes As New List(Of Keys) From {Keys.Enter}

        ' Teclas customizáveis
        Public Property DecimalKeyCodes As List(Of Keys) = DefaultDecimalKeyCodes
        Public Property BackspaceKeyCodes As List(Of Keys) = DefaultBackspaceKeyCodes
        Public Property TabKeyCodes As List(Of Keys) = DefaultTabKeyCodes

        ' Formato customizado
        Public Property FormatPattern As String = "0.00"

        ' Decimal customizado
        Public Property DecimalSeparator As Char = ","c

        Private Property Tcl As Integer
            Get
                Return _tcl
            End Get
            Set(value As Integer)
                _tcl = value
            End Set
        End Property

        Protected Overrides Sub OnCreateControl()
            MyBase.OnCreateControl()
            Me.TextAlign = HorizontalAlignment.Right
        End Sub

        Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
            MyBase.OnKeyPress(e)

            If Me.Text.Length > 22 Then
                e.KeyChar = Chr(0)
            End If

            Me.SelectionStart = Me.Text.Length
            Tcl = Asc(e.KeyChar)

            '##### Código Original
            'If DecimalKeyCodes.Contains(CType(e.KeyChar, Keys)) AndAlso Not Me.Text.Contains(DecimalSeparator) Then
            '    Exit Sub
            'End If

            '##### Código Alterado
            If DecimalKeyCodes.Contains(CType(Asc(e.KeyChar), Keys)) AndAlso Not Me.Text.Contains(DecimalSeparator) Then
                Exit Sub
            End If

            '##### Código Original
            'If Asc(e.KeyChar) < 48 OrElse Asc(e.KeyChar) > 57 Then
            '    If Not BackspaceKeyCodes.Contains(CType(e.KeyChar, Keys)) Then
            '        e.KeyChar = Chr(0)
            '    End If
            'End If

            '##### Código Alterado
            If Asc(e.KeyChar) < 48 OrElse Asc(e.KeyChar) > 57 Then
                If Not BackspaceKeyCodes.Contains(CType(Asc(e.KeyChar), Keys)) Then
                    e.KeyChar = Chr(0)
                End If
            End If

            '##### Código Original
            'If TabKeyCodes.Contains(CType(e.KeyChar, Keys)) Then
            '    SendKeys.Send("{TAB}")
            '    e.Handled = True
            'End If

            '##### Código Alterado
            If TabKeyCodes.Contains(CType(Asc(e.KeyChar), Keys)) Then
                SendKeys.Send("{TAB}")
                e.Handled = True
            End If


        End Sub

        Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
            MyBase.OnKeyDown(e)
            Me.SelectionStart = Me.Text.Length

            If BackspaceKeyCodes.Contains(e.KeyCode) Then
                Exit Sub
            End If

            If TabKeyCodes.Contains(e.KeyCode) Then
                SendKeys.Send("{TAB}")
            End If

            e.Handled = True
        End Sub

        Protected Overrides Sub OnTextChanged(e As EventArgs)
            MyBase.OnTextChanged(e)

            If ddvalor Then Exit Sub

            ddvalor = True
            Dim ddValor2 As String = Me.Text

            If Tcl <> 8 AndAlso (Tcl < 48 OrElse Tcl > 57) Then
                '##### Codigo Original
                'If Not Me.Text.Contains(DecimalSeparator) Then
                '    ddValor2 &= "00"
                'End If

                '##### Código Alterado
                If Not ddValor2.Contains(DecimalSeparator) Then
                    ddValor2 &= "00"
                End If

                '##### Codigo Original
                'If ddValor2.Length - ddValor2.IndexOf(DecimalSeparator) = 1 Then
                '    ddValor2 &= "0"
                'End If

                '##### Código Alterado
                If ddValor2.Length - ddValor2.IndexOf(DecimalSeparator) = 2 Then
                    ddValor2 &= "0"
                End If
            End If

            ddValor2 = ddValor2.Replace(DecimalSeparator, "")
            ddValor2 = ddValor2.Replace(".", "")
            ddValor2 = Val(ddValor2) / 100
            If ddValor2 = "0" Then ddValor2 = "0.00"

            '##### Codigo Original
            'ddValor2 = FormatNumber(ddValor2, FormatPattern)

            '##### Código Alterado
            ddValor2 = FormatNumber(ddValor2, 2)
            Me.Text = ddValor2
            Me.SelectionStart = Me.Text.Length
            ddvalor = False
            Tcl = 0
        End Sub

        Protected Overrides Sub OnGotFocus(e As EventArgs)
            MyBase.OnGotFocus(e)
            Me.SelectionStart = Me.Text.Length
        End Sub

        Protected Overrides Sub OnClick(e As EventArgs)
            MyBase.OnClick(e)
            Me.SelectionStart = Me.Text.Length
        End Sub
    End Class
DAMASCENO.CESAR 25/09/2023 09:25:16
#501786
Outra coisa, nesta parte do Código
  If Me.Text.Length > 22 Then
            e.KeyChar = Chr(0)
        End If

Alterei para
  If Me.Text.Length > 19 Then
                e.KeyChar = Chr(0)
      End If

Caso contrário, o número digitado não confere
Tópico encerrado , respostas não são mais permitidas
Voltar