Array Function in VB.NET

Greating everyones, this time I will discuss about Array, what make Array so special, it's ability to store multiple value, other variable can only store one value



Declaring One Dimensional Array

Dim arrValuesOne(9) As  Integer         'Create 10 slot with index start from 0 to 9

Dim arrValuesTwo(0 to 9) As Integer     'Also create 10 slot with index from 0 to 9


both code result same thing, to set the value of an array, refer to this code

arrValuesOne(0) = 1

arrValuesOne(1) = 2

arrValuesOne(2) = 3

arrValuesOne(3) = 4

arrValuesOne(4) = 5

arrValuesOne(5) = 6

arrValuesOne(6) = 7

arrValuesOne(7) = 8

arrValuesOne(8) = 9

arrValuesOne(9) = 10


This is the simpliest way declare and set an array value

Declaring Multi Dimensional Array

To create multi dimensional array, use the comma sign
Dim arrValues(0 to 9, 0 to 9) As Decimal


To set the value you can simply write it like this
arrValues(0, 0) = 100

arrValues(1, 1) = 200

arrValues(2, 2) = 300


and soon ...

We can give in array as many as 32 dimensional, but in reality we only use 2 or 3

Declaring Array Without Initialized

If we declare it like this
Dim arrValues() As Integer

this means we declare an array without giving the slot, later if we want to give a slot, we can simply write it like this

Redim arrValues(0 to 10)

arrValues(1) = 1000


To redim an array that already fill with value, and we don't want to reset the value, we can simply add Preserve keyworad infront of Redim

Redim Preserve arrValues(0 to 10)




Let's jump out to a sample code



First create a sample form like this


In this form the user will input any kind of string and everytime the user hit the Add button the string value will be saved into the array

And if the user hit the Remove button the string value that already save into the array will be removed one by one according to the order

Public Class Form1
    ' The array of strings.
    Private Values(0 To -1) As String
 
    ' Add a string to the array.
    Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
        ' Get the old upper bound.
        Dim old_upper_bound As Integer = Values.Length - 1
 
        ' Make room for the new item.
        ReDim Preserve Values(0 To old_upper_bound + 1)
 
        ' Insert the new item.
        Values(old_upper_bound + 1) = txtString.Text
 
        ' Clear the TextBox.
        txtString.Clear()
        txtString.Focus()
    End Sub
 
    ' Remove a string from the array.
    Private Sub btnRemove_Click(sender As Object, e As EventArgs) Handles btnRemove.Click
        ' Get the old upper bound.
        Dim old_upper_bound As Integer = Values.Length - 1
 
        ' Make sure the array isn't empty.
        If old_upper_bound < 0 Then
            ' There are no more items. Say so.
            txtString.Text = ""
        Else
            ' Display the last item in the array.
            txtString.Text = Values(old_upper_bound)
 
            ' Resize the array to remove the last item.
            ReDim Preserve Values(0 To old_upper_bound - 1)
        End If
    End Sub
End Class

Run the project, and try to add some item, after add several item, put a breakpoint in line 17, and hover the mouse over Values in line 14, you will see there are 4 item inside the Values array.

Another great way to create an array and this is my favorite, after defining the array name, use curly bracketto fill the value

Dim TheValues As Integer = {10,23,350,324,500}

Of course you must give a value that correspond with the data type, otherwise it will be crashed.

Creat English Decimal Speller In Visual Basic 6.0


This function is almost the same as the previous post, but in the English version with little change in the coding.

Open the new project (Standard.Exe), in Form1 put 2 pieces of textbox with the default Name property (Text1 and Text2).



Go to editor mode, click View -> Code, and enter the following code :

Private Function SpellDigit(strNumeric As Integer)
 Dim cRet As String
 On Error GoTo Pesan
 cRet = ""
 Select Case strNumeric
        Case 0:     cRet = " zero"
        Case 1:     cRet = " one"
        Case 2:     cRet = " two"
        Case 3:     cRet = " three"
        Case 4:     cRet = " four"
        Case 5:     cRet = " five"
        Case 6:     cRet = " six"
        Case 7:     cRet = " seven"
        Case 8:     cRet = " eight"
        Case 9:     cRet = " nine"
        Case 10:    cRet = " ten"
        Case 11:    cRet = " eleven"
        Case 12:    cRet = " twelve"
        Case 13:    cRet = " thirteen"
        Case 14:    cRet = " fourteen"
        Case 15:    cRet = " fifteen"
        Case 16:    cRet = " sixteen"
        Case 17:    cRet = " seventeen"
        Case 18:    cRet = " eighteen"
        Case 19:    cRet = " ninetieen"
        Case 20:    cRet = " twenty"
        Case 30:    cRet = " thirty"
        Case 40:    cRet = " fourthy"
        Case 50:    cRet = " fifty"
        Case 60:    cRet = " sixty"
        Case 70:    cRet = " seventy"
        Case 80:    cRet = " eighty"
        Case 90:    cRet = " ninety"
        Case 100:   cRet = " one hundred"
        Case 200:   cRet = " two hundred"
        Case 300:   cRet = " three hundred"
        Case 400:   cRet = " four hundred"
        Case 500:   cRet = " five hundred"
        Case 600:   cRet = " six hundred"
        Case 700:   cRet = " seven hundred"
        Case 800:   cRet = " eight hundred"
        Case 900:   cRet = " nine hundred"
 End Select
 SpellDigit = cRet
