PathCompactPathEx - Untuk Menyingkat Nama Path - VB6

Dalam membuat sebuah program, terkadang kita membutuhkan nama path yang disingkat, adapun tujuannya, agar nama yang berada paling akhir dapat kita baca. Lagipula jika path tidak disingkat, mungkin kita akan menemukan MRU (Most Recently Used) seperti pada gambar di bawah ini: (sebenarnya tidak se-ekstrim itu, hanya saja saya membuatnya menjadi panjang)

Untuk menyingkat nama path, kita membuhtuhkan fungsi API PathCompactPathEx. Berikut merupakan contoh kode untuk menyingkat nama path:

Option Explicit 
 
Private Declare Function PathCompactPathEx Lib "shlwapi.dll" Alias "PathCompactPathExA" ByVal pszOut As String, ByVal pszSrc As String, ByVal cchMax As Long, ByVal dwFlags As Long) As Long 
 
'simpan dalam modul 
Public Function ShortFilePath(FilePath As String, Optional MaxLen As Long = 40) As String 
    Dim ShortPath As String 
    On Error Resume Next 
    ShortPath = String(255, 0) 
    PathCompactPathEx ShortPath, FilePath, MaxLen, 0 
    ShortFilePath = ShortPath 
End Function 

Contoh penggunaan prosedur di atas:

Private Sub Form_Load() 
    Text1.Text = ShortFilePath("F:\Project\Outlook Bar control + Photoshop Color Picker v1.3.2\3. Samples\Images") 
    'akan menghasilkan "F:\Project\Outlook Bar   con...\Images" 
End Sub 

READ MORE - PathCompactPathEx - Untuk Menyingkat Nama Path - VB6

Fungsi Format RTF Untuk Pembuatan Kamus Bahasa Inggris

Di bawah ini merupakan contoh format RTF untuk keperluan pembuatan kamus Bahasa Inggris. Fungsi di bawah ini dapat bekerja dengan sangat cepat? mengapa? karena ia tidak memformat tulisan pada objeknya secara langsung akan tetapi, memformat string yang terdapat dalam memori kemudian mem-feed-nya kembali ke dalam objek RichTextBox.

Bukankah:

Private Sub Command1_Click() 
    Dim i As Integer 
    For i = 1 To 1000 
        Text1.Text = Text1.Text & "contoh tulisan" & vbCrLf 
    Next 
End Sub 

Berbeda dengan kode di bawah ini:

Private Sub Command1_Click() 
    Dim i As Integer 
    Dim sText   As String 
    sText = Text1.Text 
    For i = 1 To 1000 
        sText = sText & "contoh tulisan" & vbCrLf 
    Next 
    Text1.Text = sText 
End Sub 

Sepintas dua kode di atas akan memberikan hasil yang sama akan tetapi berbeda jauh dalam segi kecepatan.

Di bawah ini merupakan fungsi format RTF untuk pembuatan kamus bahasa inggris:

Option Explicit 
 
Public Function FormatSentence(sSentence As String) As String 
    Dim sFormat As String 
    Dim sKosakata   As String 
    Dim sText As String 
    Dim i As Integer 
    sFormat = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" & vbCrLf & _ 
    "{\colortbl ;\red128\green0\blue0;\red0\green0\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green0\blue0;\red128\green0\blue128;}" & vbCrLf & _ 
    "{\*\generator Msftedit 5.41.15.1512;}\viewkind4\uc1\pard\ltrpar\lang1033\f0\fs17" 
    sKosakata = sSentence 
    sText = " " & Text1.Text 
    sText = Replace(sText, vbCrLf, " \Par"   & vbCrLf) 
    sText = Replace(sText, " kb. ", " \cf2\b kb. \cf0\b0 ") 
    sText = Replace(sText, " -kki. ", " \cf5\b kki. \cf0\b0 ") 
    sText = Replace(sText, " kk. ", " \cf1\b kk. \cf0\b0 ") 
    sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ") 
    sText = Replace(sText, " -ks. ", " \cf3\b -ks. \cf0\b0 ") 
    sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ") 
    sText =   Replace(sText, "(", "\cf5(\cf0 ") 
    sText = Replace(sText, ")", "\cf5)\cf0 ") 
    For i = 1 To 100 
        If InStr(1, sText, i) Then 
            sText = Replace(sText, " " & i & " ", " \b " & i & " \cf0\b0 ") 
        End If 
    Next 
    sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ") 
    sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ") 
    sText = sFormat & "\b " & sKosakata & "\b0 " & sText & "\par" & vbCrLf & "}" 
    FormatSentence = sText 
End Function 
 
Private Sub Form_Load() 
    RTF.BackColor = RGB(241, 243, 241) 
End Sub 

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    RTF.TextRTF = FormatSentence(Text2.Text) 
End Sub 

