Tuesday, June 12, 2012

Collapsible Text - Solusi Menulis Kode Yang Panjang Pada Posting

Mengenai cara membuat expand/collapse pada class selector - Apa yang dimaksud dengan expand/collapse text itu? perhatikan di bawah (asumsinya kita memiliki satu atau beberapa kode yang panjang dalam sebuah posting):

Expand Code...
 Option Explicit 
 
'------------------------------------------------------------------------------- 
' ucTextBox (User Control TextBox for Database) 
' http://khoiriyyah.blogspot.com 
' -- Asep Hibban -- 
'------------------------------------------------------------------------------- 
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long 
 
Private Const EM_SETMARGINS = &HD3 
Private Const EC_LEFTMARGIN = &H1 
Private Const EC_RIGHTMARGIN = &H2 
 
Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
Private Type COMBOBOXINFO 
    cbSize As Long 
    rcItem As RECT 
    rcButton As RECT 
    stateButton  As Long 
    hwndCombo  As Long 
    hwndEdit  As Long 
    hwndList As Long 
End Type 
 
Private Const ECM_FIRST As Long = &H1500 
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1) 
 
Public Enum eTextConvertion 
    [GeneralConvertion] = 0 
    [UpperCase] = 1 
    [LowerCase] = 2 
    [ProperCase] = 3 
End Enum 
 
Public Enum eTextValidation 
    [GeneralValidation] = 0 
    [Alphabet] = 1 
    [AlphaNumeric] = 2 
    [Numeric] = 3 
End Enum 
 
Public Enum eAppearance 
    [Flat] = 0 
    [3D] = 1 
End Enum 
 
Public Enum eStyle 
    [Classic] = 0 
    [XP] = 1 
End Enum 
 
Public Enum eAlignment 
    [Left Justify] = 0 
    [Right Justify] = 1 
    [Center] = 2 
End Enum 
 
Public Enum eBorderStyle 
    [None] = 0 
    [Fixed Single] = 1 
End Enum 
 
Public Enum eDragMode 
    [Manual] = 0 
    [Automatic] = 1 
End Enum 
 
Public Enum eLinkMode 
    [None] = 0 
    [Automatic] = 1 
    [Manual] = 2 
    [Notify] = 3 
End Enum 
 
Public Enum eOLEDropMode 
    [None] = 0 
    [Manual] = 1 
    [Automatic] = 2 
End Enum 
 
Public Enum eOLEDragMode 
    [Manual] = 0 
    [Automatic] = 1 
End Enum 
 
Public Enum eScrollBars 
    [None] = 0 
    [Horizontal] = 1 
    [Vertical] = 2 
    [Both] = 3 
End Enum 
 
Public Enum eScaleMode 
    [User] = 0 
    [Twip] = 1 
    [Point] = 2 
    [Pixel] = 3 
    [Character] = 4 
    [Inch] = 5 
    [Millimeter] = 6 
    [Centimeter] = 7 
End Enum 
 
Public Enum eMousePointer 
    [Default] = 0 
    [arrow] = 1 
    [Cross] = 2 
    [i -Beam] = 3 
    [Icon] = 4 
    [Size] = 5 
    [Size NE SW] = 6 
    [Size N S] = 7 
    [Size NW SE] = 8 
    [Size W E] = 9 
    [Up arrow] = 10 
    [Hourglass] = 11 '(wait) 
    [No Drop] = 12 
    [Arrow and Hourglass] = 13 
    [Arrow and Question] = 14 
    [Size All] = 15 
    [Custom] = 99 
End Enum 
 
Public AutoSelection As Boolean 
Public AutoTab As Boolean 
Public TextConvertion As eTextConvertion 
Public TextValidation As eTextValidation 
Public AllowDecimal As Boolean 
Public Required As Boolean 
Public Information As Variant 
Private m_marginLeft As Integer 
Private m_marginRight As Integer 
Private m_CueBanner As String 
 
Event Click() 
Event DblClick() 
Event KeyDown(KeyCode As Integer, Shift As Integer) 
Event KeyPress(KeyAscii As Integer) 
Event KeyUp(KeyCode As Integer, Shift As Integer) 
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
 
Public Property Get BackColor() As OLE_COLOR 
    BackColor = Text1.BackColor 
End Property 
 
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) 
    Text1.BackColor() = New_BackColor 
    PropertyChanged "BackColor" 
End Property 
 
Public Property Get ForeColor() As OLE_COLOR 
    ForeColor = Text1.ForeColor 
End Property 
 
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR) 
    Text1.ForeColor() = New_ForeColor 
    PropertyChanged "ForeColor" 
End Property 
 
Public Property Get Enabled() As Boolean 
    Enabled = Text1.Enabled 
End Property 
 
Public Property Let Enabled(ByVal New_Enabled As Boolean) 
    Text1.Enabled() = New_Enabled 
    PropertyChanged "Enabled" 
End Property 
 
Public Property Get Font() As Font 
    Set Font = Text1.Font 
End Property 
 
Public Property Set Font(ByVal New_Font As Font) 
    Set Text1.Font = New_Font 
    PropertyChanged "Font" 
End Property 
 
Public Property Get BorderStyle() As eBorderStyle 
    BorderStyle = Text1.BorderStyle 
End Property 
 
Public Property Let BorderStyle(ByVal New_BorderStyle As eBorderStyle) 
    Text1.BorderStyle() = New_BorderStyle 
    PropertyChanged "BorderStyle" 
End Property 
 
Public Sub Refresh() 
    Text1.Refresh 
End Sub 
 
Private Sub Text1_Click() 
    RaiseEvent Click 
End Sub 
 
Private Sub Text1_DblClick() 
    RaiseEvent DblClick 
End Sub 
 
Private Sub Text1_GotFocus() 
    On Error Resume Next 
    If AutoSelection Then 
        Text1.SelStart = 0 
        Text1.SelLength = Len(Text1.Text) 
    End If 
End Sub 
 
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) 
    RaiseEvent KeyDown(KeyCode, Shift) 
End Sub 
 
Private Sub Text1_KeyPress(KeyAscii As Integer) 
    Dim intSelStart As Integer 
    Dim strText As String 
 
    RaiseEvent KeyPress(KeyAscii) 
    If AutoTab Then 
        If KeyAscii = 13 Then SendKeys "{Tab}" 
    End If 
    If KeyAscii = 8 Then 
        Exit Sub 
    End If 
    Select Case TextConvertion 
        Case GeneralConvertion 
        Case UpperCase 
            KeyAscii = Asc(StrConv(Chr(KeyAscii), vbUpperCase)) 
        Case LowerCase 
            KeyAscii = Asc(StrConv(Chr(KeyAscii), vbLowerCase)) 
        Case ProperCase 
            intSelStart = Text1.SelStart 
            strText = Text1.Text 
            strText = StrConv(strText, vbProperCase) 
            Text1.Text = strText 
            If Text1.SelLength = Len(Text1.Text) Then 
                Text1.SelStart = Len(Text1.Text) 
            Else 
                Text1.SelStart = intSelStart 
            End If 
    End Select 
 
    If TextValidation = Numeric Then 
        Dim intDummyDecimalSymbol As Integer 
        strText = Text1.Text 'hanya untuk mempercepat & mencegah dari terjadinya flick 
        intDummyDecimalSymbol = IIf(InStr(1, strText, Chr(GetDecimalSymbol)) = 0, GetDecimalSymbol, 0) 
        If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or _ 
        KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii = intDummyDecimalSymbol) Then 
        KeyAscii = 0 
    End If 
    On Error Resume Next 
    Text1.Text = strText 
    Exit Sub 
End If 
 
Select Case TextValidation 
    Case Alphabet 
        If Not Chr(KeyAscii) Like "*[a-zA-Z]*" Then 
            KeyAscii = 0 
        End If 
    Case AlphaNumeric 
        If Not Chr(KeyAscii) Like "*[a-zA-Z0-9]*" Then 
            KeyAscii = 0 
        End If 
End Select 
 
End Sub 
 
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) 
    RaiseEvent KeyUp(KeyCode, Shift) 
End Sub 
 
Private Sub Text1_LostFocus() 
    PropertyChanged "Text" 
End Sub 
 
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseDown(Button, Shift, X, Y) 
End Sub 
 
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseMove(Button, Shift, X, Y) 
End Sub 
 
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    RaiseEvent MouseUp(Button, Shift, X, Y) 
End Sub 
 
Public Property Get Alignment() As eAlignment 
    Alignment = Text1.Alignment 
End Property 
 
Public Property Let Alignment(ByVal New_Alignment As eAlignment) 
    Text1.Alignment() = New_Alignment 
    PropertyChanged "Alignment" 
End Property 
 
Public Property Get Appearance() As eAppearance 
    Appearance = Text1.Appearance 
End Property 
 
Public Property Let Appearance(ByVal New_Appearance As eAppearance) 
    Text1.Appearance() = New_Appearance 
    PropertyChanged "Appearance" 
End Property 
 
Public Property Get CausesValidation() As Boolean 
    CausesValidation = Text1.CausesValidation 
End Property 
 
Public Property Let CausesValidation(ByVal New_CausesValidation As Boolean) 
    Text1.CausesValidation() = New_CausesValidation 
    PropertyChanged "CausesValidation" 
End Property 
 
Public Property Get HideSelection() As Boolean 
    HideSelection = Text1.HideSelection 
End Property 
 
Public Property Get LinkItem() As String 
    LinkItem = Text1.LinkItem 
End Property 
 
