Showing posts with label Tutorial. Show all posts
Showing posts with label Tutorial. Show all posts

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

Handling Files and Directories In Visual Basic 6.0

Sometimes we need to interact with files and directories that exist on the hard drive, for example if we want to export existing data into MS. Excel files, or maybe you want can to restore its database from backup results that have been made before

Here are some examples of code that can handle file and directory issues



T&T#1) CHECK FILE PROPERTIES

Open the new Standard.Exe project, place 1 CommandButton and change its caption to Properties, double click commandbutton and insert the following code:

Private Sub Command1_Click()
  'Ganti 'c:\autoexec.bat' dengan nama file yang Anda
  'ingin lihat kotak dialog property-nya...
  Call ShowProps("c:\autoexec.bat", Me.hwnd)
End Sub

Public Sub ShowProps(FileName As String, OwnerhWnd _
As Long)
Dim SEI As SHELLEXECUTEINFO
Dim r As Long
With SEI
  .cbSize = Len(SEI)
  .fMask = SEE_MASK_NOCLOSEPROCESS Or _
  SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
  .hwnd = OwnerhWnd
  .lpVerb = "properties"
  .lpFile = FileName
  .lpParameters = vbNullChar
  .lpDirectory = vbNullChar
  .nShow = 0
  .hInstApp = 0
  .lpIDList = 0
End With
r = ShellExecuteEX(SEI)
End Sub

Click Project -> Add Module, double click module1 and enter the following code :

Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hwnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type

Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

Press F5 and run the project

Click the Properties button, it will display the properties of the autoexec.bat file that we use as an example

T&T#2) CREATE EXCEL FILE

Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton and enter the following code:

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet

Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Add
Set xlWS = xlWB.Worksheets.Add

'this line will fill cell (2,2) with
'text "hello" and fill cell (1,3) with
'text "World"

xlWS.Cells(2, 2).Value = "hello"
xlWS.Cells(1, 3).Value = "World"

'This line will save the spreadsheet into
'file "c:\mysheet.xls".

xlWS.SaveAs "c:\mysheet.xls"
xlApp.Quit

'free some memory...

Set xlWS = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub


Press F5 and run the project

T&T#3) OPEN THE DIALOGUE BOX “BROWSE FOR FOLDER”

Open the new Standard.Exe project, insert 1 CommandButton into the form, and change the caption to Browse, double click commandbutton, and enter the following code:

Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

'Change the "Browse For Folders" dialogue title

szTitle = "This Is My Title"
With tBrowseInfo
  .hWndOwner = Me.hWnd
  .lpszTitle = lstrcat(szTitle, "")
  .ulFlags = BIF_RETURNONLYFSDIRS + _
  BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer

'sBuffer var is the selected directory choose by user.

sBuffer = Left(sBuffer, InStr(sBuffer, _
vbNullChar) - 1)

MsgBox sBuffer
End If
End Sub

Last but not least click Project -> Add Module, double click Module1, and enter the following code:

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Public Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Press F5 and run the project

T&T#4) OPEN WINDOWS EXPLORER WITH SPECIFIC DIREKTORY

Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:

Private Sub Command1_Click()
'specify the directory name that you will be open with Windows Explorer
   OpenExplorer ("C:\Program Files\")
End Sub

Public Sub OpenExplorer(Optional InitialDirectory As String)
     ShellExecute 0, "Explore", InitialDirectory, vbNullString, _
     vbNullString, SW_SHOWNORMAL
End Sub
Click Project -> Add Module, double klik Module1, and enter the following code :

Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal _
lpOperation As String, ByVal lpFile As String, ByVal _
lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Const SW_SHOWNORMAL = 1
Press F5 and run the project

T&T#5) CHECK IF DIRECTORY EXIST

Open the new Standard.Exe project, double click Form1 and enter the following code:
'The example of the checked directory is "C: \ Windows"

Private Sub Form_Load()
Const ATTR_DIRECTORY = 16
If Dir$("c:\windows", ATTR_DIRECTORY) <> "" Then
MsgBox "Direktori ada!", vbInformation, "Ada"
Else MsgBox "Directory does not exist!", vbCritical, "Not Found" 
End If 
End Sub 

Press F5 and run the project

T&T#6) CHECK IF FILE EXIST

Open the new Standard.Exe project, double click Form1 and enter the following code:

'Example file"C:\autoexec.bat"
Private Sub Form_Load()
'Change "c:\autoexec.bat" with the complete file name (include the path)

If Dir$("c:\autoexec.bat") <> "" Then
   MsgBox "File Exist!", vbInformation, "Exist"
Else
   MsgBox "File Not Found!", vbCritical, "Not Found"
End If
End Sub

Press F5 and run the project

T&T#7) MOVING FILE

Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:

'this will move file 'c:\MyFile.Zip' to 'direktori 'c:\MyDir'.
Private Sub Command1_Click()
A = MoveFile("c:\MyFile.Zip", "c:\MyDir\MyFile.Zip")
If A Then
       MsgBox "File successfully move!", _
              vbInformation, "Sukses Pindah File"
Else
       MsgBox "Error. Can not move file!" & Chr(13) & _
              "Maybe file does not exist" & _
              Chr(13) & "or file already exist in " & _
              Chr(13) & _
              "destination folder!", vbCritical, "Error: Moving File"
End If
End Sub

Click Project -> Add Module, double click Module1, and enter the following code :

Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" _ 
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String) _
As Long