Exit Function

Pesan:
  SpellDigit = "(maksimal 9 digit)"
End Function

Private Function SpellUnit(strNumeric As Integer)
 Dim cRet As String
 Dim n100 As Integer
 Dim n10 As Integer
 Dim n1 As Integer
 On Error GoTo Pesan
 cRet = ""
 n100 = Int(strNumeric / 100) * 100
 n10 = Int((strNumeric - n100) / 10) * 10
 n1 = (strNumeric - n100 - n10)
 If n100 > 0 Then
    cRet = SpellDigit(n100)
 End If
 If n10 > 0 Then
    If n10 = 10 Then
       cRet = cRet & SpellDigit(n10 + n1)
    Else
       cRet = cRet & SpellDigit(n10)
    End If
 End If
 If n1 > 0 And n10 <> 10 Then
    cRet = cRet & SpellDigit(n1)
 End If
 SpellUnit = cRet
 Exit Function
Pesan:
  SpellUnit = "(maksimal 9 digit)"
End Function

Public Function TerbilangInggris(strNumeric As String) As String
 Dim cRet As String
 Dim n1000000 As Long
 Dim n1000 As Long
 Dim n1 As Integer
 Dim n0 As Integer
   On Error GoTo Pesan
   Dim strValid As String, huruf As String * 1
   Dim i As Integer
   'Periksa setiap karakter masukan
   strValid = "1234567890.,"
   For i% = 1 To Len(strNumeric)
     huruf = Chr(Asc(Mid(strNumeric, i%, 1)))
     If InStr(strValid, huruf) = 0 Then
       MsgBox "Harus karakter angka!", _
              vbCritical, "Karakter Tidak Valid"
       Exit Function
     End If
   Next i%

 If strNumeric = "" Then Exit Function
 If Len(Trim(strNumeric)) > 9 Then GoTo Pesan

 cRet = ""
 n1000000 = Int(strNumeric / 1000000) * 1000000
 n1000 = Int((strNumeric - n1000000) / 1000) * 1000
 n1 = Int(strNumeric - n1000000 - n1000)
 n0 = (strNumeric - n1000000 - n1000 - n1) * 100
 If n1000000 > 0 Then
    cRet = SpellUnit(n1000000 / 1000000) & " million"
 End If
 If n1000 > 0 Then
    cRet = cRet & SpellUnit(n1000 / 1000) & " thousand"
 End If
 If n1 > 0 Then
    cRet = cRet & SpellUnit(n1)
 End If
 If n0 > 0 Then
    cRet = cRet & " and cents" & SpellUnit(n0)
 End If
 TerbilangInggris = cRet & " only"
 Exit Function

Pesan:
TerbilangInggris = "(maximum 9 digit)"
End Function

Private Sub Text1_Change()
    Text2.Text = TerbilangInggris(Text1.Text)
End Sub

Run the project (Press F5), and enter the numeric value in the first textbox, and the resultant sentence in English will be displayed in the second textbox.

Good luck.

Be My Friend On Facebook

Create Indonesia Decimal Speller Functions In Visual Basic 6.0

The following functions are one of the most commonly used functions for creating a project such as Sales and Inventory programs, as they usually need to generate transaction receipts.

Open a new project (Standard.Exe), in Form1 put 2 pieces of textbox for Name property leave with its default name.



Go to editor mode, click View -> Code, and enter the following code :