Public Property Let LinkItem(ByVal New_LinkItem As String) 
    Text1.LinkItem() = New_LinkItem 
    PropertyChanged "LinkItem" 
End Property 
 
Public Property Get LinkMode() As eLinkMode 
    LinkMode = Text1.LinkMode 
End Property 
 
Public Property Let LinkMode(ByVal New_LinkMode As eLinkMode) 
    Text1.LinkMode() = New_LinkMode 
    PropertyChanged "LinkMode" 
End Property 
 
Public Property Get LinkTimeout() As Integer 
    LinkTimeout = Text1.LinkTimeout 
End Property 
 
Public Property Let LinkTimeout(ByVal New_LinkTimeout As Integer) 
    Text1.LinkTimeout() = New_LinkTimeout 
    PropertyChanged "LinkTimeout" 
End Property 
 
Public Property Get LinkTopic() As String 
    LinkTopic = Text1.LinkTopic 
End Property 
 
Public Property Let LinkTopic(ByVal New_LinkTopic As String) 
    Text1.LinkTopic() = New_LinkTopic 
    PropertyChanged "LinkTopic" 
End Property 
 
Public Property Get Locked() As Boolean 
    Locked = Text1.Locked 
End Property 
 
Public Property Let Locked(ByVal New_Locked As Boolean) 
    Text1.Locked() = New_Locked 
    PropertyChanged "Locked" 
End Property 
 
Public Property Get MaxLength() As Long 
    MaxLength = Text1.MaxLength 
End Property 
 
Public Property Let MaxLength(ByVal New_MaxLength As Long) 
    Text1.MaxLength() = New_MaxLength 
    PropertyChanged "MaxLength" 
End Property 
 
Public Property Get MouseIcon() As Picture 
    Set MouseIcon = Text1.MouseIcon 
End Property 
 
Public Property Set MouseIcon(ByVal New_MouseIcon As Picture) 
    Set Text1.MouseIcon = New_MouseIcon 
    PropertyChanged "MouseIcon" 
End Property 
 
Public Property Get MousePointer() As eMousePointer 
    MousePointer = Text1.MousePointer 
End Property 
 
Public Property Let MousePointer(ByVal New_MousePointer As eMousePointer) 
    Text1.MousePointer() = New_MousePointer 
    PropertyChanged "MousePointer" 
End Property 
 
Public Property Get MultiLine() As Boolean 
    MultiLine = Text1.MultiLine 
End Property 
 
Public Property Get OLEDragMode() As eOLEDragMode 
    OLEDragMode = Text1.OLEDragMode 
End Property 
 
Public Property Let OLEDragMode(ByVal New_OLEDragMode As eOLEDragMode) 
    Text1.OLEDragMode() = New_OLEDragMode 
    PropertyChanged "OLEDragMode" 
End Property 
 
Public Property Get OLEDropMode() As eOLEDropMode 
    OLEDropMode = Text1.OLEDropMode 
End Property 
 
Public Property Let OLEDropMode(ByVal New_OLEDropMode As eOLEDropMode) 
    Text1.OLEDropMode() = New_OLEDropMode 
    PropertyChanged "OLEDropMode" 
End Property 
 
Public Property Get PasswordChar() As String 
    PasswordChar = Text1.PasswordChar 
End Property 
 
Public Property Let PasswordChar(ByVal New_PasswordChar As String) 
    Text1.PasswordChar() = New_PasswordChar 
    PropertyChanged "PasswordChar" 
End Property 
 
Public Property Get RightToLeft() As Boolean 
    RightToLeft = Text1.RightToLeft 
End Property 
 
Public Property Let RightToLeft(ByVal New_RightToLeft As Boolean) 
    Text1.RightToLeft() = New_RightToLeft 
    PropertyChanged "RightToLeft" 
End Property 
 
Public Property Get ScrollBars() As eScrollBars 
    ScrollBars = Text1.ScrollBars 
End Property 
 
Public Property Get SelLength() As Long 
    SelLength = Text1.SelLength 
End Property 
 
Public Property Let SelLength(ByVal New_SelLength As Long) 
    Text1.SelLength() = New_SelLength 
    PropertyChanged "SelLength" 
End Property 
 
Public Property Get SelStart() As Long 
    SelStart = Text1.SelStart 
End Property 
 
Public Property Let SelStart(ByVal New_SelStart As Long) 
    Text1.SelStart() = New_SelStart 
    PropertyChanged "SelStart" 
End Property 
 
Public Property Get SelText() As String 
    SelText = Text1.SelText 
End Property 
 
Public Property Let SelText(ByVal New_SelText As String) 
    Text1.SelText() = New_SelText 
    PropertyChanged "SelText" 
End Property 
 
Public Property Get Text() As String 
    Text = Text1.Text 
End Property 
 
Public Property Let Text(ByVal New_Text As String) 
    Text1.Text() = New_Text 
    PropertyChanged "Text" 
End Property 
 
Public Property Get WhatsThisHelpID() As Long 
    WhatsThisHelpID = Text1.WhatsThisHelpID 
End Property 
 
Public Property Let WhatsThisHelpID(ByVal New_WhatsThisHelpID As Long) 
    Text1.WhatsThisHelpID() = New_WhatsThisHelpID 
    PropertyChanged "WhatsThisHelpID" 
End Property 
 
Private Sub UserControl_Initialize() 
    AutoSelection = True 
    AutoTab = True 
    AllowDecimal = False 
End Sub 
 
Private Sub MoveTextBox() 
    Text1.Move 0, 0, ScaleWidth, ScaleHeight 
End Sub 
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) 
    MoveTextBox 
    Text1.Text = PropBag.ReadProperty("Text", "Text1") 
    Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005) 
    Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008) 
    Text1.Enabled = PropBag.ReadProperty("Enabled", True) 
    Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font) 
    Text1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1) 
    Text1.Alignment = PropBag.ReadProperty("Alignment", 0) 
    Text1.Appearance = PropBag.ReadProperty("Appearance", 1) 
    Text1.CausesValidation = PropBag.ReadProperty("CausesValidation", True) 
    Text1.LinkItem = PropBag.ReadProperty("LinkItem", "") 
    Text1.LinkMode = PropBag.ReadProperty("LinkMode", 0) 
    Text1.LinkTimeout = PropBag.ReadProperty("LinkTimeout", 50) 
    Text1.LinkTopic = PropBag.ReadProperty("LinkTopic", "") 
    Text1.Locked = PropBag.ReadProperty("Locked", False) 
    Text1.MaxLength = PropBag.ReadProperty("MaxLength", 0) 
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing) 
    Text1.MousePointer = PropBag.ReadProperty("MousePointer", 0) 
    Text1.OLEDragMode = PropBag.ReadProperty("OLEDragMode", 0) 
    Text1.OLEDropMode = PropBag.ReadProperty("OLEDropMode", 0) 
    Text1.PasswordChar = PropBag.ReadProperty("PasswordChar", "") 
    Text1.RightToLeft = PropBag.ReadProperty("RightToLeft", False) 
    Text1.SelLength = PropBag.ReadProperty("SelLength", 0) 
    Text1.SelStart = PropBag.ReadProperty("SelStart", 0) 
    Text1.SelText = PropBag.ReadProperty("SelText", "") 
    Text1.WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", 0) 
    AutoSelection = PropBag.ReadProperty("AutoSelection", True) 
    AutoTab = PropBag.ReadProperty("AutoTab", True) 
    TextConvertion = PropBag.ReadProperty("TextConvertion", 0) 
    TextValidation = PropBag.ReadProperty("TextValidation", 0) 
    AllowDecimal = PropBag.ReadProperty("AllowDecimal", False) 
    Required = PropBag.ReadProperty("Required", True) 
    Information = PropBag.ReadProperty("Information", "") 
    m_marginLeft = PropBag.ReadProperty("MarginLeft", 0) 
    m_marginRight = PropBag.ReadProperty("MarginRight", 0) 
    m_CueBanner = PropBag.ReadProperty("CueBanner", "") 
    SetCueBanner Text1, m_CueBanner 
    SetMargin 
End Sub 
 
Private Sub UserControl_Resize() 
    MoveTextBox 
End Sub 
 
Private Sub UserControl_Show() 
    UserControl.Refresh 
    Text1.Refresh 