Maka hasilnya seperti gambar di bawah ini:

Catatan:
Fungsi di atas hanyalah sekadar contoh, Anda dapat memodifikasinya untuk disesuaikan dengan kebutuhan.

Download: Source code fungsi format RTF untuk Kamus Bahasa Inggris

READ MORE - Fungsi Format RTF Untuk Pembuatan Kamus Bahasa Inggris

Fungsi Untuk Membuat Kata Secara Acak

Di bawah ini merupakan fungsi untuk membuat sebuah kata secara acak.

Option Explicit 
 
Public Function RandomString(Optional Max As Integer = 5) As String 
 
    Dim sAlpha As String 
    Dim iLoop As Integer 
    Dim iRandNum As Integer 
    Dim sMatch As String 
    Dim str As String 
    sAlpha = "abcdefghijklmnopqrstuvwxyz" 
 
    Randomize 
 
    For iLoop = 1 To Max 
        iRandNum = Int((26   - 1 + 1) * Rnd + 1) 
        sMatch = Mid(sAlpha, iRandNum, 1) 
        str = str & sMatch 
    Next iLoop 
 
    RandomString = str 
 
End Function 

Contoh penggunaan fungsi menampilkan kata secara acak

Private Sub Command1_Click() 
    MsgBox RandomString 10 
End Sub 

READ MORE - Fungsi Untuk Membuat Kata Secara Acak

Menjadikan Input TextBox Kapital

Option Explicit 
 
'This one line code makes the contents of text box in capital. As you keep in typing it. Just copy this code keypress  
Private Sub Text1_KeyPress(KeyAscii As Integer) 
    KeyAscii = Asc(UCase(Chr(KeyAscii))) 
End Sub 

READ MORE - Menjadikan Input TextBox Kapital

Fungsi Encode dan Decode Tag HTML

Kode HTML yang dituliskan dalam sebuah tulisan/postingan tentu saja tidak dapat ditulis secara langsung tetapi harus dikonversi terlebih dahulu agar format tulisannya sesuai dengan apa yang diharapkan. Perlu kita ketahui bahwa mesin penerjemah (compiler) akan menganggap tulisannya merupakan kode HTML dan menerjemahkannya, padahal yang kita maksud adalah tulisan, tulisan yang mengandung kode HTML . Dibawah ini merupakan fungsi encode dan decode tag HTML yang bisa Anda gunakan ketika membuat tulisan/postingan yang melibatkan banyak kode/tag HTML.

Option Explicit 
 
Dim EncodeTag() As String 
Dim DecodeTag() As String 
 
Enum eType 
    Decode 
    Encode 
End Enum 
 
Public Function   EncDecTag(strText As String, EncDec As eType) As String 
    Dim i As Integer 
    InitTagArray 
    For i = LBound(EncodeTag) To UBound(EncodeTag) 
        If EncDec = Encode Then 
            strText = Replace(strText, EncodeTag(i), DecodeTag(i), , , vbTextCompare) 
        Else 
            strText = Replace(strText, DecodeTag(i), EncodeTag(i), , , vbTextCompare) 
        End If 
    Next 
    EncDecTag = strText 
End Function 
 
Private Function InitTagArray() 
    Dim EncTag As String 
    Dim DecTag As String 
    EncTag = &quot;&amp;,<,>,&quot; &amp; Chr(34) &amp; &quot;,&plusmn;&quot; 
    DecTag = &quot;&amp;amp;,&amp;lt;,&amp;gt;,&amp;quot;,&amp;plusmn;&quot; 
    EncodeTag = Split(EncTag, &quot;,&quot;) 
    DecodeTag = Split(LCase(DecTag), &quot;,&quot;) 
End Function 

Cara Penggunaan Fungsi Encode dan Decode Tag HTML

Private   Sub Command1_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Decode) 
End Sub 
 
Private Sub Command2_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Encode) 
End Sub 

READ MORE - Fungsi Encode dan Decode Tag HTML

Fungsi Compressor CSS Opsi Super Compact | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi super compact. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css compress ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi super compact

Option Explicit 
 
Function CSSCompressSuperCompact(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "")   
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
    Next 
    CSSCompressSuperCompact = sTextCSS 
End Function 

Contoh penggunaan css compress opsi super compact

Private Sub   Command1_Click() 
    Text1.Text = CSSCompressSuperCompact(Text1.Text) 
End Sub 

READ MORE - Fungsi Compressor CSS Opsi Super Compact | Visual Basic 6.0

Fungsi CSS Decompress Untuk Editing | Visual Basic 6.0