Public Function TerbilangDesimal(InputCurrency As String, Optional MataUang As String = "rupiah") As String
 Dim strInput As String
 Dim strBilangan As String
 Dim strPecahan As String
   On Error GoTo Pesan
   Dim strValid As String, huruf As String * 1
   Dim i As Integer
   'Periksa setiap karakter yg diketikkan ke kotak
   'UserID
   strValid = "1234567890,"
   For i% = 1 To Len(InputCurrency)
     huruf = Chr(Asc(Mid(InputCurrency, i%, 1)))
     If InStr(strValid, huruf) = 0 Then
       Set AngkaTerbilang = Nothing
       MsgBox "Harus karakter angka!", _
              vbCritical, "Karakter Tidak Valid"
       Exit Function
     End If
   Next i%

 If InputCurrency = "" Then Exit Function
 If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan

 strInput = CStr(InputCurrency) 'Konversi ke string
 'Periksa apakah ada tanda "," jika ya berarti pecahan
 If InStr(1, strInput, ",", vbBinaryCompare) Then
      
  strBilangan = Left(strInput, InStr(1, strInput, _
                ",", vbBinaryCompare) - 1)
  'strBilangan = Right(strInput, InStr(1, strInput, _
  '              ".", vbBinaryCompare) - 2)
  strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 1))
  
  If MataUang <> "" Then
      
  If CLng(Trim(strPecahan)) > 99 Then
     strInput = Format(Round(CDbl(strInput), 2), "#0.00")
     strPecahan = Format((Right(strInput, Len(strInput) - Len(strBilangan) - 1)), "00")
    End If
    
    If Len(Trim(strPecahan)) = 1 Then
       strInput = Format(Round(CDbl(strInput), 2), _
                  "#0.00")
       strPecahan = Format((Right(strInput, _
          Len(strInput) - Len(strBilangan) - 1)), "00")
    End If
    
    If CLng(Trim(strPecahan)) = 0 Then
    TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan))
 Else
  TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan) & "sen")
    End If
  Else
    TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma " & KonversiPecahan(strPecahan))
  End If
  
 Else
    TerbilangDesimal = (KonversiBilangan(strInput))
  End If
 Exit Function
Pesan:
  TerbilangDesimal = "(maksimal 15 digit)"
End Function
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0)
Private Function KonversiPecahan(strAngka As String) As String
Dim i%, strJmlHuruf$, Urai$, Kar$
 If strAngka = "" Then Exit Function
    strJmlHuruf = Trim(strAngka)
    Urai = ""
    Kar = ""
    For i = 1 To Len(strJmlHuruf)
      'Tampung setiap satu karakter ke Kar
      Kar = Mid(strAngka, i, 1)
      Urai = Urai & Kata(CInt(Kar))
    Next i
    KonversiPecahan = Urai
End Function
'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata
Private Function Kata(angka As Byte) As String
   Select Case angka
          Case 1: Kata = "satu "
          Case 2: Kata = "dua "
          Case 3: Kata = "tiga "
          Case 4: Kata = "empat "
          Case 5: Kata = "lima "
          Case 6: Kata = "enam "
          Case 7: Kata = "tujuh "
          Case 8: Kata = "delapan "
          Case 9: Kata = "sembilan "
          Case 0: Kata = "nol "
   End Select
End Function
'Ini untuk mengkonversi nilai bilangan sebelum pecahan
Private Function KonversiBilangan(strAngka As String) As String
Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$
 Dim X, Y, z As Integer

 If strAngka = "" Then Exit Function
    strJmlHuruf = Trim(strAngka)
    X = 0
    Y = 0
    Urai = ""
    While (X < Len(strJmlHuruf))
      X = X + 1
      strTot = Mid(strJmlHuruf, X, 1)
      Y = Y + Val(strTot)
      z = Len(strJmlHuruf) - X + 1
      Select Case Val(strTot)
      'Case 0
       '   Bil1 = "NOL "
      Case 1
          If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
              Bil1 = "satu "
          ElseIf (z = 4) Then
              If (X = 1) Then
                  Bil1 = "se"
              Else
                  Bil1 = "satu "
              End If
          ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
              X = X + 1
              strTot = Mid(strJmlHuruf, X, 1)
              z = Len(strJmlHuruf) - X + 1
              Bil2 = ""
              Select Case Val(strTot)
              Case 0
                  Bil1 = "sepuluh "
              Case 1
                  Bil1 = "sebelas "
              Case 2
                  Bil1 = "dua belas "
              Case 3
                  Bil1 = "tiga belas "
              Case 4
                  Bil1 = "empat belas "
              Case 5
                  Bil1 = "lima belas "
              Case 6
                  Bil1 = "enam belas "
              Case 7
                  Bil1 = "tujuh belas "
              Case 8
                  Bil1 = "delapan belas "
              Case 9
                  Bil1 = "sembilan belas "
              End Select
          Else
              Bil1 = "se"
          End If
      
      Case 2
          Bil1 = "dua "
      Case 3
          Bil1 = "tiga "
      Case 4
          Bil1 = "empat "
      Case 5
          Bil1 = "lima "
      Case 6
          Bil1 = "enam "
      Case 7
          Bil1 = "tujuh "
      Case 8
          Bil1 = "delapan "
      Case 9
          Bil1 = "sembilan "
      Case Else
          Bil1 = ""
      End Select
       
      If (Val(strTot) > 0) Then
         If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
            Bil2 = "puluh "
         ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
            Bil2 = "ratus "
         Else
            Bil2 = ""
         End If
      Else
         Bil2 = ""
      End If
      If (Y > 0) Then
          Select Case z
          Case 4
              Bil2 = Bil2 + "ribu "
              Y = 0
          Case 7
              Bil2 = Bil2 + "juta "
              Y = 0
          Case 10
              Bil2 = Bil2 + "milyar "
              Y = 0
          Case 13
              Bil2 = Bil2 + "trilyun "
              Y = 0
          End Select
      End If
      Urai = Urai + Bil1 + Bil2
  Wend
  KonversiBilangan = Urai