End Sub 
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) 
    Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005) 
    Call PropBag.WriteProperty("ForeColor", Text1.ForeColor, &H80000008) 
    Call PropBag.WriteProperty("Enabled", Text1.Enabled, True) 
    Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font) 
    Call PropBag.WriteProperty("BorderStyle", Text1.BorderStyle, 1) 
    Call PropBag.WriteProperty("Alignment", Text1.Alignment, 0) 
    Call PropBag.WriteProperty("Appearance", Text1.Appearance, 1) 
    Call PropBag.WriteProperty("CausesValidation", Text1.CausesValidation, True) 
    Call PropBag.WriteProperty("LinkItem", Text1.LinkItem, "") 
    Call PropBag.WriteProperty("LinkMode", Text1.LinkMode, 0) 
    Call PropBag.WriteProperty("LinkTimeout", Text1.LinkTimeout, 50) 
    Call PropBag.WriteProperty("LinkTopic", Text1.LinkTopic, "") 
    Call PropBag.WriteProperty("Locked", Text1.Locked, False) 
    Call PropBag.WriteProperty("MaxLength", Text1.MaxLength, 0) 
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing) 
    Call PropBag.WriteProperty("MousePointer", Text1.MousePointer, 0) 
    Call PropBag.WriteProperty("OLEDragMode", Text1.OLEDragMode, 0) 
    Call PropBag.WriteProperty("OLEDropMode", Text1.OLEDropMode, 0) 
    Call PropBag.WriteProperty("PasswordChar", Text1.PasswordChar, "") 
    Call PropBag.WriteProperty("RightToLeft", Text1.RightToLeft, False) 
    Call PropBag.WriteProperty("SelLength", Text1.SelLength, 0) 
    Call PropBag.WriteProperty("SelStart", Text1.SelStart, 0) 
    Call PropBag.WriteProperty("SelText", Text1.SelText, "") 
    Call PropBag.WriteProperty("Text", Text1.Text, "") 
    Call PropBag.WriteProperty("WhatsThisHelpID", Text1.WhatsThisHelpID, 0) 
    Call PropBag.WriteProperty("AutoSelection", AutoSelection, True) 
    Call PropBag.WriteProperty("AutoTab", AutoTab, True) 
    Call PropBag.WriteProperty("TextConvertion", TextConvertion, 0) 
    Call PropBag.WriteProperty("TextValidation", TextValidation, 0) 
    Call PropBag.WriteProperty("Text", Text1.Text, "Text1") 
    Call PropBag.WriteProperty("AllowDecimal", AllowDecimal, False) 
    Call PropBag.WriteProperty("Required", Required, True) 
    Call PropBag.WriteProperty("Information", Information, "") 
    Call PropBag.WriteProperty("MarginLeft", m_marginLeft, 0) 
    Call PropBag.WriteProperty("MarginRight", m_marginRight, 0) 
    Call PropBag.WriteProperty("CueBanner", m_CueBanner, "") 
End Sub 
 
Private Sub Text1_Change() 
    PropertyChanged "Text" 
End Sub 
 
Public Function GetDecimalSymbol() As Integer 
    If AllowDecimal Then GetDecimalSymbol = Asc(Mid$(1 / 2, 2, 1)) 
End Function 
 
Public Property Get MarginLeft() As Integer 
    MarginLeft = m_marginLeft 
End Property 
 
Public Property Let MarginLeft(ByVal New_MarginLeft As Integer) 
    m_marginLeft = New_MarginLeft 
    PropertyChanged "MarginLeft" 
    SetMargin 
End Property 
 
Public Property Get MarginRight() As Integer 
    MarginRight = m_marginRight 
End Property 
 
Public Property Let MarginRight(ByVal New_MarginRight As Integer) 
    m_marginRight = New_MarginRight 
    PropertyChanged "MarginRight" 
    SetMargin 
End Property 
 
Private Sub SetMargin() 
    Dim long_value As Long 
    Dim s As String 
    long_value = m_marginRight * &H10000 + m_marginLeft 
    SendMessage Text1.hwnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, long_value 
    s = Text1.Text 
    Text1.Text = "" 
    Text1.Text = s 
End Sub 
 
Public Property Get CueBanner() As String 
    CueBanner = m_CueBanner 
End Property 
 
Public Property Let CueBanner(ByVal New_CueBanner As String) 
    m_CueBanner = New_CueBanner 
    PropertyChanged "CueBanner" 
    SetCueBanner Text1, m_CueBanner 
End Property 
 
Private Sub SetCueBanner(obj As Object, str As String) 
    Dim s As String 
    s = StrConv(str, vbUnicode) 
    Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s) 
End Sub  
 
 

Untuk melakukannya dapat dengan cara melakukan link external atau secara internal (meng-embed-nya langsung pada template).

Cara Pertama (External):

  1. Download link disamping: http://khoiriyyah.vacau.com/expander.js

  2. Upload file expander.js kembali pada hosting Anda

  3. Login ke blogger.com

  4. Simpan di bawah tag <head> <script src='http://hostinganda/expander.js' type='text/javascript'></script>
  5. Pada postingan tulislah kode di bawah:
    <span style="color: #0000FF; text-decoration: underline; cursor: pointer;" onClick="toggleOverflowText('hiddenText1', this, 'Collapse Code...', 'Expand Code...', '200px');">Expand Code...</span>
    <pre class="code" id="hiddenText1" style="height: 200px";>Tulisan/Code yang akan di-expand/collapse</pre>


Cara Kedua (Embed Pada Template Blogger):


  1. Login ke blogger.com

  2. Klik Rancangan >> Edit HTML

  3. Simpan kode di bawah dimana saja antara tag <head> </head>
    <script type='text/javascript'>
    function toggleOverflowText (hiddenDivId, expander, expandText, collapseText, collapseHeight) {
        if (document.getElementById) {
            if (document.getElementById(hiddenDivId).style.height == &quot;&quot;) {
                document.getElementById(hiddenDivId).style.overflow = &quot;auto&quot;;
         document.getElementById(hiddenDivId).style.height = collapseHeight;
         expander.innerHTML = collapseText?collapseText:defaultHideText;
     } else {
                document.getElementById(hiddenDivId).style.overflow = &quot;auto&quot;;
         document.getElementById(hiddenDivId).style.height = &quot;&quot;;
         expander.innerHTML = expandText?expandText:defaultExpandText;
     }  
        }
    }
    </script>

  4. Pada postingan tulislah kode di bawah:
    <span style="color: #0000FF; text-decoration: underline; cursor: pointer;" onClick="toggleOverflowText('hiddenText1', this, 'Collapse Code...', 'Expand Code...', '200px');">Expand Code...</span>
    <pre class="code" id="hiddenText1" style="height: 200px";>Tulisan/Code yang akan di-expand/collapse</pre>


Catatan: 200px adalah tinggi dari class selector, Anda dapat menggantinya sesuai dengan tinggi class selector yang diinginkan, Anda juga dapat mengganti tag <pre></pre> dengan <div></div>, silakan berinovasi.
READ MORE - Collapsible Text - Solusi Menulis Kode Yang Panjang Pada Posting

Google Page Rank Monitor 1.0 - Blogger Tools

Ini merupakan aplikasi untuk melihat Google Page Rank. Sebagian besar source codenya saya ambil dari situs milik Leandro Ascierto, saya hanya sedikit menambahkan kode agar kompatibel dengan firefox.

Fitur-Fitur Google Page Rank Monitor 1.0:
  1. Portable
  2. Automatic Checker (tanpa membutuhkan verifikasi yang merepotkan)
  3. Kecil dan ringan
  4. Bekerja dengan baik pada koneksi internet yang lambat
  5. dan lain-lain
Kekurangannya:
  1. Untuk sementara hanya bekerja pada Firefox.
Cara menggunakan:
  1. Buka Firefox
  2. Klik install.bat untuk meregistrasikan komponen PageRank.dll
  3. Jalankan Google Page Rank Monitor 1.0
  4. Selesai.
Download: Google Page Rank Monitor 1.0

Catatan: Pada dasarnya, kita dapat melihat dengan mudah Google Page Rank melalui Google ToolBar. Aplikasi ini hanya sekedar contoh, apabila kita ingin membuat browser sendiri yang dilengkapi dengan Google Page Rank, atau fasilitas-fasilitas yang terdapat pada Google Toolbar dengan cara melakukan Request ke http://toolbar.google.com/.... (query).
READ MORE - Google Page Rank Monitor 1.0 - Blogger Tools

Hook Menu Dengan 4 Style Milik Leandro Ascierto

Anda tentu telah mengetahui hook menu yang dibuat oleh Vlad Vissoultchev dengan menggunakan teknik Subclassing Thunk. Nah, ini merupakan versi update yang dikembangkan oleh Leandro Ascierto. Memiliki satu properties tambahan yaitu .MenuLook, adapun pilihan dari 4 style tersebut, yaitu: MenuXP, MenuRibbon (office 2007), MenuVista, dan Menu2003 (office 2003). Adapun screenshootnya bisa Anda lihat di bawah:

Hook menu tidak membutuhkan kode, Anda hanya perlu menambahkan .ocx pada aplikasi yang Anda buat. Ini tentu saja akan sangat mempercepat pekerjaan, disamping tampilannya yang lebih menarik.
Hook menu 4 style bisa Anda download di: http://www.leandroascierto.com

Catatan: pada saat berhasil mendownload, bukalah filenya, disana Anda akan mendapati HookMenu.OCX, ketahuilah bahwa HookMenu.OCX tersebut masih milik Vlad (1 style). Adapun jika ingin memperoleh HookMenu.OCX versi update (4 style) Anda meng-compile ulang sourcenya.
READ MORE - Hook Menu Dengan 4 Style Milik Leandro Ascierto

Memberi Batas Minimal - Maksimal Sebuah Aplikasi - VB6

Merancang sebuah interface yang baik, terkadang tidak semudah yang dibayangkan (download codejock dan selesai). Beberapa hal yang sering diutamakan diantaranya, tampilan yang menarik, kemudahan akses (dapat digunakan secara sempurna tanpa menggunakan mouse), navigasi antar form yang mudah dan tidak membingungkan, pemilihan ActiveX Third Party yang memiliki kualitas kode yang baik (tidak mengandung bug atau mudah crash), dsb (banyak). Nah, diantara sekian yang banyak itu salah satunya adalah memberi batas minimal ukuran sebuah aplikasi. Di bawah ini merupakan modul untuk memberi batas minimal sebuah aplikasi, sumber kodenya dari Microsoft.
Option Explicit 

Private Const
GWL_WNDPROC = -4
Private Const WM_GETMINMAXINFO = &H24

Private Type
POINTAPI
X As Long
Y As Long
End Type

Private Type
MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Global lpPrevWndProc As Long
Global gHW As Long