Press F5 and run the project

T&T#8) GET FILE NAME

Open the new Standard.Exe project, double click Form1 and enter the following code:

Private Sub Form_Load()
   MsgBox StripPath("c:\myfolder\myfile.exe") 
End Sub

Function StripPath(T$) As String
Dim x%, ct%
StripPath$ = T$
x% = InStr(T$, "\")
Do While x%
  ct% = x%
  x% = InStr(ct% + 1, T$, "\")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function

Press F5 and run the project

T&T#9) GET FILE EXTENSION

Open the new Standard.Exe project, double click Form1 and enter the following code:

Private Sub Form_Load()
    MsgBox GetExtension("c:\myfolder\myfile.exe")
End Sub

Function GetExtension(FileName As String)
    Dim PthPos, ExtPos As Integer
    For i = Len(FileName) To 1 Step -1
        If Mid(FileName, i, 1) = "." Then
            ExtPos = i
            For j = Len(FileName) To 1 Step -1
                If Mid(FileName, j, 1) = "\" Then
                    PthPos = j
                    Exit For
                End If
            Next j
            Exit For
        End If
    Next i
    If PthPos > ExtPos Then
        Exit Function
    Else
        If ExtPos = 0 Then Exit Function
        GetExtension = Mid(FileName, ExtPos + 1, _
                       Len(FileName) - ExtPos)
    End If
End Function
Press F5 and run the project

T&T#10) GET DIRECTORY SIZE

Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:

Private Sub Command1_Click()
  MsgBox "Directory Size C:\Windows = " & _
  Format(SizeOf("C:\Windows"), "#,#") & _
  " bytes", vbInformation, "Directory Size"
End Sub

Public Function SizeOf(ByVal DirPath As String) As Double
Dim hFind As Long
Dim fdata As WIN32_FIND_DATA
Dim dblSize As Double
Dim sName As String
Dim x As Long
On Error Resume Next
  x = GetAttr(DirPath)
  If Err Then SizeOf = 0: Exit Function
  If (x And vbDirectory) = vbDirectory Then
     dblSize = 0
     Err.Clear
     sName = Dir$(EndSlash(DirPath) & "*.*", vbSystem _
            Or vbHidden Or vbDirectory)
     If Err.Number = 0 Then
        hFind = FindFirstFile(EndSlash(DirPath) & _
                "*.*", fdata)
       If hFind = 0 Then Exit Function
        Do
        If (fdata.dwFileAttributes And vbDirectory) = _
           vbDirectory Then
           sName = Left$(fdata.cFileName, _
                InStr(fdata.cFileName, vbNullChar) - 1)
           If sName <> "." And sName <> ".." Then
              dblSize = dblSize + _
                      SizeOf(EndSlash(DirPath) & sName)
            End If
          Else
            dblSize = dblSize + fdata.nFileSizeHigh * _
                      65536 + fdata.nFileSizeLow
          End If
          DoEvents
        Loop While FindNextFile(hFind, fdata) <> 0
        hFind = FindClose(hFind)
     End If
  Else
     On Error Resume Next
     dblSize = FileLen(DirPath)
  End If
  SizeOf = dblSize
End Function

Private Function EndSlash(ByVal PathIn As String) As String
  If Right$(PathIn, 1) = "\" Then
     EndSlash = PathIn
  Else
     EndSlash = PathIn & "\"
  End If
End Function

Click Project -> Add Module, double klik Module1 and enter the following code :

Public Const MAX_PATH = 260
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
  
Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
  
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long

Press F5 and run the project

T&T#11) DELETE FILE TO RECYCLE BIN

Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:

Private Sub Command1_Click()
Dim MyBool As Boolean
  DelToRecycBin ("c:\My Documents\MyFile.Zip")
End Sub

Public Function DelToRecycBin(FileName As String)
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
On Error GoTo DelToRecycBin_Err
  With FileOperation
     .wFunc = F0_DELETE
     .pFrom = FileName
     .fFlags = F0F_ALLOWUNDO + F0F_CREATEPROGRESSDLG
  End With
  lReturn = SHFileOperation(FileOperation)
  Exit Function
DelToRecycBin_Err:
  MsgBox Err.Number & Err.Description
End Function

Click Project -> Add Module, double klik Module1, and enter the following code :

'Depend on your windows setting if you disable delete to recycle bin
'file akan will be deleted permanently

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const F0_DELETE = &H3
Public Const F0F_ALLOWUNDO = &H40
Public Const F0F_CREATEPROGRESSDLG As Long = &H0

Press F5 and run the project

Handling TextBox In Visual Basic 6.0

TextBox is one of the most important components in the visual-based programming environment, because this component will accept the data input from the user, the lack of attention to this component will be very fatal, ranging from Runtime Error to Invalid data and others.

Here are some tips and tricks in handling textbox :



T&T#1) ONLY ACCPET NUMERIC VALUE
For the demo please open a new project, select standard exe, then place a textbox for experiment material and set with the following properties:

Name : Text1
Text : (clear)

Then press F7 to switch to view code mode, or through the View -> Code menu, then type in the following code :
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii >= Asc("0") & Chr(13) _
    And KeyAscii <= Asc("9") & Chr(13) _
        Or KeyAscii = vbKeyBack _
        Or KeyAscii = vbKeyDelete _
        Or KeyAscii = vbKeySpace) Then
            Beep
            KeyAscii = 0
   End If
End Sub 
Press F5, and see the result

Based on the above code then the data that we entry into the textbox only receive numerical data, and some other key like BackSpace, Delete and Space.

T&T#2) ONLY ACCPET UPPER CASE ENTRY INTO THE TEXTBOX
Open the new project Standard Exe, then place 2 pieces of textbox with the following properties :
Name : Text1
Text : (empty)

Name : Text2
Text : (empty)

Press F7, or select View -> Code, then type the following code :
Private Sub Text1_Change()
'Text1 menggunakan event Change
Dim posisi As Integer
    posisi = Text1.SelStart
    Text1.Text = UCase(Text1.Text)
    Text1.SelStart = posisi
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
'Text2 menggunakan event KeyPress
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub 
Press F5 and see the result

T&T#3) ONLY ACCEPT LOWER CASE ENTRY INTO THE TEXTBOX
Open the new project Standard Exe, then place 2  textbox with the following properties :
Name : Text1
Text : (empty)

Name : Text2
Text : (empty)

Press F7, or select View -> Code, then type the following code :
Private Sub Text1_Change()
'Text1 use event Change
    Dim posisi As Integer
    posisi = Text1.SelStart
    Text1.Text = LCase(Text1.Text)
    Text1.SelStart = posisi
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
'Text2 use KeyPress
    KeyAscii = Asc(LCase(Chr(KeyAscii)))
End Sub 
Press F5 and see the result

T&T#4) CLEAR ALL TEXTBOX VALUE
Open a new project and place 4 textbox, and 1 commanbutton, let the default property settings do not need to change name or any other properties.

Press F7, and type in the following code :
Private Sub Command1_Click()
    Dim Contrl As Control
    For Each Contrl In Form1.Controls
        If (TypeOf Contrl Is TextBox) Then Contrl.Text = ""
    Next Contrl
End Sub 
Press F5 and see the result

T&T#5) AVOID CERTAIN CHARACTER ENTRY
Open the new Standard Exe project, then place a textbox and leave the default name 'Text1', then press F7 and type the following code :
Private Sub Text1_KeyPress(KeyAscii As Integer)
    Dim sTemplate As String
    'Ganti '!@#$%^&*()_+=' dengan karakter yang Anda
    'inginkan untuk dihindari diinput pada Text1
    sTemplate = "!@#$%^&*()_+="
    If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then _
    KeyAscii = 0
End Sub 
Note the code above, each data that we input in the textbox will be accepted except the characters contained in the sTemplate variable

Press F5 and see the result


T&T#6) CALCULATING THE WORD IN TEXTBOX
Open the new Standard Exe project, and place 1 textbox and 1 commandbutton, and set it with the following properties :

TextBox
Name : Text1
Text : (empty)

CommandButton
Name : cmdCount
Caption : &Count

Press F7 and type in the following code :
Private Sub cmdCount_Click()
    'Type a few sentences long enough
    'thus containing up to tens or even hundreds
    'words to try the word count function below.
    MsgBox GetWordCount(Text1.Text)
End Sub

Public Function GetWordCount(ByVal Text As String) As Long
'Define a hyphen at each end
'lines that are part of the whole word,
'so combine together.
    Text = Trim(Replace(Text, "-" & vbNewLine, ""))
    'Replace a new row with a single space
    Text = Trim(Replace(Text, vbNewLine, " "))
    'Replace a space more than one (if any)
    'into a single space
    Do While Text Like "*  *"
        Text = Replace(Text, "  ", " ")
    Loop
    'Separate the string and return the calculated word
    GetWordCount = 1 + UBound(Split(Text, " "))
End Function 
Press F5 and see the result

T&T#7) POP UP MENU IN TEXTBOX
Open the new Standard Standard project, and place 1 textbox and name it Text1, and make a menubar, you can specify what is inside the menubar, note the illustration below


Press F7 and type in the following code :
Private Const WM_RBUTTONDOWN = &H204
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Sub OpenContextMenu(FormName As Form, menuName As Menu)
  Call SendMessage(FormName.hwnd, WM_RBUTTONDOWN, 0, 0&)
  FormName.PopupMenu menuName
End Sub

Private Sub Form_Load()
  MyMenu.Visible = False  'To be invisible at the top of the form
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
  'Replace 'MyMenu' with the menu you want to appear as pop up.
If Button = vbRightButton Then _
    Call OpenContextMenu(Me, Me.MyMenu)
End Sub
Press F5 and see the result
Right click on the textbox and a pop up menu will appear


T&T#8) HIGHLIGHT ALL CHARACTERS IN TEXTBOX
Open the new Standard Exe project, then place a textbox and set its properties as follows :
Name : Text1
Text : http://ilmalyakin.blogspot.com

Press F7 and type in the following code :
Private Sub Text1_GotFocus()
  Text1.SelStart = 0
  Text1.SelLength = Len(Text1)
End Sub
Press F5 and see the result


T&T#9) TEXTBOX VALIDATION
Open the new Standard Uns project, then place 2 textbox and 1 commandbutton, and set it with the following properties :

TextBox
Name : Text1
Text : (empty)

Name : Text2
Text : (empty)

CommandButton
Name : cmdExit
Caption : &Exit

Press F7 and type in the following code :
Private Sub cmdExit_Click()
    End
End Sub

Private Sub Text1_Validate(Cancel As Boolean)
    Cancel = Text1.Text <> "abc"
End Sub
Press F5 an see the result

In this example, the cursor will not be able to exit the textbox until the user types "abc".

That's it, some of the common task in TextBox

Good luck.

Create Your Own ActiveX Control With Visual Basic 6

This time I try to share one of the examples of activex control project is quite simple that is making a timepiece, well without any longer let's start



Open the new project with ActiveX Control project type, different from the usual project that is displayed is not the form but the user controls, change the name of the project into MyWatch, then change its user controls to Watch, BorderStyle becomes 0 - None


Then insert a label into the form and set its property to:
Name: lblJam
Appearance: 0 - Flat
Autosize: True
BackColor: & H00E0E0E0 &
BorderStyle: 1 - Fixed Single
Caption: 00:00:00
Font: Ms Sans Serif
Font Style: Bold

The next step we enter a Timer, then set its properties
Name : tmrJam
Interval : 1000

Then move the label that we made to the top left corner of the form, then minimize the size of the form of the label we created earlier


Well until here we save the first project that we created, for the user controls give the name MyWatch.ctl file, for his project give the name MyWatch.vbp

After the design interface is complete, when it is to add code into the project, double click on user controls add the following code:

Private Sub UserControl_Initialize()
    lblJam.Caption = Time
    tmrJam.Enabled = True
End Sub

The Initialize sub procedure will be loaded first when the component is first loaded on the form, then add the following code:

Private Sub tmrJam_Timer()
Dim jam
    jam = Time()
    lblJam.Caption = jam
End Sub 

The above procedure will be called when the component is dragged or slid on the form, to specify the font to use, we use the SET function and to read the value we use the GET function, add the following code:

Public Property Set Font(ByVal NewFont As Font)
    Set lblJam.Font = NewFont
    PropertyChanged "Font"
End Property

Public Property Get Font() As Font
    Set Font = lblJam.Font
End Property 

we know each activex control that we have drag into a form then each control will have property value, with SET procedure we can specify some value that we will change in its properties, while the GET procedure later that will take value on the properties and will be applied when an activex control is dragged or slid into a form

Then we add an Event that will be triggered in the event of a change in the activex control

Make sure your cursor is in position (General) (Declaration),

Then type the following code:

Public Event change() 

This event we need to detect if there is a change in the activex control that will run a procedure we named SetTime (), type the following code:

Private Sub SetTime(ByVal waktu As String)
    lblJam.Caption = waktu
    RaiseEvent change
End Sub 

This procedure will trigger Event change () to run, which will parse a time variable and adjust it to the clock label

To read changes to global properties for fonts, we read through ReadProperties on the UserControl object, in this section the global properties will be read

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    lblJam.Font = PropBag.ReadProperty("Font", Ambient.Font)
    lblJam.FontBold = PropBag.ReadProperty("FontBold", _
                      Ambient.Font.Bold)
    lblJam.FontSize = PropBag.ReadProperty("FontSize", _
                      Ambient.Font.Size)
End Sub 

To write the changes that occur on the global property for the font, we do through WriteProperties on the UserControl object

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Font", lblJam.Font, Ambient.Font)
    Call PropBag.WriteProperty("FontBold", lblJam.FontBold, _
         Ambient.Font.Bold)
    Call PropBag.WriteProperty("FontSize", lblJam.FontSize, _
         Ambient.Font.Size)
End Sub 

Procedure is what will make some property values into one unity or become part of the activex itself

Now it is almost finished, now we can save the project, then try to run the project press F5, and see the results that will be opened on the browser that we use

The next step is to compile the project we have created, click the File menu and select Make MyWatch.ocx, then specify the location of the folder where the ocx we will put it, then click the Ok button, now activex control we have successfully created

Now it's time we add the new activex control we created into our application project, open one of your projects, or create a new Standard.exe app, right click on Toolbox, select Components ..., after show click browse button, then search ocx file that we have created "MyWatch.ocx", then click Open, now in the Toolbox there will be a new component that is MyWatch, try to add to the form, the initial view of the ocx is the current time.


SQL Server Data Type

Determining the right data type is a good database implementation and administration technique. By implementing effective and efficient data types, you can save hard drive space and data processing time from your SQL Server.

Here are some of the built-in data types found in SQL Server along with the space required on the hard drive when implementing it:



  • Bit
The bit data type can only accept input numbers 1 and 0 as values (or it could be null, meaning no value). This data type is helpful if you want to generate the output yes / no, true / false, etc.

  • Int
This data type may already be familiar to you. This data type can receive values ranging from -231 (-2,147,483,648) to 231-1 (2,147,483,647). This data type consumes 4 bytes to store data on the hard drive.

  • Bigint
This data type is similar to int, only the received value is greater than int. This data type can receive values ranging from -263 (-9,223,372,036,854,775,808) to 263-1 (-9,223,372,036,854,775,807). This data type consume 8 bytes to store data on the hard drive.

  • Smallint
This data type is also similar to int, only the received value is smaller than int. This data type can receive values ranging from -215 (-32,768) to 215-1 (32767). This data type requires only 2 bytes to store data on the hard drive.

  • Tinyint
This data type receives a value smaller than smallint. Acceptable values range from 0 to 255, and require only 1 bytes to store data on the hard drive.

  • Decimal
This data type receives a more precise value than the integer data types discussed earlier. This data type uses 2 parameters to determine the level of precision of the value received; precision and scale. Precision is the number of digits that can be received by the field, while the scale is the number of numbers behind the comma that can be accepted by the field. So, if we make the precision parameter as much as 5 and scale 2 then field we can accept value like this: 123,45. This data type can receive values ranging from -1038 to 1038-1. This data type consumes 5-17 bytes to store data on the hard drive, depending on the precision of the inserted value.

  • Numeric
This data type is basically the same as the decimal data type. So this data type can be called a synonym of decimal.

  • Money
This data type can receive values ranging from -263 (-9,223,372,036,854,775,808) to 263-1 (-9,223,372,036,854,775,807). This data type consumes 8 bytes to store data on the hard disk.

  • Smallmoney
This data type is basically the same as the data type of money, only the received value is smaller, ranging from -214,748,3648 to 214,748,3647. This data type consumes 4 bytes to store data on the hard drive.

  • Float
This data type is similar to the decimal data type, it's just that the paramater scale on this data type can accept infinite value, as in the value of pi. This data type can receive values ranging from -1.79E + 308 to 1.79E +308. If you are describing a field with a data type like this: float (2), then the output value of pi (for example) is 3.14. The number 2 inside the brackets explains how many numbers should be displayed behind the comma. This data type consumes 4-8 bytes to store data on the hard drive.

  • Real
This data type is similar to the float data type, it just receives a smaller value than the float, which starts from -3.40E +38 to 3.40E +38. This data type consumes 4 bytes to store data on the hard drive.

  • Datetime
This data type can receive date and time values from 1 January 1753 to 31 December 9999. This data type consumes 8 bytes to store data on the hard disk..

  • Smalldatetime
This data type can receive dates and times from January 1, 1900 to June 6, 2079, with the accuracy of the time used is minutes. This data type consumes 4 bytes to store data on the hard disk..

  • Timestamp

This data type is used to record records when new data is inserted and updated. This data type is very useful to find out the changes that occur in your database.

  • Uniqueidentifier
This data type works to create a unique value that might look like this 6F9619FF-8B86-D011-B42D-00C04FC964FF. This data type is useful if you want to create a unique serial number or id.

  • Char
This data type can be used to enter non-Unicode character data with a fixed number of characters. This data type can accept up to 8000 characters, and the number of bytes required depends on the number of characters entered. 1 character requires 1 bytes, so if you define it like this: char (5) then the field can only accept characters as many as 5 characters with space needed to store data on hard drive as much as 5 bytes.

  • Varchar
This data type is similar to the char data type, but this data type is useful for you who do not know exactly the number of characters that will be entered by the user. This data type can also receive values up to 8000 characters. So if in the char data type, you define char (5), then you will always need 5 bytes to store data on the hard disk, although the number of characters entered is only 1 to 4 characters; then in this type of data, the number of bytes required will be more flexible. For example if you define varchar (30) for a field, then the field can receive data up to 30 characters (30 bytes), but if you only enter 1 character, then the number of bytes required is only 1 bytes.

  • Varchar(max)
This data type is also similar to varchar, it's just, the acceptable value reaches 2^31-1 (2,147,438.67) bytes of data.

  • Nchar
This type of data is similar to the char data type, but this data type can accept Unicode values or data (in contrast to char data types that can only accept non-Unicode character values). This data type can receive values up to 4000 characters. This data type consumes 2-8000 bytes to store data on the hard disk. Why it takes 2-8000 bytes? Because this data type multiplies 2 bytes for each character. So if the user only enter 1 character, it takes 2 bytes to store data on the hard drive.

  • Nvarchar
This data type is similar to the varchar data type, but this data type can accept Unicode values or data. This data type can also receive values up to 4000 characters.

  • Nvarchar(max)

This data type is similar to varchar data type (max), but this data type can accept Unicode value or data. This data type can accept characters up to 2 31 - 1 (2,147,483,67) bytes data.

  • Binary
This data type can receive binary data with a maximum of 8000 bytes of data. This data type is interpreted as a string of bits eg (110011001011).

  • Varbinary
This data type is similar to varchar, it's just acceptable value only binary data. This data type is useful for storing unknown binary data with exact number of bytes of data.

  • Xml
This data type is useful for storing data in XML Document format. This data type can store data up to 2Gb. This data type is a new data type contained in SQL Server.


That's it, a brief explanation of some data types contained in SQL Server. Although there are actually some other types of data built-in, but the data type above is the type of data that we often use.