End Function
Private Sub Text1_Change()  'Isi besar nilai angka diulangi 'dengan terbilang huruf...
   Text2.Text = TerbilangDesimal(Text1.Text)
End Sub

Run the project (press F5) and try to enter some number of values into the first textbox, then the second textbox will generate a sentence counted from the number of numbers you enter.

Good luck.

Be My Friend On Facebook

Create Initial Word into a Capitalized Letters In Visual Basic 6.0

for this post we will discuss a function that can change every initial letter on a word into uppercase or capslock.

Open a new project (Standard.Exe), in Form1 add a textbox and set the Height and Width property of a rather large size make sure your Multiline property is set to True, so that its textbox can be widened down, and let the Name property match its default name .



Now let's move to editor mode, click View -> Code, and enter the following code :

Public Function AwalKataKapital(strKalimat As String)
Dim i As Integer
Dim Temp As String
Dim Lokasi As Integer
Dim huruf As String * 1
  Temp$ = ""
  For i% = 1 To Len(strKalimat)
    huruf = Chr(Asc(Mid(strKalimat, i%, 1)))
    If Len(Trim(huruf)) < 1 Then
      Lokasi% = i% + 1
    End If
    If i% = Lokasi% Or i% = 1 Then
       Temp$ = Temp$ + UCase(Chr(Asc(Mid(strKalimat, _
               i%, 1))))
    Else
       Temp$ = Temp$ + LCase(Chr(Asc(Mid(strKalimat, _
                i%, 1))))
    End If
  Next i
  AwalKataKapital = Temp$
End Function
Private Sub Text1_Change()
  Dim posisi As Integer
  posisi = Text1.SelStart
  Text1.Text = AwalKataKapital(Text1.Text)
  Text1.SelStart = posisi
End Sub

Press F5 to run the project, you try to type some words in the textbox we have provided, then every letter of the beginning of the word will automatically turn into capital letters.

Good luck.

Remove a Title Bar or None BorderStyle On MDI Form

Sometime we want to manipulate the entire screen appearance, without having to be limited by the title bar or status bar, if that's what you want, refer to the following reviews

On the reguler form this is very easy to do, we only have to set the property BorderStyle = 0 - None, but to remove Title Bar on MDI Form we need to call some API function.



Add an MDI Form to the project via Project -> Add MDI Form, and a Module from the menu Project -> Add Module

Double klik Module1, and type in the following code :

Private Declare Function GetWindowLong Lib "USER32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WS_CAPTION = &HC00000

Public Sub MDINoBorder(ByRef nFormHWND As Long)
Dim sHandle As Long
On Error GoTo errMDINoBorder

sHandle = GetWindowLong(nFormHWND, GWL_STYLE)
sHandle = sHandle And Not WS_CAPTION
SetWindowLong nFormHWND, GWL_STYLE, sHandle

Exit Sub

errMDINoBorder:
  MsgBox "[" & Err.Number & "] - " & Err.Description, _
  vbExclamation, "MDI No Border Error"
End Sub

And then double click the MDIForm1, and type in the following code :

Private Sub MDIForm_Activate()
  MDINoBorder Me.hwnd
End Sub

Run the project by pressing the F5 key, and see the result now MDIForm on your project does not have a Title Bar.


Good luck.

Be My Friend On Facebook