Wednesday, July 10, 2013

VB6 API - Menghilangkan Border TextBox, ListBox, etc.

Mengenai cara menghilangkan border object TextBox, ListBox, dan lain sebagainya.

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 Const WS_EX_CLIENTEDGE = &H200 
Private Const GWL_EXSTYLE = (-20) 
 
Private Sub RemoveBorder(ctl As Control) 
    Dim lStyle As Long 
    ctl.Appearance = 1 
    lStyle = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) 
    lStyle = lStyle And Not WS_EX_CLIENTEDGE 
    SetWindowLong ctl.hwnd, GWL_EXSTYLE, lStyle 
    ctl.Appearance = 0 
End Sub

Contoh penggunaan:

Private Sub Command1_Click() 
    Call RemoveBorder(Text1) 
End Sub

Tuesday, July 9, 2013

VB6 ListBox - Mengetahui Item Height Object ListBox

Untuk tujuan tertentu, terkadang kita memerlukan sebuah fungsi untuk mengukur Item Heigh sebuah object ListBox dan di bawah ini merupakan salah satu contohnya dengan menggunakan fungsi API.

Option Explicit   
   
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long   
Private Const LB_GETITEMRECT As Long = &H198   
   
Private Type RECT   
    Left As Long   
    Top As Long   
    Right As Long   
    Bottom As Long   
End Type   
   
Private Function ListBoxItemHeight(lst As ListBox) As Integer   
    Dim rc As RECT, i As Long, dy As Long   
    If lst.ListCount = 0 Then Exit Function   
    SendMessage lst.hwnd, LB_GETITEMRECT, ByVal 0&, rc   
    dy = rc.Bottom - rc.Top   
    ListBoxItemHeight = (dy * Screen.TwipsPerPixelY)   
End Function

Contoh penggunaan:

Private Sub Command1_Click() 
    List1.AddItem "A" 
    MsgBox ListBoxItemHeight(List1) 
End Sub

Friday, July 5, 2013

VB6 Date Time: Cara Mudah Menghitung Selisih Waktu

Menjelaskan cara mudah/termudah untuk menghitung selisih waktu - Mengapa disebut sebagai cara termudah? Karena ia hanya membutuhkan satu baris kode saja.

Untuk memahami manipulasi Date and Time seperti fungsi built-in dalam VB6 (DateAdd, DatePart, dan sebagainya) atau fungsi-fungsi date custom (bukan built-in), ada baiknya Anda mengetahui fakta mengenai data type date di bawah ini:

Data type date sama seperti data type number lainnya (integer, long, double) yang ditampilkan dengan format tertentu.
Bilangan 0 pada data type number (integer, long, double) padanannya dalam data type date adalah 30 December 1899, Jadi yang kurang dari tanggal 30 December 1899 menjadi bilangan negatif dan yang lebih dari 30 December 1899 akan menjadi bilangan positif.
Limit bilangan negatif untuk data type date adalah: 1 January 100 (-657434) dan untuk bilangan positif: 31 December 9999 (2958465) .
Date type date adalah angka 0,0000115740740740741 yang terus menerus ditambahkan atau terus menerus dikurangkan. 0,0000115740740740741 adalah 1 detik. Jadi (0,0000115740740740741 * 3600 * 24) hasilnya adalah 1. Angka 1 itu maksudnya adalah satu hari.
Seluruh tanggal berada di depan koma dan seluruh jam berada di belakang koma [tanggal, jam] dan sekarang (pada saat saya menulis artikel ini) adalah tanggal/jam: 41460,9088310185
Jika tidak ada tulisan 'ditampilkan dengan format tertentu' pada poin kesatu, apabila orang bertanya: "Jam berapa sekarang?" jawabannya, sekarang jam: 0,904872685185185.
Dan sebagainya, dan sebagainya, dan lain sebagainya.

Dari statement di atas maka, berapa selisih waktu antara: "10:11:01" s/d "11:23:01", jawabannya adalah:

CDate ("11:23:01") - CDate ("10:11:01") hasilnya adalah: 0,049537037037037. Duh, yang benar saja Mang, jadi pusing membacanya. Ingat pada point yang kesatu 'ditampilkan dengan format tertentu' sehingga: CDate (0,049537037037037) hasilnya adalah selisih waktu yang sebenarnya. Atau:

MsgBox CDate (CDate ("11:23:01") - CDate ("10:11:01")) 'hasilnya adalah selisih waktu yang sebenarnya atau 1:12:00.