Private Declare Function
DefWindowProc Lib "user32" Alias _
"DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function
CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam 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 Declare Sub
CopyMemoryToMinMaxInfo Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "kernel32" Alias _
"RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
ByVal cbCopy As Long)

Public Sub
Hook()
'Start subclassing.
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Public Sub
Unhook()
Dim temp As Long

'Cease subclassing.
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function
WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim
MinMax As MINMAXINFO

'Check for request for min/max window sizes.
If uMsg = WM_GETMINMAXINFO Then
'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)

'Specify new minimum size for window.
MinMax.ptMinTrackSize.X = 750 'untuk ukuran minimal aplikasi
MinMax.ptMinTrackSize.Y = 550

'Specify new maximum size for window.
' MinMax.ptMaxTrackSize.x = 900 'untuk ukuran maksimal aplikasi
' MinMax.ptMaxTrackSize.y = 600

'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)

WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
wParam, lParam)
End If
End Function

Contoh penggunaan pada MDI form:
Private Sub MDIForm_Load() 
gHW = Me.hwnd 'Save handle to the form.
Hook 'Begin subclassing.
End Sub

Private Sub
MDIForm_Unload(Cancel As Integer)
Unhook 'Stop subclassing.
End Sub

Catatan penting: karena menggunakan teknik subclassing, tempatkan kode di atas setelah aplikasi selesai dibuat (final), pastikan seluruh kode berjalan dengan baik, pastikan pula seluruh error terhandle dengan baik. Mengapa? CRASH! dan kita akan kesulitan mentrace dan mendebug aplikasi yang sedang kita buat.
READ MORE - Memberi Batas Minimal - Maksimal Sebuah Aplikasi - VB6

Validasi Numeric Yang Disertai Decimal Symbol - Visual Basic 6

Bagaimana logika untuk validasi numerik yang disertai angka dibelakang koma? Nah, dengan menggabungkan posting sebelumnya dan sebelumnya, maka kita memperoleh logika untuk membuat validasi numeric yang memperbolehkan angka di belakang koma. Adapun kodenya adalah sebagai berikut:
Private Sub Text1_KeyPress(KeyAscii As Integer) 
Dim intDummyDecimalSymbol As Integer
intDummyDecimalSymbol = IIf(InStr(1, Text1.Text, Chr(GetDecimalSymbol)) = 0, GetDecimalSymbol, 0)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii = intDummyDecimalSymbol) Then KeyAscii = 0
End Sub

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

Kode di atas akan sangat merepotkan, apabila harus memvalidasi banyak TextBox. Maka buatlah menjadi sederhana dengan menyimpannya pada module agar dapat diakses oleh seluruh form.
'Simpan dalam module 
Public Function GetNumericAndDecimal(txt As TextBox, Keyascii As Integer) As Integer
Dim
intDummyDecimalSymbol As Integer
intDummyDecimalSymbol = IIf(InStr(1, txt.Text, Chr(GetDecimalSymbol)) = 0, GetDecimalSymbol, 0)
If Not ((Keyascii >= 48 And Keyascii <= 57) Or Keyascii = 8 Or Keyascii = 45 Or Keyascii = intDummyDecimalSymbol) Then
GetNumericAndDecimal = 0
Else
GetNumericAndDecimal = Keyascii
End If
End Function

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

Contoh penggunaan:
Private Sub Text1_KeyPress(KeyAscii As Integer) 
KeyAscii = GetNumericAndDecimal(Text1, KeyAscii)
End Sub



READ MORE - Validasi Numeric Yang Disertai Decimal Symbol - Visual Basic 6

Black Circle PasswordChar Untuk Login Form - Visual Basic 6

Pada saat kita menuliskan password di yahoo, gmail, xp, facebook, dll, kita dapat melihat, bahwa karakter yang digunakan untuk menuliskan password bukanlah karakter asterix (*) melainkan lingkaran kecil berwarna hitam. Nah, bagaimana setting PasswordChar untuk menggantikan karakter asterix (*) tersebut? (ini tentu saja akan membuat form login Anda terlihat lebih baik dan standard).

Option Explicit 

Private Sub
Form_Load()
With Text1
.FontName = "Wingdings"
.FontSize = 9
.PasswordChar = "l"
End With
End Sub

Catatan: yang harus kita perhatikan adalah, apakah font 'Wingdings' merupakan font bawaan OS (98, 2000, XP, Vista, Windows 7)?, jika bukan maka kita harus mengikutsertakan dalam file setup/installer.
READ MORE - Black Circle PasswordChar Untuk Login Form - Visual Basic 6

Generator Interface Yang Dilengkapi Template, Sebuah Konsep

Mengenai generator interface yang dilengkapi template - Pada posting terdahulu saya telah menjelaskan mengenai pembuatan generator interface database yang sangat sederhana. Kelemahan utama dari generator tersebut yang ketidakmampuannya untuk diedit secara atau pada saat runtime (yaitu pada saat telah dicompile ke dalam bentuk DLL), sehingga bisa dianggap sebagai generator interface yang statis. Disini kita akan belajar mengenai cara membuat generator interface yang memiliki sifat dinamis, sehingga memiliki keleluasaan untuk diperbaiki, diedit, dipilih, dikembangkan bahasanya menjadi lebih baik, dan tentu saja akan menghasilkan tampilan yang berbeda-beda (seperti halnya mengedit CSS).

Kode dibawah masih sangat sederhana, kurang layak, perlu dikembangkan. Setelah menjadi baik maka gabungkan dengan kode yang terdapat pada posting terdahulu (tentu saja setelah disesuaikan kodenya).
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
OpenTextFileAndTranslate 'membuka template dan menerjemahkannya
End Sub

'//fungsi yang digunakan untuk membaca template baris demi baris
Private Function OpenTextFileAndTranslate() As String
Dim
nFileNum As Integer, sText As String
Dim
sNextLine As String, lLineCount As Long
nFileNum = FreeFile
Open
App.Path & "\template.txt" For Input As nFileNum
lLineCount = 1
Do While Not EOF(nFileNum)
Line Input #nFileNum, sNextLine
Compile sNextLine
sNextLine = sNextLine & vbCrLf
sText = sText & sNextLine
Loop
OpenTextFile = sText
Close nFileNum
End Function

'//fungsi yang digunakan untuk menterjemahkan template, sehingga bisa dianggap
'//sebagai translator/compiler code (walaupun tidak tepat). Disini kita diberi
'//kebebasan untuk mengembangkan translator menjadi lebih baik lagi, dengan
'//memberikan sedikit 'kecerdasan' kepada mesin untuk menerjemahkan kode yang
'//telah kita buat/edit. dan lain-lain. Adapun kode fungsi di bawah
'//ini masih sangat sederhana, sehingga kurang layak untuk digunakan, tetapi kita
'//telah memahami konsep/logika/garis besarnya, bukan?

Private Sub
Compile(Code As String)

Dim
ObjectOrMethod As String
Dim
strCode As String
Dim
strObject As String
Dim
strProperty As Variant
Dim
ctl As VBControl
Dim f As VBForm
Dim i As Integer

If
(Trim(Left(Code, 1)) = "/") Or (Trim(Code) = "") Then
Exit Sub
'do nothing with comments or blank line
End If

strObject = Split(Code, "=")(0)
ObjectOrMethod = Trim$(Split(Code, "=")(0))
Set f = VBInstance.SelectedVBComponent.Designer

Select Case
ObjectOrMethod
Case "Form"
'Do with Form
Case Else
Set
ctl = f.VBControls.Add(ObjectOrMethod)
End Select

strCode = Trim$(Right$(Code, Len(Code) - Len(strObject)))
strCode = Right$(strCode, Len(strCode) - 1)
strProperty = Split(strCode, ",")

For i =
LBound(strProperty) To UBound(strProperty)
Select Case ObjectOrMethod
Case "InsertOCX"
InsertOCX Trim$(Split(strProperty(i), "=")(0))
Case "Form"
With VBInstance.SelectedVBComponent
.Properties(Trim$(Split(strProperty(i), "=")(0))) = CVar((Trim$(Split(strProperty(i), "=")(1))))
End With
Case Else
With
ctl
.Properties(Trim$(Split(strProperty(i), "=")(0))) = CVar((Trim(Split(strProperty(i), "=")(1))))
End With
End Select
Next

End Sub

'//sub fungsi dari fungsi di atas, digunakan untuk menambahkan OCX third party
Public Function InsertOCX(ProgID As String) As Boolean
On Error GoTo
ErrHandler
'Add OCX
VBInstance.ActiveVBProject.AddToolboxProgID ProgID
InsertOCX = True
Exit Function
ErrHandler:
InsertOCX = False
End Function

Pada kode di atas saya menggunakan sebuah ActiveX (OCX) yang dibuat oleh Mas Gyus (Gautama Yustitia) pemilik situs http://araysoft.blogspot.com

Contoh template yang digunakan:
// -- HEADER -------------------------------------------------------------------------------------------
// -- contoh menambahkan OCX third party ke dalam ToolBox VB6
InsertOCX=ARTitleBar32.ARCompanyLine

// -- banyak yang belum diimplementasikan, atau Anda sendiri yang membuatnya dengan selera
// -- bahasa Anda sendiri, di antaranya:
// InsertDLL= menambah reference dll seperti ;Microsoft ActiveX Data Object 2.8 Library' dan lain-lain
// SpaceTop= margin atas penempatan object
// SpaceLeft= margin kiri penempatan object
// SpaceRight= margin kanan penempatan object
// SpaceBottom= margin bawah penempatan object
// SpaceBetween= kerenggangan TextBox atau label
// dan lain-lain -- silakan Anda kembangkan bahasa sendiri dengan menggunakan logika percabangan
// (branching) agar layak untuk digunakan