Artikel ini berjudul fungsi css decompress untuk editing. Maksud dari css decompress untuk editing ialah sebuah fungsi (procedure) yang digunakan untuk mengembalikan format css yang telah dicompress. Kita tahu bahwa css yang telah dicompress tentu saja akan menyulitkan pada saat kita ingin mengeditnya kembali. Bagaimana fungsi css decompress ini?

Fungsi css decompress untuk editing

Option Explicit 
 
Public Function CSSDecompress(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = CSSDelSpace(sText) 
    sTextCSS = Replace(sTextCSS, "{", "{" & vbCrLf) 
    sTextCSS = Replace(sTextCSS, "}", "}" & vbCrLf & vbCrLf) 
    sTextCSS = Replace(sTextCSS, ";", ";" & vbCrLf) 
    CSSDecompress = sTextCSS 
End Function 
 
Private Function CSSDelSpace(sText As String) As String 
    Dim sTextCSS As String 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    CSSDelSpace = sTextCSS 
End Function   

Contoh penggunaan fungsi css decompress untuk editing

Private Sub Command2_Click() 
    Text1.Text = CSSDecompress(Text1.Text) 
End Sub 
 

READ MORE - Fungsi CSS Decompress Untuk Editing | Visual Basic 6.0

Fungsi Untuk Compressor CSS Opsi Normal | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi normal. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css compress ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi normal

Option Explicit 
 
Function CSSCompressNormal(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    Dim i As Integer 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    sTextCSS = Replace(sTextCSS, vbCrLf, "") 
    sTextCSS = Replace(sTextCSS, "}", "}" & vbCrLf) 
    sTextCSS = Replace(sTextCSS, "*/", "*/" & vbCrLf) 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
      Next 
    CSSCompressNormal = sTextCSS 
End Function 

Contoh penggunaan css compress opsi normal

Private Sub Command1_Click() 
    Text1.Text = CSSCompressNormal(Text1.Text) 
End Sub 

READ MORE - Fungsi Untuk Compressor CSS Opsi Normal | Visual Basic 6.0

Fungsi CSS Compressor Opsi Light | Visual Basic 6.0

Artikel di bawah ini kami beri judul fungsi css compress opsi light. Apa yang dimaksud dengan css compress ini, bisa Anda lihat pada link disamping ini [css compress]. Nah, sekarang Anda faham mengenai apa tujuan, kegunaan dan mengapa kode css dikompres. Bagaimana implementasi kode css ini pada pemrograman Visual Basic 6.0? bisa Anda lihat kodenya di bawah.

Kode fungsi css compress opsi light

Option Explicit 
 
Public Function CSSCompressLight(sText As String) As String 
    Dim sTextCSS As String 
    Dim arrCSS() As String 
    sTextCSS = sText 
    sTextCSS = Replace(sTextCSS, " ", "") 
    arrCSS = Split(sTextCSS, vbCrLf) 
    sTextCSS = "" 
    For i = LBound(arrCSS) To UBound(arrCSS) 
        If arrCSS(i) <> "" Then 
            sTextCSS = sTextCSS & arrCSS(i) & vbCrLf 
        End If 
    Next 
    CSSCompressLight = sTextCSS 
End Function 

Cara penggunaan fungsi css compress opsi light

Private Sub Command1_Click() 
    Text1.Text = CSSCompress(Text1.Text) 
End Sub 

READ MORE - Fungsi CSS Compressor Opsi Light | Visual Basic 6.0

Hanya 1 Baris Untuk Validasi Angka - Visual Basic 6

Di bawah ini merupakan kode untuk memvalidasi angka pada sebuah TextBox, maksudnya pada objek TextBox tersebut hanya memperbolehkan angka saja. Kodenya sangat sederhana, hanya satu baris saja yaitu: KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)

Contoh penggunaan:

Private Sub Text1_KeyPress(KeyAscii As Integer) 
    KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0) 
End Sub 

Kode di atas tentu saja bisa dikembangkan lebih baik, misalnya untuk angka di belakang koma, dsb.

READ MORE - Hanya 1 Baris Untuk Validasi Angka - Visual Basic 6

Cara Termudah Memperoleh Decimal Symbol - Visual Basic 6

Ini bisa dikatakan sebagai cara termudah untuk memperoleh decimal symbol dari regional setting, adapun kodenya adalah sebagai berikut:

Public Function GetDecimalSymbol() As Integer 
    'akan memperoleh 44 untuk koma (,) dan 46 untuk (.) dan lain sebagainya. 
    GetDecimalSymbol = Asc(Mid$(1 / 2, 2, 1)) 
End Function 

Apabila digabungkan dengan posting sebelumnya, maka dapat diperoleh validasi entry untuk numeric yang memperbolehkan angka di belakang koma, tapi bagaimana cara menggabungkannya?

READ MORE - Cara Termudah Memperoleh Decimal Symbol - Visual Basic 6