Kesimpulannya: Untuk menghitung selisih waktu, kita bisa menggunakan fungsi: CDate (CDate (Time) - CDate (Time)), sehingga tidak harus mengkonversi jam ke detik, menit ke detik dengan bantuan fungsi Abs atau Mod kemudian dari detik dikonversi lagi ke jam, menit, dan detik. Walaupun hasinya sama, tetapi CDate (CDate (Time) - CDate (Time)) jauh lebih simple, bukankah demikian? Nah, bagaimana jika selisih waktunya ditambah hari? Contohnya: berapa selisih waktu antara 18/02/2013 s/d 25/03/2013 hmm... ingat pada point ke satu: 'seperti bilangan lainnya hanya saja ditampilkan dengan format tertentu.'

Keywords: cara, menghitung, jam, selisih, waktu, vb6, date, perbedaan, mencari, angka, time, menit, detik, bilangan

Thursday, July 4, 2013

VB6 Internet - Membuat FTP Uploader

Seringkali kita membutuhkan aplikasi untuk mengupload file melalui ftp, nah, untuk keperluan ini kita bisa memperolehnya banyak, mulai dari gratis hingga berbayar dari yang kurang lengkap hingga yang memiliki fitur lengkap. Aplikasi tersebut memang dikhususkan untuk keperluan yang serius. Tetapi setelah mencoba beberapa darinya, rasanya tidak sebanding dengan fiturnya yang hebat dan loadingya yang berat jika hanya digunakan untuk mengupload file-file lampiran (file-file source code VB) yang ukurannya hnaya 3kb, 5kb atau belasan kb. Lalu bagaimana solusinya?

Di bawah ini merupakan source code FTP yang dibuat menggunakan VB6 beserta file Installernya (setup.exe) yang bisa digunakan untuk membantu pekerjaan blogging.

Gambar - VB6 FTP uploader

Cara menggunakan:

Terlebih dahulu kita harus memiliki hosting, baik berbayar maupun gratisan. Untuk yang gratisan bisa daftar di sini. Detail mengenai pendaftaran bisa dilihat disini
Download source code ftp disini atau file setup.exe disini
Selanjutnya dalam aplikasi tersebut, kita harus mengisi:

Host = alamat ftp
Username = username Anda
Password = password
Remote Dir. = remote directory public
Situs = domain yang sudah Anda buat

Jika seluruhnya dirasa sudah benar, pilihlah salah satu file .zip yang ukurannya sekitar belasan kb.
Pada Explorer context menu, klik Upload File with Khoiriyyah-FTP seperti yang terlihat pada gambar di bawah ini:

Gambar - FTP Context Menu

Tunggu beberapa saat hingga selesai proses upload.
Setelah selesai, kita memperoleh link untuk dicopy-pastekan ke dalam artikel seperti terlihat pada gambar di bawah ini:

Gambar - Proses upload selesai

Download: Source Code VB6 FTP uploader.
Download: Setup VB6 FTP uploader
.

Wednesday, July 3, 2013

DeRef Dalam VB6

Dengan memanfaatkan salah satu fungsi (GetMem4) yang berada dalam runtime VB6 (msvbvm60.dll).

Option Explicit 
 
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) 
Private Declare Sub GetDWord Lib "MSVBVM60.dll" Alias "GetMem4" (ByRef inSrc As Any, ByRef inDst As Long) 
 
Public Function DeRef(ByVal ptr As Long) As Long 
    If (ptr) Then 
        Call GetDWord(ByVal ptr, DeRef) 
    End If 
End Function 
 
Private Sub Command1_Click() 
     
    Dim lngTest As Long 
    Dim lngAddress As Long 
 
    lngTest = 100 
    lngAddress = VarPtr(lngTest) 'lngAddress sekarang berisi pointer lngTest 
    Text1.Text = DeRef(lngAddress) 'Perhatikan sekarang Text1.Text = 100 (yang berasal dari pointer lngTest)
 
End Sub

Monday, July 1, 2013

VB6 Add-Ins - Mengambil String Terpilih (Code Module)

Mengenai cara mengambil string terpilih (selected) dari code module. Adapun kodenya adalah seperti di bawah ini:

Public Function GetSelections() As String 
     
    Dim cd As CodePane 
    Dim cm As CodeModule 
 
    Set cd = VBInstance.ActiveCodePane 
    Set cm = VBInstance.ActiveCodePane.CodeModule 
 
    Dim StartLine As Long 
    Dim StartColoum As Long 
    Dim EndLine As Long 
    Dim EndColoum As Long 
     
    Dim sKeyword As String 
     
    cd.GetSelection StartLine, StartColoum, EndLine, EndColoum 
    sKeyword = cm.Lines(StartLine, EndLine) 
    GetSelections = Mid$(sKeyword, StartColoum, EndColoum - StartColoum) 
     
End Function

VB6 Add-Ins Tools - Win32 Keyword Search

Dikarenakan saya tidak memiliki MSDN jadinya harus report membuat tools yang seperti ini. Tools ini gunanya untuk melakukan pencarian pada:

Win32.hlp (sebelumnya Anda harus memiliki file Win32.hlp ukurannya 24MB)
API-Guide.exe
Google (dengan keyword ... + VB6)

Hasilnya, pada menu klik kanan VB6 terdapat 3 tambahan menu seperti terlihat pada gambar:

Win32 Keyword Search

Adapun potongan kodenya adalah seperti di bawah:

'----------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com 
'----------------------------------------------------------------------------- 
 
Option Explicit 
 
Const HELP_COMMAND = &H102& 
Const HELP_CONTENTS = &H3& 
Const HELP_CONTEXT = &H1 
Const HELP_CONTEXTPOPUP = &H8& 
Const HELP_FORCEFILE = &H9& 
Const HELP_HELPONHELP = &H4 
Const HELP_INDEX = &H3 
Const HELP_KEY = &H101 
Const HELP_MULTIKEY = &H201& 
Const HELP_PARTIALKEY = &H105& 
Const HELP_QUIT = &H2 
Const HELP_SETCONTENTS = &H5& 
Const HELP_SETINDEX = &H5 
Const HELP_SETWINPOS = &H203& 
 
Private Declare Function WinHelp Lib "user32.dll" Alias "WinHelpA" (ByVal hWndMain As Long, ByVal lpHelpFile As String, ByVal uCommand As Long, dwData As Any) As Long 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal LpszDir As String, ByVal FsShowCmd As Long) As Long 
 
Public VBInstance As VBIDE.VBE 
 
Private oWin32Search As Office.CommandBarControl 
Private oGoogleSearch As Office.CommandBarControl 
Private oAPIGuideSearch As Office.CommandBarControl 
 
Private WithEvents Win32Search As CommandBarEvents 
Private WithEvents GoogleSearch As CommandBarEvents 
Private WithEvents APIGuideSearch As CommandBarEvents 
 
Private Sub SearchKeyword(Keyword As String) 
    Dim ret As Long 
    ret = WinHelp(frmDummy.hwnd, App.Path & "\win32.hlp", HELP_KEY, ByVal Keyword) 
End Sub 
 
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) 
 
    On Error GoTo ErrHandler: 
 
    Set VBInstance = Application 
     
    If ConnectMode = ext_cm_Startup Then 
        Set oWin32Search = AddItemToMenu("&Win32 Keyword Search", "Code Window") 
        Set Win32Search = VBInstance.Events.CommandBarEvents(oWin32Search) 
         
        Set oGoogleSearch = AddItemToMenu("&Google Search", "Code Window") 
        Set GoogleSearch = VBInstance.Events.CommandBarEvents(oGoogleSearch) 
        
        Set oAPIGuideSearch = AddItemToMenu("&API-Guide Search", "Code Window") 
        Set APIGuideSearch = VBInstance.Events.CommandBarEvents(oAPIGuideSearch) 
    End If 
     
    Exit Sub 
 
ErrHandler: 
 
    MsgBox Err.Description 
 
End Sub 
 
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) 
    On Error Resume Next 
    Call oWin32Search.Delete 
    Set oWin32Search = Nothing 
    Call oGoogleSearch.Delete 
    Set oWin32Search = Nothing 
    Call oWin32Search.Delete 
    Set oAPIGuideSearch = Nothing 
    Set Win32Search = Nothing 
    Set GoogleSearch = Nothing 
    Set APIGuideSearch = Nothing 
    Set VBInstance = Nothing 
End Sub 
 
Private Function AddItemToMenu(sCaption As String, sMenuName As String, Optional Bitmap As Object) As Office.CommandBarControl 
 
    Dim cbMenuCommandBar As Office.CommandBarControl 
    Dim cbMenu As CommandBar 
    Dim oTemp As Object 
    Dim sClipText As String 
 
    On Error GoTo ErrHandler: 
 
    Set cbMenu = VBInstance.CommandBars(sMenuName) 
    If cbMenu Is Nothing Then Exit Function 
 
    Set cbMenuCommandBar = cbMenu.Controls.Add(msoControlButton, , , VBInstance.CommandBars(sMenuName).Controls.Item("&Definition").Index) 
    cbMenuCommandBar.Caption = sCaption 
 
'    If Not Bitmap Is Nothing Then 
'        With Clipboard 
'            sClipText = .GetText 
'            Set oTemp = .GetData 
'            .SetData Bitmap, vbCFBitmap 
'            cbMenuCommandBar.PasteFace 
'            .Clear 
'            If Not oTemp Is Nothing Then 
'                .SetData oTemp 
'            End If 
'            .SetText sClipText 
'        End With 
'        If Err Then GoTo ErrHandler 
'    End If 
 
    Set AddItemToMenu = cbMenuCommandBar 
 
    Exit Function 
 