//------------------------------------------------------------------------------------------------------
// -- http://khoiriyyah.blogspot.com
//-- Coder: Asep Hibban
// menjelaskan mengenai cara membuat sebuah compiler GUI sederhana
// sehingga bisa dibuat sebuah template atau style yang digunakan untuk generator code
//------------------------------------------------------------------------------------------------------

// -- menambah control/object serta memodifikasi property-property yang dibutuhkan
TextBox=Width=5295,Top=660,Height=2805,Left=1440,Text=Cool a.k.a Hade Pisan
ComboBox=Text=Bagaimana?,Width=5295,Top=180,Left=1440
CommandButton=Caption=&Ok,Top=3885,Left=4260,Height=360
CommandButton=Caption=&Cancel,Top=3885,Left=5520,Height=360
CommandButton=Caption=&Update,Top=3885,Left=3000,Height=360

//PictureBox=Align=3,BorderStyle=0,BackColor=&H000000C0

// -- menambah control third party serta memodifikasi property-property yang dibutuhkan
ARTitleBar32.ARCompanyLine=CompanyName=khoiriyyah.blogspot.com,Left=-5,Width=7050,Top=3540


// --- memodifikasi property Form
Form=Width=7000,Height=4900,Caption=Data Karyawan,Name=frmKaryawan,BorderStyle=3

// --- End Template ------------------------------------------------------------------------------------

Download lampiran (source code): Generator Interface
READ MORE - Generator Interface Yang Dilengkapi Template, Sebuah Konsep

Menambahkan Object Yang Disertai Gambar - VB6 Add-Ins

Mengenai cara menambahkan object yang disertai atau membutuhkan gambar - Dalam mengenerate kode, terkadang ada object-object yang harus, membutuhkan, lebih baik disertai dengan gambar. Dalam contoh kode sekarang, object diwakili dengan satu PictureBox sedangkan untuk object-object yang lainnya (Smart Menu, object-object dari Codejock, menu vbAccelator, dll), Anda qiyaskan saja setelah disesuaikan kodenya.

Sebelum mengembangkan kode selanjutnya, ada beberapa yang harus kita pahami mengenai properties Picture. Pertama: Picture memiliki data type object, untuk mengatur propertiesnya, kita tidak bisa menggunakan kode seperti .Properties ("Picture") = LoadPicture ("C:\contoh_gambar.jpg"), ini akan menyebabkan ketidaksesuaian data type, karena penulisan .Properties ("Text") misalnya, sama dengan .Properties ("Text").Value, karena default untuk untuk .Properties adalah Value, seperti halnya kita menulis Text1 = "Contoh Text" (pada saat runtime) sama halnya dengan menulis Text1.Text = "Contoh Text" karena default properties untuk object TextBox adalah properties Text, demikian pula Label default Propertiesnya adalah Caption, dan seterusnya. Nah, untuk properties Picture (karena data typenya object) maka kita harus menuliskan .Properties ("Picture").Object = LoadPicture ("C:\contoh_gambar.jpg"). Kedua: Karena properties Picture adalah object maka kita tidak bisa menjalankan kode design time v.s desin time, mau tidak mau kita harus mengcompile terlebih dahulu project add-insnya untuk dibuat menjadi sebuah dll dan diakses secara runtime, mengapa?

Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
Dim v As VBForm
Dim p As VBControl
Set v = VBInstance.SelectedVBComponent.Designer
Set p = v.VBControls.Add("VB.PictureBox")
With p
.Properties("AutoSize") = True
.Properties("BorderStyle") = 0 'None
Set .Properties("Picture").object = LoadPicture(App.Path & "\home_brown_48.gif")
End With
End Sub

Download: Source Code

Walaupun sangat sederhana, akan tetapi kode di atas merupakan kode yang sangat langka sekali.
READ MORE - Menambahkan Object Yang Disertai Gambar - VB6 Add-Ins

Membaca File Text Baris Per Baris - Visual Basic 6

Dibawah ini merupakan contoh kode untuk membaca file text baris per baris menggunakan VB6 - Adapun kode untuk membaca file text line by line adalah sebagai berikut:
Option Explicit 

Private Function
OpenTextFile() As String
Dim
nFileNum As Integer, sText As String
Dim
sNextLine As String, lLineCount As Long
nFileNum = FreeFile
Open
"C:\daftar_driver.txt" For Input As nFileNum
lLineCount = 1
Do While Not EOF(nFileNum)
Line Input #nFileNum, sNextLine
MsgBox sNextLine 'ini akan membaca file text baris per baris
sNextLine = sNextLine & vbCrLf
sText = sText & sNextLine
Loop
OpenTextFile = sText
Close nFileNum
End Function
READ MORE - Membaca File Text Baris Per Baris - Visual Basic 6

Contoh Iterasi VBControl dan VBComponent - VB6 Add-ins

Menjelaskan iterasi untuk VBControl dan VBComponent menggunakan For ... Each - Apabila kita membuat sebuah TextBox pada Form, maka secara default property Text dari TextBox tersebut akan memiliki isi berupa tulisan Text1, Text2, dan seterusnya. Kita dapat menghilangkan isi dari dari TextBox tersebut secara manual (satu persatu dihilangkan teksnya) atau menggunakan kode yang telah ditulis terdahulu. Maka pada saat design time kita dapat menggunakan kode yang ... 'just one click' dan semuanya selesai, tidak masalah berapapun jumlah TextBox atau Form yang kita miliki/buat.
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
ClearAllTextBoxes
'hilangkan 1 baris kode di atas, dan gunakan kode di bawah
'jika hanya ingin menghilangkan isi dari TextBox dalam satu form saja.
'ClearTextBoxes 'menghilangkan Text yang terdapat pada TextBox
End Sub

'gunakan kode di bawah, jika ingin menghilangkan isi dari TextBox
'dalam sebuah project VB6
Private Function ClearAllTextBoxes()
Dim ctl As VBComponent
Dim p As Properties
Dim i As Integer
For Each
ctl In VBInstance.ActiveVBProject.VBComponents
If ctl.Type = vbext_ct_VBForm Or ctl.Type = vbext_ct_VBMDIForm Then
ctl.DesignerWindow.SetFocus
ClearTextBoxes
End If
Next
Dim c As
VBForm
End Function

'gunakan kode di bawah jika hanya satu form selected saja.
Private Function ClearTextBoxes()
On Error Resume Next
Dim
ctr As VBIDE.VBControl
For Each ctr In VBInstance.SelectedVBComponent.Designer.VBControls
If ctr.ProgId = "VB.TextBox" Then
ctr.Properties("Text") = ""
End If
Next
End Function
Contoh di atas hanyalah contoh sederhana dan tentu saja bisa dikembangkan untuk mempermudah pembuatan aplikasi, contoh lain: MZ-Tools yang menggunakan kode iterasi di atas untuk mengetahui apakah sebuah control memiliki Access Keys (mnemonic/ShortCut Underline).
READ MORE - Contoh Iterasi VBControl dan VBComponent - VB6 Add-ins

Menutup Seluruh Windows Yang Tidak Digunakan - VB6 Add-Ins

Contoh kode untuk menutup Windows yang tidak digunakan menggunakan Add-Ins:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
CloseUnusedWindows
End Sub

'kode di bawah akan menutup seluruh windows kecuali windows yang sedang aktif
Private Sub CloseUnusedWindows()
Dim v As VBComponent
For Each v In VBInstance.ActiveVBProject.VBComponents
If Not (v Is VBInstance.SelectedVBComponent) Then
v.DesignerWindow.Close
End If
Next
End Sub
READ MORE - Menutup Seluruh Windows Yang Tidak Digunakan - VB6 Add-Ins

Project Add-Ins Visual Basic 6 - Compile And Run

Pernahkah Anda mencoba kode yang mengharuskan dicompile terlebih dahulu dengan memanggil prosedur ini? tentu sering, bagaimana? sangat merepotkan sekali bukan? Nah, kode di bawah ini bisa mengatasinya:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
CompileAndRun
End Sub

Private Sub
CompileAndRun()
VBInstance.VBProjects.StartProject.MakeCompiledFile
Shell VBInstance.ActiveVBProject.BuildFileName, vbNormalFocus
End Sub
Jika Anda gabungkan dengan manifest injector, maka hasilnya akan lebih baik lagi.
READ MORE - Project Add-Ins Visual Basic 6 - Compile And Run

Menambahkan Project Baru Menggunakan Add-Ins Visual Basic 6

Di bawah merupakan contoh menambahkan project baru menggunakan VB6 Addins. Adapun kode yang dibutuhkan untuk menambahkan project baru adalah VBInstance.VBProjects.Add(ProjectType), seperti pengkodean pada umumnya (menambahkan kontrol objek pada koleksi).
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()

Dim p As
VBProject
Set p = AddNewProject(vbext_pt_ActiveXControl) 'ActiveXControl project
With p
.Name = "prjButtonControl" 'setting properties
'.dan sebagainya
End With

Set p =
AddNewProject(vbext_pt_ActiveXDll) 'ActiveXDll Project
With p
.Name = "prjClassDatabase" 'setting properties
End With
'dan sebagainya
AddNewProject vbext_pt_ActiveXExe 'ActiveXExe project
AddNewProject vbext_pt_StandardExe 'Standard Exe Project
'dan lain-lain
End Sub

'fungsi untuk menambahkan project baru
Private Function AddNewProject(pType As vbext_ProjectType) As VBProject
Set AddNewProject = VBInstance.VBProjects.Add(pType)
End Function
READ MORE - Menambahkan Project Baru Menggunakan Add-Ins Visual Basic 6

Memasukan Sebuah Object ke dalam Container - Addins VB6

Di bawah ini merupakan contoh kode untuk memasukan sebuah objek ke dalam objek kontainer melalui Addins, dalam hal ini objek diwakili oleh satu CommandButton dan kontainer diwakili oleh satu objek Frame.
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
ObjectInContainerSample
End Sub

Private Sub
ObjectInContainerSample()
'menambahkan PictureBox
Dim f As VBForm
Dim p As VBControl
Dim b As VBControl
Set f = VBInstance.SelectedVBComponent.Designer
Set p = f.VBControls.Add("Frame")
With p
.Properties("Height") = 2000
.Properties("Width") = 4000
.Properties("Left") = 500
.Properties("Top") = 500
.Properties("Caption") = "Data Siswa"
'.properties dan lain-lain
End With
'menambahkan CommandButton
Set b = f.VBControls.Add("CommandButton")
Set b.Container = p 'memasukan sebuah objek ke dalam kontainer
With b
.Properties("Left") = 500
.Properties("Top") = 500
.Properties("Caption") = "&Simpan"
'.properties dan lain-lain
End With
End Sub
READ MORE - Memasukan Sebuah Object ke dalam Container - Addins VB6

Merubah Nama (Rename) Active VB Project - VB6 Add-Ins

Berikut merupakan kode untuk merubah nama atau rename Active VB Project: VBInstance.ActiveVBProject.Name = "prjDatabase" apabila Active VB Project ingin dirubah namanya menjadi 'prjDatabase'.
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
RenameActiveProject "prjDatabase"
End Sub

Private Sub
RenameActiveProject(s As String)
VBInstance.ActiveVBProject.Name = s
End Sub
READ MORE - Merubah Nama (Rename) Active VB Project - VB6 Add-Ins

Contoh Kode Menghilangkan Item VBComponent - VB6 Add-Ins

Berikut merupakan contoh kode untuk menghilangkan salah satu VBComponent (Form, Module, UserControl, Class, dll) berdasarkan namanya:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
RemoveVBComponent "Form1"
End Sub

Private Sub
RemoveVBComponent(s As String)
Dim f As VBComponent
Set f = VBInstance.ActiveVBProject.VBComponents.Item("Form1")
VBInstance.ActiveVBProject.VBComponents.Remove f
End Sub
READ MORE - Contoh Kode Menghilangkan Item VBComponent - VB6 Add-Ins

Menghilangkan Reference DLL Yang Tidak Digunakan - VB6 Add-Ins

Di bawah ini merupakan kode untuk menghilangkan reference yang tidak digunakan dalam sebuah project. Untuk menggunakannya, buatlah project Addins, selanjutnya gantilah seluruh kode yang terdapat pada frmAddins dengan kode di bawah:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
CleanUpUnUsedReferences
End Sub

Private Function
CleanUpUnUsedReferences()
Dim c, my, mn
'On Error GoTo ErrHandler
Dim ref As VBIDE.Reference
Dim refPath As String
For Each
ref In VBInstance.ActiveVBProject.References
refPath = ref.FullPath
c = ref.Guid: my = ref.Major: mn = ref.Minor
If ref.BuiltIn <> True Then
With
VBInstance.ActiveVBProject.References
.Remove ref 'hapus reference
' Shell "regsvr32.exe " & Chr(34) & refPath & Chr(34) & " /u /s"
VBInstance.ActiveVBProject.MakeCompiledFile 'compile, jika error kembalikan reference
End With
End If
Next
Exit Function
ErrHandler:
VBInstance.ActiveVBProject.References.AddFromGuid c, my, mn 'kembalikan reference
Err.Clear
Resume Next
End Function
READ MORE - Menghilangkan Reference DLL Yang Tidak Digunakan - VB6 Add-Ins

Agar Form Tidak Bisa Digeser Atau Dipindahkan - VB6

Mengenai kode yang digunakan membekukan form agar tidak bisa digeser atau dipindahkan (move).
Option Explicit 

Public Declare Function
GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function
RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Const
SC_MOVE = &HF010&
Public Const MF_BYCOMMAND = &H0&

Public Function
FrozeForm(frm As Form)
Dim lhSysMenu As Long
Dim
lRetVal As Long
lhSysMenu = GetSystemMenu(frm.hwnd, False)
lRetVal = RemoveMenu(lhSysMenu, SC_MOVE, MF_BYCOMMAND)
End Function
Contoh penggunaan kode di atas:
Private Sub Form_Load() 
FrozeForm Me
End Sub
READ MORE - Agar Form Tidak Bisa Digeser Atau Dipindahkan - VB6

Mengganti Seluruh Kode Yang Terdapat Pada Module - VB6 Add-Ins

Di bawah merupakan kode untuk mengganti seluruh kode yang terdapat pada CodeModule VBComponent (Form, Module, Class, dll) melalui Add-Ins.
Private Function SetCodeModule(s As String, c As String) As Boolean 
Dim
cd As CodeModule
Set cd = VBInstance.ActiveVBProject.VBComponents(s).CodeModule
cd.DeleteLines 1, cd.CountOfLines
cd.AddFromString c
End Function
READ MORE - Mengganti Seluruh Kode Yang Terdapat Pada Module - VB6 Add-Ins

Di manakakah letak procedure Sub Main? - VB6 Add-Ins

Karena letak prosedure Sub Main() bisa di module mana saja, maka untuk mengetahuinya melalui project VB6 Addin, maka kita memerlukan kode di bawah ini:
Private Function GetSubMain() As String 
Dim v As
VBComponent
Dim l As Long, s As String
For Each v In
VBInstance.ActiveVBProject.VBComponents
With v
If
.Type = vbext_ct_StdModule Then
l =
v.CodeModule.CountOfLines
If l > 0 Then
s =
v.CodeModule.Lines(1, l)
If InStr(1, s, "sub main()", vbTextCompare) > 0 Then
GetSubMain = v.Name
Exit Function
End If
End If
End If
End With
Next
End Function
READ MORE - Di manakakah letak procedure Sub Main? - VB6 Add-Ins

Memeriksa Apakah Sebuah Project Telah Disimpan - VB6 Add-Ins

Melalui VB6 Add-Ins kita dapat memeriksa apakah sebuah project telah disimpan atau belum, berikut fungsi untuk memeriksa apakah project telah disimpan:
Private Function IsProjectSaved() As Boolean 
IsProjectSaved = Not (VBInstance.ActiveVBProject.Filename = "")
End Function
READ MORE - Memeriksa Apakah Sebuah Project Telah Disimpan - VB6 Add-Ins

Mendapat Seluruh Kode Yang Terdapat Pada CodeModule - Add-Ins

Di bawah merupakan fungsi untuk memperoleh seluruh kode dari baris pertama hingga baris terakhir - Bermanfaat terutama untuk meng-crop kode-kode sample dan memasukannya ke dalam snippet database.
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
MsgBox GetCodeModule("Form1")
End Sub

Private Function
GetCodeModule(s As String) As String
Dim
cd As CodeModule
Set cd = VBInstance.ActiveVBProject.VBComponents(s).CodeModule
GetCodeModule = cd.Lines(1, cd.CountOfLines)
End Function
READ MORE - Mendapat Seluruh Kode Yang Terdapat Pada CodeModule - Add-Ins

Cara Membuat Form Transparan Menggunakan VB6

Kode di bawah digunakan untuk menjadikan sebuah form menjadi transparan, tetapi dengan kontrol-kontrol (CommandButton, TextBox, ComboBox, dll) yang tidak transparan (opaque).