ErrHandler: 
 
    MsgBox Err.Description 
 
End Function 
 
Private Sub Win32Search_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim sSelections As String 
    sSelections = GetSelections 
    If Trim$(sSelections) = "" Then Exit Sub 
    Call SearchKeyword(sSelections) 
End Sub 
 
Private Sub GoogleSearch_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim r As Long 
    Dim sSelections As String 
    sSelections = Trim$(GetSelections) 
    If sSelections = "" Then Exit Sub 
    r = ShellExecute(0, "open", "http://www.google.com/search?q=" & sSelections & "+VB6", 0, 0, 1) 
End Sub 
 
Private Sub APIGuideSearch_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 
    Dim sSelections As String 
    sSelections = Trim$(GetSelections) 
    If sSelections = "" Then Exit Sub 
    Dim wsh As New IWshRuntimeLibrary.WshShell 
    wsh.RegWrite "HKCU\Software\KPD-Team\API-Guide\LastAPI", sSelections 
    Shell "C:\Program Files\API-Guide\API-Guide.exe", vbNormalFocus 
End Sub 
 
Public Function GetSelections() As String 
     
    Dim cd As CodePane 
    Dim cm As CodeModule 
 
    Set cd = VBInstance.ActiveCodePane 
    Set cm = VBInstance.ActiveCodePane.CodeModule 
 
    Dim StartLine As Long 
    Dim StartColoum As Long 
    Dim EndLine As Long 
    Dim EndColoum As Long 
     
    Dim sKeyword As String 
     
    cd.GetSelection StartLine, StartColoum, EndLine, EndColoum 
    sKeyword = cm.Lines(StartLine, EndLine) 
    GetSelections = Mid$(sKeyword, StartColoum, EndColoum - StartColoum) 
     
End Function

Selengkapnya bisa didownload pada link di bawah ini:
Download: Win32KeywordSearch

VB6 Code: Memperoleh Serial Hardisk dan Sebagainya

Mengenai cara memperoleh serial hardisk dan sebagainya. Adapun kodenya seperti terlihat di bawah ini:

Option Explicit 
  
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long 
 
Public Function GetSerialNumber(ByVal sDrive As String) As Long 
    Call GetVolumeInformation(sDrive, vbNullString, 0, GetSerialNumber, ByVal 0&, ByVal 0&, vbNullString, 0) 
End Function 
 