Bagaimanakah kode untuk membuat form transparant ini:
Option Explicit 

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 Declare Function
SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const
GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Public Function
MakeTransparentForm(frm As Form)
frm.BackColor = vbBlue
SetWindowLong frm.hwnd, GWL_EXSTYLE, GetWindowLong(frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes frm.hwnd, vbBlue, 0&, LWA_COLORKEY
End Function

Contoh penggunaan kode form transparant:
Private Sub Form_Load() 
MakeTransparentForm Me
End Sub

Demikianlah semoga kode membuat form menjadi transparant di atas bermanfaat. selamat mencoba!
READ MORE - Cara Membuat Form Transparan Menggunakan VB6

Bagaimana cara menjalankan Speech Properties Dialog - VB6

Karena Speech Properties dialog tidak terdapat dalam Windows\System32 maka untuk memanggilnya, Kita memerlukan kode di bawah:
Option Explicit 
 
Private Sub Command1_Click() 
    Shell "rundll32.exe shell32.dll,Control_RunDLL " & Chr(34) & "c:\program files\common files\microsoft shared\speech\sapi.cpl" & Chr(34) 
End Sub 
Perhatikan kode di atas, pathnya diapit oleh chr(34). Selain menggunakan chr(34) kita bisa juga menggunakan '"""' atau mengkonversi path menjadi format DOS 8.3 seperti yang telah ditulis terdahulu.
READ MORE - Bagaimana cara menjalankan Speech Properties Dialog - VB6

Monday, June 11, 2012

Twitter OAuth 1.0a: Digital Signature - Base String - VB6

Dalam Twitter OAuth 1.0, setiap kita melakukan request ke twitter.com maka tiap-tiap request harus disertai dengan digital signature sebagai bukti otentifikasi dan otorisasi. Adapun digital signature tersebut adalah hasil dari hash (one way encrypt):HMAC-SHA1 (BaseString + Key).Adapun Key adalah gabungan dari: (ConsumerSecret + AccessTokenSecret)

Nah disini saya menjelaskan bagaimana merakit/membuat BaseString untuk men-generate digital signature melalui VB6 seperti yang telah dijelaskan di atas:

Private Function GetTwitterBaseString() As String

Dim strURL As String
Dim strBaseString As String
strURL = "http://api.twitter.com/1/statuses/update.json"

strBaseString = txtMethod & _
"&" & UrlEncodeUtf8(txtURL.Text)
strQuery = HSA1.URLEncode("oauth_consumer_key=" & txtConsumerKey.Text) & _
UrlEncodeUtf8("&oauth_nonce=" & txtNonce.Text) & _
UrlEncodeUtf8("&oauth_signature_method=" & txtSignatureMethod.Text) & _
UrlEncodeUtf8("&oauth_timestamp=" & txtTimeStamp.Text) & _
UrlEncodeUtf8("&oauth_token=" & txtToken.Text) & _
UrlEncodeUtf8("&oauth_version=" & txtVersion.Text)
strParameter = HSA1.URLEncode("&status=" & UrlEncodeUtf8(strURL))
GetTwitterBaseString = strBaseString & "&" & strQuery & strParameter

End Function
Demikian BaseString Twitter OAuth 1.0 melalui VB6. Semoga bermanfaat. Apabila kita gagal mengirim tweet ke twitter menggunakan OAuth 1.0, mungkin bisa kita ganti dengan OhOut atau lebih tepatnya Oh Out Of Memory (OOM), mengenai artikel OOM bisa Anda baca di sini.
READ MORE - Twitter OAuth 1.0a: Digital Signature - Base String - VB6

Saturday, June 9, 2012

Daftar Google Data API Service Names

Google Analytics Data APIs => analytics
Google Apps APIs (Domain Information & Management) => apps
Google Sites Data API => jotspot
Blogger Data API => blogger
Book Search Data API => print
Calendar Data API => cl
Google Code Search Data API => codesearch
Contacts Data API => cp
Content API for Shopping => structuredcontent
Documents List Data API => writely
Finance Data API => finance
Gmail Atom feed => mail
Health Data API => health
weaver (H9 sandbox)
Maps Data APIs => local
Picasa Web Albums Data API => lh2
Sidewiki Data API => annotateweb
Spreadsheets Data API => wise
Webmaster Tools API => sitemaps
YouTube Data API => youtube
READ MORE - Daftar Google Data API Service Names

Merger 2 File XML Menggunakan Visual Basic 6.0

Private Sub AddPostNew(XMLSource As String, XMLDestination As String) 

Dim
strText As String
Dim
strPost As String

Dim
domFree As FreeThreadedDOMDocument60
Dim domApt As DOMDocument60
Dim node As IXMLDOMNode
Dim clone As IXMLDOMNode
Dim msg As String

msg = ""
Set domFree = New FreeThreadedDOMDocument60
Set domApt = New DOMDocument60

domApt.async = False
If False =
domApt.loadXML(XMLDestination) Then
MsgBox "can't load doc1.xml"
Exit Sub
End If

domFree.async = False
If False =
domFree.loadXML(XMLSource) Then
MsgBox "can't load doc2.xml"
Exit Sub
End If

Dim
nodeId As IXMLDOMAttribute
Set node = domFree.documentElement

Set
clone = domApt.importNode(node, True)

domApt.documentElement.appendChild clone
domApt.documentElement.appendChild domApt.createTextNode(vbNewLine)

Set
node = Nothing
Set clone = Nothing

domApt.save strPathXML

End Sub
READ MORE - Merger 2 File XML Menggunakan Visual Basic 6.0

Mengatasi Masalah OCX Pada Windows-7

Bagi temen-temen pecinta Visual Basic 6, kadang program yang kita tulis "bermasalah" pada saat dijalankan di target Sistem Operasi 64 Bit. Ini biasanya terjadi karena program tsb menggunakan komponen (DLL/OCX) dengan arsitektur 32Bit, seperti MSCOMM32.OCX, MSMASK32.OCX dll. Untuk mengatasi masalah tsb dapat dilakukan dengan cara : Copy kan komponen (DLL/OCX) 32Bit yang bermasalah ke folder \Windows\SysWow64 pada Sistem Operasi 64 Bit yang menjadi target, kemudian register dengan Regsvr32.....

Mungkin ini terjadi karena kebingungan karyawan om "BILL GATES" waktu bikin Windows dengan arsitektur 64Bit :

• Folder SysWOW64 Hanya untuk Komponen 32-bit
• Folder System32 Hanya untuk komponen 64-bit

Jadi jika kita membuat program Installer dan aplikasi ada yang khusus untuk 32Bit... harus dapat melakukan cek sistem operasi untuk menentukan target folder

Sumber: http://i-bego.com
READ MORE - Mengatasi Masalah OCX Pada Windows-7

Menghapus Section Pada INI File

Option Explicit

Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Sub DeleteKey(Section As String, Key As String, PathIni As String)
Dim sSection As String
Dim sKey As String
Dim sFileName As String
sSection = Section
sKey = Key
sFileName = PathIni
If Len(Trim(sKey)) <> 0 Then
WritePrivateProfileString sSection, sKey, vbNullString, sFileName
Else
WritePrivateProfileString sSection, sKey, vbNullString, sFileName
End If
End Sub
READ MORE - Menghapus Section Pada INI File

Friday, June 8, 2012

Effect Bayangan (Shadow) Pada Form Menggunakan VB6

Mengenai cara menambahkan effect bayangan (shadow effect) pada form - effect bayangan (shadow effect) ini akan terlihat bagus terutama pada form tanpa border (property BorderStyle = 0 - none). Bagaimana kode mengenai shadow effect ini?
Option Explicit 

Private Declare Function
GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function
SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const
CS_DROPSHADOW As Long = &H20000
Private Const GCL_STYLE As Long = -26

Private Sub
DropShadow(ByVal hWnd As Long)
Call SetClassLong(hWnd, GCL_STYLE, GetClassLong(hWnd, GCL_STYLE) Or CS_DROPSHADOW)
End Sub

Private Sub
Form_Load()
DropShadow Me.hWnd
End Sub

Catatan: Effect bayangan (shadow effect) akan bekerja pada saat Show shadow under menus dicheck (default). Show shadow under menus terdapat pada start >> Settings >> Control Panel >> System >> Advanced >> Settings >> Show shadow under menus.
READ MORE - Effect Bayangan (Shadow) Pada Form Menggunakan VB6

Bagaimana Memperoleh Nama Object Dalam Startup Object - VB6

Menjelaskan mengenai cara memperoleh (return/get) object atau nama object dalam sebuah project Visual Basic 6 menggunakan Add-Ins - Jika kita mengetikan kode seperti disamping: VBInstance.ActiveVBProject.VBComponents.StartUpObject. (dengan menambahkan titik di depan), VB6 tidak akan menampilkan list method atau property otomatisnya, padahal StartUpObject ini memiliki beberapa property, diantaranya adalah property .Name untuk memperoleh nama object, seperti contoh di bawah ini:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
MsgBox GetStartUpName
End Sub

Private Function
GetStartUpName() As String
GetStartUpName = VBInstance.ActiveVBProject.VBComponents.StartUpObject.Name
End Function
Sepertinya pembahasan Startup Object ini selesai, dari sini tentu kita dapat membuat tools-tools sederhana dan bermanfaat, misalnya Generator XP Style, yakni dengan memasukan resource file dan sedikit kode. Akan tetapi sebelumnya, ia (Generator XP Style) harus sedikit diberi 'kecerdasan buatan' agar dapat memutuskan, manakah yang menjadi Startup Object, apakah harus membuat Sub Main atau menginsert kode langsung pada Form? dan lain sebagainya.
READ MORE - Bagaimana Memperoleh Nama Object Dalam Startup Object - VB6

Jika Bukan Sub Main Untuk Startup Object? - VB6 Add-Ins

Mengenai cara mensetting Startup object yang bukan Sub Main (maksudnya Form) dalam project yang dibuat dengan Visual Basic 6 Add-Ins - Setelah membahas mengenai Startup Object dengan Sub Main, sekarang permasalahannya bagaimana jika bukan Sub Main tetapi Form tertentu yang akan dijadikan Startup Object, misalnya 'frmMain', 'frmSplashScreen', dan sebagainya? Perhatikan dalam tulisan Object Browser (dengan menekan F2) tertulis, seperti di bawah: Property StartUpObject As Variant Member of VBIDE.VBComponents Returns a Variant containing the startup component for the project. Dengan demikian kita tidak bisa mengassign value seperti kode di bawah: VBInstance.ActiveVBProject.VBComponents.StartUpObject = "frmMain" dengan asumsi ingin menjadikan frmMain sebagai Startup Object. Kode tersebut akan men-generate error. Maka solusinya seperti di bawah:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
SetStartUpObject "frmMain"
End Sub

Private Function
SetStartUpObject(c As String) As Boolean
Dim v As
VBComponent
Set v = VBInstance.ActiveVBProject.VBComponents.Item(c)
VBInstance.ActiveVBProject.VBComponents.StartUpObject = v
End Function
Kode di atas hanya kode sederhana saja, tentu saja dalam kenyataannya ia telah dilengkapi dengan handle error yang memadai serta check beberapa kondisi, misalnya Check apakah frmMain ada? dan sebagainya.
READ MORE - Jika Bukan Sub Main Untuk Startup Object? - VB6 Add-Ins

Apakah Project Telah Dirubah, Cara Mengetahuinya? VB6-AddIns

Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
If IsDirty Then
MsgBox "Project telah disimpan"
Else
MsgBox "Project belum disimpan"
End If
End Sub

'untuk mengetahui apakah project telah dirubah/diedit
Public Function IsDirty() As Boolean
IsDirty = (VBInstance.ActiveVBProject.IsDirty = True)
End Function
READ MORE - Apakah Project Telah Dirubah, Cara Mengetahuinya? VB6-AddIns

Memeriksa Apakah Project Telah Disimpan - VB6 Add-Ins

Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
If IsProjectSaved Then
MsgBox "Project telah disimpan"
Else
MsgBox "Project belum disimpan"
End If
End Sub

'untuk mengetahui apakah project telah disimpan
Public Function IsProjectSaved() As Boolean
IsProjectSaved = Not (VBInstance.ActiveVBProject.FileName = "")
End Function
READ MORE - Memeriksa Apakah Project Telah Disimpan - VB6 Add-Ins

Antisipasi Dari Pemberian 'Option Explicit' Ganda - VB6 Add-Ins

Kode di bawah berguna untuk mencegah pemberian Option Explicit ganda pada saat memasukan kode pada VBComponent (Form, Module, Class, dll) misalnya dengan menggunakan kode ini.

Adapun kode untuk mengantisipasi dari double Option Explicit adalah sebagai berikut:
Option Explicit 

Public Function
AddOptionExplicit() As String
If
RegRead("HKEY_CURRENT_USER\Software\Microsoft\VBA\Microsoft Visual Basic\RequireDeclaration") = 1 Then
AddOptionExplicit = vbNullString
Else
AddOptionExplicit = "Option Explicit 'Add by Project Builder 2.0" & vbCrLf
End If
End Function

Private Sub
Command1_Click()
MsgBox AddOptionExplicit
End Sub
Return VBNullString jika Option Explicit sudah ada, dan Option Explicit 'Add by Project Builder 2.0 jika Option Explicit belum ada.
READ MORE - Antisipasi Dari Pemberian 'Option Explicit' Ganda - VB6 Add-Ins

Data Report, Bagaimana Cara Menambahkannya Melalui Add-Ins?

Mengenai cara menambah data report project database melalui pemrograman Add-Ins - Apabila kita berusaha menambahkan sebuah data report (lebih umum ActiveX Designer) dengan menggunakan kode disamping: VBInstance.ActiveVBProject.VBComponents.Add (vbext_ct_ActiveXDesigner) seperti pada postingan sebelumnya, maka yang kita peroleh hanyalah peringatan error. Adapun untuk ActiveX designer maka kode adalah seperti disamping: VBInstance.ActiveVBProject.VBComponents.AddCustom("{78E93846-85FD-11D0-8487-00A0C90DC8A9}"). {78E93846-85FD-11D0-8487-00A0C90DC8A9} merupakan CLSID untuk data report default VB6, gantilah {78E93846-85FD-11D0-8487-00A0C90DC8A9} dengan CLSID yang sesuai, misalnya apabila menggunakan Crystal Report atau Active Report.

Adapun contoh kode untuk menambah data report baru melalui pemrograman Add-Ins adalah sebagai berikut:
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
Dim NewReport '- variant?
' //MSDBRPTR.DLL-Microsoft Data Report Designer v6.0
' InsertReferences "{642AC760-AAB4-11D0-8494-00A0C90DC8A9}", "1", "0"
' //msstdfmt.dll-Microsoft Data Formatting Object Library 6.0 (SP4)
' InsertReferences "{6B263850-900B-11D0-9484-00A0C91110ED}", "1", "0"

' //dua referensi .dll (MSDBRPTR.DLL dan msstdfmt.dll) di atas, akan otomatis direferensi pada saat kode di bawah dijalankan

'//Insert data report, CLSID untuk data report {78E93846-85FD-11D0-8487-00A0C90DC8A9}}
'//atau CLSID-nya diganti dengan ProgID juga akan menghasilkan hasil yang sama.
Set NewReport = VBInstance.ActiveVBProject.VBComponents.AddCustom("{78E93846-85FD-11D0-8487-00A0C90DC8A9}")

'mengatur properties
With NewReport
.Name = "rptSiswa" 'rubah nama menjadi rptSiswa
.Properties("Caption") = "Laporan data siswa"
'.dan sebagainya
'.dan sebagainya
End With
End Sub

'-------------------------------------------------------------------------------------------
'//Kode di bawah tidak diperlukan, hanya sebagai pengingat saja...
'-------------------------------------------------------------------------------------------

'Public Function InsertReferences(GUID As String, Mayor As Long, Minor As Long) As Boolean
'On Error GoTo ErrHandler
' 'Add dll references
' VBInstance.ActiveVBProject.References.AddFromGuid GUID, Mayor, Minor
' InsertReferences = True
'ErrHandler:
' InsertReferences = False
'End Function
READ MORE - Data Report, Bagaimana Cara Menambahkannya Melalui Add-Ins?

Mengubah Startup Object Melalui VB6 Add-Ins

Pada saat kita membuat project baru (Standard Exe misalnya), maka secara default yang menjadi standard object untuk project1 adalah Form1. Tetapi permasalahannya, bagaimana jika kita ingin membuat generator code yang Startup Objectnya Sub Main? untuk menyelesaikannya, kita hanya memerlukan 1 baris kode yaitu: VBInstance.ActiveVBProject.VBComponents.StartUpObject = vbext_so_SubMain. Untuk mengujinya buatlah project addin seperti posting terdahulu, gantilah seluruh kode yang terdapat pada frmAddin.
Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
VBInstance.ActiveVBProject.VBComponents.StartUpObject = vbext_so_SubMain
End Sub
Compile dan jalankan seperti posting terdahulu.
READ MORE - Mengubah Startup Object Melalui VB6 Add-Ins

Menambah Module Dengan Kode Melalui VB6 Add-Ins

Menjelaskan mengenai cara menambah module melalui Visual Basic 6 Add-Ins - Sebelumnya saya telah memposting mengenai cara menambah Form, Menu, CommandButton, menambah referensi komponen OCX dan DLL melalui pemrograman Add-Ins, maka untuk melengkapi mengenai cara membuat robot software atau generator code tentulah harus dapat menambahkan Module, Class, UserControl, Resource, dsb.

Untuk menjalankan kode di bawah, ikuti langkah-langkah berikut:
  1. Buat project Add-Ins baru dengan cara Klik File, klik New Project, klik Addin
  2. Gantilah seluruh kode yang terdapat pada frmAddin dengan kode di bawah
  3. Lakukan compile dengan cara klik File, klik Make MyAddin.dll
  4. Simpan project, dan tutuplah aplikasi Visual Basic 6

Public VBInstance As VBIDE.VBE 
Public Connect As Connect

Option Explicit

Private Sub
CancelButton_Click()
Connect.Hide
End Sub

Private Sub
OKButton_Click()
AddModule "moDatabase", ConnectionCode
End Sub

Public Function
AddModule(ModulName As String, Optional strCode As String) As Boolean

Dim
newModule As VBComponent

On Error GoTo
ErrHandler

Set
newModule = VBInstance.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule)
With newModule
.Name = ModulName
.CodeModule.AddFromString strCode
End With
Exit Function