Private Sub Command1_Click() 
    MsgBox Hex$(GetSerialNumber("C:\")) 
End Sub

Assembler - Embed Manifest Pada Aplikasi MASM

Mengenai cara menambahkan manifest pada resource MASM (Macro Assembler).

Tambahkan baris di bawah ini pada file resource (*.rc):

#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 
#define RT_MANIFEST 24 
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"

Contoh lengkapnya seperti di bawah ini (tentu saja berbeda dengan file *.rc yang Anda miliki):

#define  ID_SPIN1 101
#define  ID_SPIN2 102

#define  ID_SLIDER1 201
#define  ID_SLIDER2 202

#define  ID_SCROLLBAR1 301
#define  ID_SCROLLBAR2 302

#define  ID_PROGRESS1 401
#define  ID_PROGRESS2 402

#define  ID_EDIT1 501
#define  ID_EDIT2 502

#define  ID_STATIC -1
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"
;################################################################################

CONTROLS DIALOGEX 0, 0, 310, 199
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Fun example using - Scroll Bar, Slider, Up Down, Progress controls"
FONT 8, "MS Sans Serif"
BEGIN
    CONTROL         "Slider1",ID_SLIDER1,"msctls_trackbar32",TBS_AUTOTICKS | 
                    TBS_BOTH | WS_TABSTOP,20,158,120,29,WS_EX_DLGMODALFRAME | 
                    WS_EX_STATICEDGE
    CONTROL         "Slider2",ID_SLIDER2,"msctls_trackbar32",TBS_VERT | 
                    TBS_TOP | WS_BORDER | WS_TABSTOP,23,53,27,89,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    SCROLLBAR       ID_SCROLLBAR1,25,14,108,24
    SCROLLBAR       ID_SCROLLBAR2,154,18,17,128,SBS_VERT
    EDITTEXT        ID_EDIT1,93,77,32,38,ES_CENTER | ES_NUMBER | NOT 
                    WS_BORDER,WS_EX_CLIENTEDGE
    CONTROL         "Spin1",ID_SPIN1,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS,83,77,11,38
    EDITTEXT        ID_EDIT2,197,67,31,17,ES_CENTER | ES_AUTOHSCROLL | 
                    ES_NUMBER | NOT WS_BORDER,WS_EX_DLGMODALFRAME | 
                    WS_EX_CLIENTEDGE
    CONTROL         "Spin2",ID_SPIN2,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS | UDS_HORZ,197,84,31,19,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    CONTROL         "Progress1",ID_PROGRESS1,"msctls_progress32",0x0,168,165,
                    114,17,WS_EX_DLGMODALFRAME
    CONTROL         "Progress2",ID_PROGRESS2,"msctls_progress32",
                    PBS_VERTICAL | PBS_SMOOTH,259,53,27,98,WS_EX_CLIENTEDGE | 
                    WS_EX_STATICEDGE
    CTEXT           "Click and drag any Slider or Scroll Bar control or click on the Up-Down control buttons.",
                    ID_STATIC,191,7,98,28,SS_SUNKEN | WS_BORDER
END

IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"

;####################################################################################

Contoh selengkapnya bisa Anda download pada link di bawah ini:

Download: khoiriyyah.vacau.com/masm_manifest.zip

Assembler: Mengenal Operasi Logika XOR

Option Explicit 
 
'-------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com 
'-------------------------------------------------------------------- 
 
Private Function XOR_(A, B) As Boolean 
    XOR_ = Not (Not (A And Not (A And B)) And Not (B And Not (A And B))) 
End Function 
 
Private Sub Command1_Click() 
    MsgBox XOR_(True, True)   'True  + True  = False 1 + 1 = 0 
    MsgBox XOR_(True, False)  'True  + False = True  1 + 0 = 1 
    MsgBox XOR_(False, True)  'False + True  = True  0 + 1 = 1 
    MsgBox XOR_(False, False) 'False + False = False 0 + 0 = 0 
End Sub

Dari sini maka:

XOR EAX, EAX ;maka hasilnya nilai EAX pasti 0
XOR AX, AX   ;maka hasilnya nilai AX pasti 0

Assembler - Menambahkan Icon 32bit pada Aplikasi MASM

Ini merupakan contoh lanjutan dari sini, mengenai cara menambahkan icon 32bit pada aplikasi MASM (Macro/Microsoft? Assembler). Adapun bagian yang ditambahkan pada file *.rc:

#define IDI_APPICON 100
IDI_APPICON ICON DISCARDABLE "icon.ico"

Sehingga lengkapnya menjadi:

#include "\masm32\include\resource.h"

;################################################################################

#define  ID_SPIN1 101
#define  ID_SPIN2 102

#define  ID_SLIDER1 201
#define  ID_SLIDER2 202

#define  ID_SCROLLBAR1 301
#define  ID_SCROLLBAR2 302

#define  ID_PROGRESS1 401
#define  ID_PROGRESS2 402

#define  ID_EDIT1 501
#define  ID_EDIT2 502

#define  ID_STATIC -1
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24

#define IDI_APPICON 100
IDI_APPICON ICON DISCARDABLE "icon.ico"

CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST DISCARDABLE "xpmanifest.xml"
;################################################################################

CONTROLS DIALOGEX 0, 0, 310, 199
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Fun example using - Scroll Bar, Slider, Up Down, Progress controls"
FONT 8, "MS Sans Serif"
BEGIN
    CONTROL         "Slider1",ID_SLIDER1,"msctls_trackbar32",TBS_AUTOTICKS | 
                    TBS_BOTH | WS_TABSTOP,20,158,120,29,WS_EX_DLGMODALFRAME | 
                    WS_EX_STATICEDGE
    CONTROL         "Slider2",ID_SLIDER2,"msctls_trackbar32",TBS_VERT | 
                    TBS_TOP | WS_BORDER | WS_TABSTOP,23,53,27,89,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    SCROLLBAR       ID_SCROLLBAR1,25,14,108,24
    SCROLLBAR       ID_SCROLLBAR2,154,18,17,128,SBS_VERT
    EDITTEXT        ID_EDIT1,93,77,32,38,ES_CENTER | ES_NUMBER | NOT 
                    WS_BORDER,WS_EX_CLIENTEDGE
    CONTROL         "Spin1",ID_SPIN1,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS,83,77,11,38
    EDITTEXT        ID_EDIT2,197,67,31,17,ES_CENTER | ES_AUTOHSCROLL | 
                    ES_NUMBER | NOT WS_BORDER,WS_EX_DLGMODALFRAME | 
                    WS_EX_CLIENTEDGE
    CONTROL         "Spin2",ID_SPIN2,"msctls_updown32",UDS_SETBUDDYINT | 
                    UDS_AUTOBUDDY | UDS_ARROWKEYS | UDS_HORZ,197,84,31,19,
                    WS_EX_DLGMODALFRAME | WS_EX_CLIENTEDGE
    CONTROL         "Progress1",ID_PROGRESS1,"msctls_progress32",0x0,168,165,
                    114,17,WS_EX_DLGMODALFRAME
    CONTROL         "Progress2",ID_PROGRESS2,"msctls_progress32",
                    PBS_VERTICAL | PBS_SMOOTH,259,53,27,98,WS_EX_CLIENTEDGE | 
                    WS_EX_STATICEDGE
    CTEXT           "Click and drag any Slider or Scroll Bar control or click on the Up-Down control buttons.",
                    ID_STATIC,191,7,98,28,SS_SUNKEN | WS_BORDER
END

IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"

;####################################################################################

Selanjutnya pada file *.ASM, bagian yang ditambahkan:

.CONST

    IDI_APPICON     EQU 100

Pada message pembuatan dialog WM_INITDIALOG tambahkan kode di bawah ini:

        .if uMsg == WM_INITDIALOG
        
                    ; set app icon
                    INVOKE LoadImage, hInstance, IDI_APPICON, IMAGE_ICON, 32, 32, LR_DEFAULTSIZE
                    mov hIcon, eax
                    INVOKE SendMessage, hWin, WM_SETICON, ICON_BIG, hIcon
                    INVOKE LoadImage, hInstance, IDI_APPICON, IMAGE_ICON, 16, 16, LR_DEFAULTSIZE
                    mov hIcon, eax
                    INVOKE SendMessage, hWin, WM_SETICON, ICON_SMALL, hIcon
                    ;End set icon

Sehingga sekarang hasil akhirnya seperti gambar di bawah ini:

Gambar: MASM Icon 32 bit

Download: MASM Icon32bit

Wednesday, April 17, 2013

VB6 Code - Membuat Cue Banner atau Placeholder Text

Apa yang dimaksud dengan cue banner atau placeholder text atau sebagian menyebutnya dengan watermark text itu? untuk memahaminya perhatikan gambar di bawah ini:

VB6 Cue Banner Placeholder Text Watermark Text

Terlihat pada gambar di atas beberapa objek (ComboBox dan beberapa TextBox) yang memiliki tulisan kurang jelas dengan warna keabu-abuan. Nah, tulisan yang kurang jelas itulah yang dinamakan dengan cue banner/placeholder text/watermark text. Tulisan itu hanya akan muncul apabila objek-objek tersebut memiliki property Text = "" serta dalam keadaan lost focus.

Berikut beberapa bagian kode darinya:

Option Explicit
 
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
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

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 Sub SetCueBanner(obj As Object, str As String)
    Dim s As String
    Dim c As COMBOBOXINFO
    If TypeOf obj Is ComboBox Then
        c.cbSize = Len(c)
        Call GetComboBoxInfo(obj.hwnd, c)
        s = StrConv(str, vbUnicode)
        Call SendMessage(c.hwndEdit, EM_SETCUEBANNER, 0&, ByVal s)
    Else 'TextBox
        s = StrConv(str, vbUnicode)
        Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s)
    End If
End Sub

Catatan sangat penting:

Cue banner tidak bisa berjalan pada WinXP yang terinstall left to rigth language seperti arabic dsb. Hal tersebut merupakan bug dari Microsoft sendiri, dan telah diperbaiki pada OS selanjutnya.
Cue banner hanya akan berjalan setelah dicompile serta diberi manifest (XP Style)

Lebih lengkap mengenai pembuatan cue banner/placeholder text/watermark text bisa Anda download pada tautan di bawah ini:

Download: VB6_CueBanner

Sunday, March 31, 2013

Menghilangkan Ritual Mode Compatibility - VB6 Tips

Sebuah aplikasi yang dibuat dengan VB6 seringkali tidak kompatibel dengan OS yang berada di atas XP, akhirnya user harus melakukan kegiatan ritual rutinan pada saat pertama kali menjalankan aplikasi exe tersebut. Adapun rutinan yang dimaksud adalah sebagai berikut:

Klik kanan di icon exe program tersebut.
Pilih Properties
Kemudian klik pada tab Compatibility
Anda dapat memilih atau bisa juga tidak di tombol Change settings for all users
Berikan tanpa centang di Run this program in compatibility mode for
Di dalam menu drop-down pilih sistem operasi yang sesuai
Klik tombol Apply dan OK

Nah, agar user tidak direpotkan dengan kegiatan di atas, lebih baik Anda sisipkan saja beberapa script untuk memasukan beberapa nilai pada registry, di bawah adalah contohnya (InnoSetup Installer):

Scrip Inno sebelumnya....
[Registry]
Root: HKCU; Subkey: "Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers"; ValueType: String; ValueName:"{app}\AplikasiAnda.exe"; ValueData: "WINXP"; Flags: Uninsdeletekey
Root: HKLM; Subkey: "Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers"; ValueType: String; ValueName:"{app}\AplikasiAnda.exe"; ValueData: "WINXP"; Flags: Uninsdeletekey
Scrip Inno sesudahnya....

Demikian, semoga bermanfaat.

VB6 Tools: VB6 Code Tidy

Sebelumnya saya pernah memposting beberapa VB6 Tools, salah satu yang dianggap bermanfaat diantaranya adalah Manifest Creator yang dibuat LaVolpe.
Kali ini masih mengenai VB6 tools yang berguna untuk men-tidy code-code VB6. Contoh kode:

Private Sub GetProfilIDAndBloggerID(TextXML As String)

Dim child As IXMLDOMNode
Dim x As New DOMDocument
x.loadXML TextXML
Dim strID As String
Dim i As Integer
' Add the child nodes

ReDim strIDAndProfiles(0)

For Each child In x.documentElement.childNodes
If child.NodeName = "entry" Then
For i = 0 To child.childNodes.Length - 1
If child.childNodes(i).NodeName = "id" Then
strID = child.childNodes(i).Text
If Trim$(strID) <> "" Then
strIDAndProfiles(UBound(strIDAndProfiles)) = strID
End If
ReDim Preserve strIDAndProfiles(UBound(strIDAndProfiles) + 1)
End If
Next
End If
Next

If blnFromFile = False Then
strPathXML = App.Path & "\" & strTitle & ".XML"
End If

Dim b As Integer

frmBlog.List1.Clear

If UBound(strIDAndProfiles) > 0 Then
For i = 0 To UBound(strIDAndProfiles)
If Trim$(strIDAndProfiles(i)) <> "" Then
frmBlog.List1.AddItem strIDAndProfiles(i)
End If
Next
End If

With frmBlog
If .List1.ListCount > 1 Then
.Show vbModal, frmMain
strID = .List1.List(.List1.ListIndex)
Else
strID = .List1.List(0)
End If
End With

i = InStr(1, strID, "user-")
b = InStr(1, strID, "blog-")

strBlogID = Mid$(strID, b + 5, 19)
strProfileID = Mid$(strID, i + 5, Len(strID) - (b + 3))
Set x = Nothing

End Sub

Melihat kode di atas, tidak Anda kesulitan membacanya? Nah, dengan tools ini Anda akan mudah meng-indentnya secara tepat, sehingga menjadi:

Private Sub GetProfilIDAndBloggerID(TextXML As String)

    Dim child As IXMLDOMNode
    Dim x As New DOMDocument
    x.loadXML TextXML
    Dim strID As String
    Dim i As Integer
    ' Add the child nodes

    ReDim strIDAndProfiles(0)

    For Each child In x.documentElement.childNodes
        If child.NodeName = "entry" Then
            For i = 0 To child.childNodes.Length - 1
                If child.childNodes(i).NodeName = "id" Then
                    strID = child.childNodes(i).Text
                    If Trim$(strID) <> "" Then
                        strIDAndProfiles(UBound(strIDAndProfiles)) = strID
                    End If
                    ReDim Preserve strIDAndProfiles(UBound(strIDAndProfiles) + 1)
                End If
            Next
        End If
    Next

    If blnFromFile = False Then
        strPathXML = App.Path & "\" & strTitle & ".XML"
    End If

    Dim b As Integer

    frmBlog.List1.Clear

    If UBound(strIDAndProfiles) > 0 Then
        For i = 0 To UBound(strIDAndProfiles)
            If Trim$(strIDAndProfiles(i)) <> "" Then
                frmBlog.List1.AddItem strIDAndProfiles(i)
            End If
        Next
    End If

    With frmBlog
        If .List1.ListCount > 1 Then
            .Show vbModal, frmMain
            strID = .List1.List(.List1.ListIndex)
        Else
            strID = .List1.List(0)
        End If
    End With

    i = InStr(1, strID, "user-")
    b = InStr(1, strID, "blog-")

    strBlogID = Mid$(strID, b + 5, 19)
    strProfileID = Mid$(strID, i + 5, Len(strID) - (b + 3))
    Set x = Nothing

End Sub

Cara menggunakan:

Ekstrak terlebih dahulu
Klik Install.bat
Buka project VB6 apa saja (terserah)
Klik Menu Add-Ins, pada menu ini Anda akan menemukan sebuah menu baru yaitu menuu Rapikan Kode
Klik Rapikan Kode
Beri centang pada CheckBox Rapikan Seluruhnya untuk merapikan seluruh kode yang ada pada Project

Download: VB6 Code Tidy Source Code

Friday, January 25, 2013

Edit Class 1.0 - Mempermudah Membuat Posting di Blogspot

Mengenai Edit Class versi 1.0 sebuah sofware editor sederhana yang saya buat untuk mempermudah membuat postingan di blogspot.

Apakah Edit Class 1.0 itu?

Edit class 1.0 merupakan sebuah software editor sederhana untuk mempermudah membuat posting di blogspot. Edit class bukan HTML editor, dia hanya lebih spesifik dari itu. Karena tujuannya yang sederhana, Edit Class tidak memperlakukan HTML sebagai objek yang memiliki properties, atribut, dsb, tetapi ia lebih memperlakukan HTML sebagai string, jadi dalam kenyataannya ia hanya memanipulasi string. File yang dihasilkan berektensi .blr [pada kenyataannya ia hanya file teks biasa yang bisa Anda buka melalui NotePad].

Gambar: Edit Class 1.0 - Sofware Editor Sederhana

Sebelum Menggunakan Edit Class 1.0

Sebelum menggunakan ada hal yang harus diperhatikan, bahwa Edit Class terdiri dari beberapa bagian, di antaranya yang paling terpenting adalah: SideBar yang tediri dari dua bagian: Daftar HTML dan Daftar Macro, MainEdit yang terdiri dari: BodyPost, Preview, CustomCSS, EditHTML, EditMacros.

Daftar HTML

Daftar HTML berguna untuk membuat daftar tags HTML yang dibutuhkan. Untuk menambah daftar HTML yang dibutuhkan, Anda dapat membuka file yang terdapat pada Program Files\Code\HTMLTag.txt dan mengeditnya menggunakan Notepad. Adapun format kodenya adalah sebagai berikut:

{Name!+StartTags|EndTags}

Contoh:

{Underline!+<U>|</U>}

Daftar Macro

Daftar Macro macro dibuat berdasarkan daftar HTML di atas, untuk menambah daftar Macro yang dibutuhkan, Anda dapat membuka file yang terdapat pada Program Files\Code\Macros.txt. Macro digunakan untuk meng-eksekusi (menjalankan) rangkaian perintah daftar HTML di atas secara berurutan dari kiri ke kanan. Adapun format kodenya adalah sebagai berikut:

{MacroName:HTMLName,HTMLName, etc.}

Contoh:

{italic+underline:italic,Underline}

Preview

Preview digunakan untuk melihat hasil tulisan Anda yang dibuat pada Tab Body Post.

Custom CSS

Custom CSS merupakan style CSS yang yang akan mempengaruhi preview. Custom CSS digunakan sebagai simulasi CSS yang terdapat pada blog agar style tulisan offline yang Anda buat dengan Edit Class menyerupai style tulisan online.

Daftar Built-In Functions

Pada versi 1.0 ini, Edit Class memiliki beberapa fungsi built-in yang dapat ditambahkan pada file yang terdapat di Program Files\Code\HTMLTag.txt. Adapun format kode untuk memanggil fungsi-fungsi built-in adalah sebagai berikut:

{Name!+Built-In}

Contoh:

{Encode!+EncodeHTML}

Adapun fungsi-fungsi built-in tersebut, yaitu:

DecodeHTML
EncodeHTML
RemoveHTML
MakeTable
FormatVB6Code
OrdinerList
UnOrdinerList
InsertLink
InsertImage

Cara menggunakan Edit Class 1.0

Buatlah tulisan pada Body Post
Pilih teks yang akan dimodifikasi
DoubleKlik HTML atau Macro yang dibutuhkan
Setelah, selesai kopi tulisan ke dalam posting blogspot milik Anda.

Download: EditClass1.0

Thursday, January 24, 2013

TEST - Membuat Table di Blogspot

Catatan
Because while loops do not have explicit built-in counter variables, they are more vulnerable to infinite looping than the other types of loops. Moreover, because it is not necessarily easy to discover where or when the loop condition is updated, it is easy to write a while loop in which the condition never gets updated. For this reason, you should be careful when you design while loops.

HTML List Tags

Tag	Description
<ol>	Defines an ordered list
<ul>	Defines an unordered list
<li>	Defines a list item
<dl>	Defines a definition list
<dt>	Defines an item in a definition list
<dd>	Defines a description of an item in a definition list

Subscribe to: Posts ( Atom )

Wednesday, July 10, 2013

Tuesday, July 9, 2013

Friday, July 5, 2013

Thursday, July 4, 2013

Wednesday, July 3, 2013

Monday, July 1, 2013

Wednesday, April 17, 2013

Sunday, March 31, 2013

Friday, January 25, 2013

Apakah Edit Class 1.0 itu?

Sebelum Menggunakan Edit Class 1.0

Daftar Built-In Functions

Cara menggunakan Edit Class 1.0

Thursday, January 24, 2013

HTML List Tags

Perhatian

Page Rank

Online

Statistik Pengunjung

embrio9 - Auto Reply

Blog Archive

Visual Basic 6.0

Arabic

Blogging

Miscellaneous