ErrHandler:

MsgBox Err.Description

End Function

Private Function
ConnectionCode() As String
Dim
sMsg As String
sMsg = sMsg & "" & vbCrLf
sMsg = sMsg & "Public conn As ADODB.Connection" & vbCrLf
sMsg = sMsg & "" & vbCrLf
sMsg = sMsg & "Public Function OpenDatabase(Filename As String) As Boolean" & vbCrLf
sMsg = sMsg & "" & vbCrLf
sMsg = sMsg & " Dim c As String" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & " On Error GoTo ErrHandler" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & " c = " & Chr(34) & "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & Chr(34) & " & Filename" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & " Set conn = New ADODB.Connection" & vbCrLf
sMsg = sMsg & " conn.ConnectionString = c" & vbCrLf
sMsg = sMsg & " conn.Open" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & " OpenDatabase = True" & vbCrLf
sMsg = sMsg & " Exit Function" & vbCrLf
sMsg = sMsg & "" & vbCrLf
sMsg = sMsg & "ErrHandler:" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & " OpenDatabase = False" & vbCrLf
sMsg = sMsg & " " & vbCrLf
sMsg = sMsg & "End Function" & vbCrLf
ConnectionCode = sMsg
End Function

Untuk mengakses MyAddin.dll, buka project baru klik Add-in Addin Manager.... klik My Add-in, selanjutnya tekanlah tombol OK dan lihatlah hasilnya.
READ MORE - Menambah Module Dengan Kode Melalui VB6 Add-Ins

Menonaktifkan Keyboard dan Mouse - BlockInput

Option Explicit 

Private Declare Function
BlockInput Lib "user32" (ByVal fBlock As Long) As Long

Private Sub
Command1_Click()
Timer1.Enabled = True
BlockInput True
End Sub

'Gunakan kode di bawah, agar komputer Anda tidak usah di restart
Private Sub Form_Load()
Timer1.Interval = 1000 '1 detik
Timer1.Enabled = False
End Sub

'Timer1.Interval = 1000 '1 detik
Private Sub Timer1_Timer()
Static i As Integer
i = i +
1
If i > 5 Then 'tunggu 5 detik
BlockInput False 'aktifkan kembali keyboard dan mouse
i = 0
End If
End Sub
READ MORE - Menonaktifkan Keyboard dan Mouse - BlockInput