Showing posts with label Misc-VB6. Show all posts
Showing posts with label Misc-VB6. Show all posts

Wednesday, July 4, 2012

VB6 Facebook: Mengakses Facebook Graph API

Mengenai teka-teki mengakses Facebook graph API - Agar tidak membosankan kali ini saya ajak Anda untuk bermain teka-teki saja, apakah semuanya setuju? oh, ternyata semuanya setuju. Baiklah teka-teki kali ini mengenai cara mengendalikan Facebook yang kita miliki dari aplikasi VB6 yang kita buat menggunakan Graph API. Di sini hanya diwakili dengan aplikasi facebook uploader sederhana. Untuk membuat aplikasi tersebut tidak sederhana/rumit, baik, user friendy maka kita membutuhkan satu lagi pemahaman mengenai JSON parser.

Tidak seperti Twitter yang menggunakan OAuth 1.0 yang sangat memusingkan kepala pada saat pembuatan digital signature yang valid (seperti yang telah saya posting sebelumnya, maka pada Facebook prosesnya jauh lebih sederhana kita hanya memerlukan access_token jangka panjang itu saja, atau access_token yang digenerate on the fly melalui OAuth 2.0, jadi kita sudah tidak memerlukan lagi password dan email untuk proses otentifikasi dan otorisasi yang tentu saja sangat tidak aman (berpotensi terjadinya pembajakan akun secara besar-besaran) dan ini sudah tidak dianjurkan lagi baik oleh Google, Facebook, Twitter, .dll (termasuk .ocx juga?).

Mengenai cara memperoleh access_token dari Facebook, silakan Anda cari di Google.

VB6 Facebook Graph API - Photo Uploader
Gambar: Upload photo ke Facebook melalui VB6
Demikian teka-teki kali ini mengenai cara mengakses Facebook graph API melalui aplikasi VB6. Baca juga teka-teka sebelumnya:
READ MORE - VB6 Facebook: Mengakses Facebook Graph API

Sunday, June 17, 2012

VB6 Code - Memperoleh Control Yang Sedang Aktif - Focus

Option Explicit

Private Sub Timer1_Timer()
Dim cControl As Control
Set cControl = Me.ActiveControl

If Not cControl Is Nothing Then
Caption = cControl.Name
End If
End Sub

READ MORE - VB6 Code - Memperoleh Control Yang Sedang Aktif - Focus

Membaca dan Menampilkan Karakter Unicode

Option Explicit

Private Sub Command1_Click()
Dim a(0 To 5) As Byte
a(0) = &HFF
a(1) = &HFE
a(2) = &H39
a(3) = &H4E
a(4) = &H44
a(5) = &H0
Open "unicode.txt" For Binary As #1
Put #1, , a
Close #1
End Sub

Private Sub Command2_Click()
Dim txtline As String

Open "unicode.txt" For Binary As #1
txtline = InputB(2, #1)
txtline = InputB(4, #1)
Close #1

TextBox1.Text = txtline
End Sub
READ MORE - Membaca dan Menampilkan Karakter Unicode

Apakah ScrollBar Visible Pada Sebuah Control?

Option Explicit

Private Const GWL_STYLE = (-16)
Private Const WS_HSCROLL = &H100000
Private Const WS_VSCROLL = &H200000

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub Command1_Click()
Dim wndStyle As Long
wndStyle = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
If (wndStyle And WS_HSCROLL) <> 0 Then
MsgBox "A horizontal scroll bar is visible."
Else
MsgBox "A horizontal scroll bar is NOT visible."
End If

If (wndStyle And WS_VSCROLL) <> 0 Then
MsgBox "A vertical scroll bar is visible."
Else
MsgBox "A vertical scroll bar is NOT visible."
End If
End Sub

Private Sub Command2_Click()
TreeView1.Move 250, 900, 1000, 1000
End Sub

Private Sub Form_Load()
Form1.ScaleMode = 1
Form1.Move 0, 0, 5100, 5040
Command1.Caption = "Scroll Bar Test"
Command1.Move 120, 120, 1700, 500
Command2.Caption = "Size Control"
Command2.Move 2000, 120, 1700, 500
TreeView1.Move 250, 900, 3000, 1500
TreeView1.Nodes.Add , , , "1: Sample Text"
TreeView1.Nodes.Add , , , "2: Sample Text"
TreeView1.Nodes.Add , , , "3: Sample Text"
TreeView1.Nodes.Add , , , "4: Sample Text"
End Sub
READ MORE - Apakah ScrollBar Visible Pada Sebuah Control?

Contoh MRU - Most Recently Used

Option Explicit

Private Const MaxMRU = 4
Private Const NotFound = -1
Private Const NoMRUs = -1

Private MRUCount As Long

Private Sub Form_Load()
MRUCount = NoMRUs

GetMRUFileList
End Sub

Private Sub Form_Unload(Cancel As Integer)
SaveMRUFileList
End Sub

Private Sub mnuMRU_Click(Index As Integer)
ReorderMRUList mnuMRU(Index).Caption, CLng(Index)
End Sub

Private Sub mnuOpen_Click()
Me.CommonDialog1.ShowOpen

AddMRUItem Me.CommonDialog1.FileName
End Sub

Private Sub AddMRUItem(NewItem As String)
Dim result As Long

result = CheckForDuplicateMRU(NewItem)

If result <> NotFound Then
ReorderMRUList NewItem, result
Else
AddMenuElement NewItem
End If
End Sub

Private Function CheckForDuplicateMRU(ByVal NewItem As String) As Long
Dim i As Long

NewItem = UCase$(NewItem)

For i = 0 To MRUCount
If UCase$(Me.mnuMRU(i).Caption) = NewItem Then
CheckForDuplicateMRU = i

Exit Function
End If
Next i

CheckForDuplicateMRU = -1
End Function

Private Sub mnuQuit_Click()
Unload Me
End Sub

Private Sub AddMenuElement(NewItem As String)
Dim i As Long

If (MRUCount < (MaxMRU - 1)) Or (MaxMRU = -1) Then
MRUCount = MRUCount + 1

If MRUCount <> 0 Then
Load mnuMRU(MRUCount)
End If

mnuMRU(MRUCount).Visible = True
End If

For i = (MRUCount) To 1 Step -1
mnuMRU(i).Caption = mnuMRU(i - 1).Caption
Next i

mnuMRU(0).Caption = NewItem
End Sub

Private Sub ReorderMRUList(DuplicateMRU As String, DuplicateLocation As Long)
Dim i As Long

For i = DuplicateLocation To 1 Step -1
mnuMRU(i).Caption = mnuMRU(i - 1).Caption
Next i

mnuMRU(0).Caption = DuplicateMRU
End Sub

Private Sub GetMRUFileList()
Dim i As Long
Dim result As String

Do
result = GetSetting(App.Title, "MRUFiles", Trim$(CStr(i)), "")

If result <> "" Then
AddMRUItem result
End If

i = i + 1
Loop Until (result = "")
End Sub

Private Sub SaveMRUFileList()
Dim i As Long

For i = 0 To MRUCount
SaveSetting App.Title, "MRUFiles", Trim$(CStr(i)), mnuMRU(i).Caption
Next i
End Sub
READ MORE - Contoh MRU - Most Recently Used

Cara Membuat Generic Handler Error

Option Explicit

Private Sub Form_Load()
On Error GoTo FormLoadErr
Err.Raise 76
Err.Raise 70
Exit Sub

FormLoadErr:
Select Case Err.Number
Case 76
MsgBox "Form_Load Error Handler. Form Does Not Exist"
Case Else
AppWideErr (Err.Number)
End Select
End Sub

Private Sub Command1_Click()
On Error GoTo Cmd1Err
Err.Raise 53
Err.Raise 70
Exit Sub

Cmd1Err:
Select Case Err.Number
Case 53
MsgBox "Command 1 Error Handler"
Case Else
AppWideErr (Err.Number)
End Select
Resume Next
End Sub

Private Sub Command2_Click()
Form2.Show
End Sub

Private Sub Command1_Click()
On Error GoTo ThisSubErr
Err.Raise 17
Exit Sub
ThisSubErr:
AppWideErr (Err.Number)
End Sub

Public Sub AppWideErr(lnErrNumber)
Select Case lnErrNumber
Case 70
MsgBox "Generic Routine. Access Denied. See Net Administrator.", , "AppWideErr"
Exit Sub
Case Else
MsgBox "Generic Routine. Unhandled Error: " + Err.Description + " # " & lnErrNumber, , "AppWideErr"
Exit Sub
End Select
End Sub
READ MORE - Cara Membuat Generic Handler Error

Membuat Aplikasi Console Dengan Visual Basic 6.0

Option Explicit

Declare Function AllocConsole Lib "kernel32" () As Long
Declare Function FreeConsole Lib "kernel32" () As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long

Public Const STD_OUTPUT_HANDLE = -11&
Dim hConsole As Long

Private Sub Command1_Click()
Dim Result As Long, sOut As String, cWritten As Long
sOut = "Hi There" & vbCrLf
Result = WriteConsole(hConsole, ByVal sOut, Len(sOut), cWritten, ByVal 0&)
Shell "C:\TEST.BAT"
End Sub

Private Sub Form_Load()
If AllocConsole() Then
hConsole = GetStdHandle(STD_OUTPUT_HANDLE)
If hConsole = 0 Then MsgBox "Couldn"
Else
MsgBox "Couldn"
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
CloseHandle hConsole
FreeConsole
End Sub
READ MORE - Membuat Aplikasi Console Dengan Visual Basic 6.0

Contoh Menjalankan Procedure Di dalam Script Control

Option Explicit

Private Sub Command1_Click()
ScriptControl1.Modules.Add Text1.Text
Form_Activate
End Sub

Private Sub Command2_Click()
ScriptControl1.Modules(List1).AddCode Text1.Text
List1_Click
End Sub

Private Sub Command3_Click()
Dim RetVal As Variant, m As Variant
Set m = ScriptControl1.Modules(List1.Text)
With m.Procedures(List2.Text)
Select Case .NumArgs
Case 0
RetVal = m.Run(List2.Text)
Case 1
RetVal = m.Run(List2.Text, 5)
Case 2
RetVal = m.Run(List2.Text, 4, 23)
Case Else
MsgBox "Procedure has too many arguments"
End Select
If .HasReturnValue Then
MsgBox List2.Text & " returned: " & RetVal
End If
End With
End Sub

Private Sub Form_Activate()
Dim m As Variant
List1.Clear
With ScriptControl1
.Language = "VBScript"
.AllowUI = True
For Each m In .Modules
List1.AddItem m.Name
Next m
End With
End Sub

Private Sub Form_Load()
Command1.Caption = "Add Module"
Command2.Caption = "Add Code"
Command3.Caption = "Run Procedure"
End Sub

Private Sub List1_Click()
Dim m As String, p As Variant
m = List1
List2.Clear
If m = "" Then Exit Sub
For Each p In ScriptControl1.Modules(m).Procedures
List2.AddItem p.Name
Next p
End Sub

Private Sub List2_Click()
Dim m As String, p As String, r As Boolean, a As Long
m = List1
p = List2
With ScriptControl1.Modules(m).Procedures(p)
r = .HasReturnValue
a = .NumArgs
End With
MsgBox m & "." & p & " has " & IIf(r, "a", "no") & _
" return value and " & a & " arguments"
End Sub

'Tambahkan module dan prosedur di bawah ini pada script control
Function Calc(X)
Calc = X * 2
End Function

Function Calc(X, Y)
Calc = X * Y
End Function

Sub Test()
MsgBox "The Test Sub in Module Mod2"
End Sub
READ MORE - Contoh Menjalankan Procedure Di dalam Script Control

Spin Artikel Bahasa Indonesia

Apa yang dimaksud artikel spin/spin artikel/article spinner? bisa Anda baca di sini. Dengan kata lain artikel spin adalah mengganti kata dengan menggunakan sinonim dari kata tersebut secara besar-besaran. Tujuannya? Mengecoh mesin pencari agar artikel yang kita duplikatkan (copy paste) berubah menjadi sebuah konten unik menurut pengamatan robot/mesin pencari (bukan menurut pengamatan manusia). Contoh:

Saya akan pergi ke pasar. berubah menjadi
Ana berencana berangkat ke pasar. atau
Ane mau pergi ke pasar. atau
Aku berencana pergi ke pasar. atau
Gue akan berangkat ke pasar. atau
gw mo pergi ke pasar. atau
dan seterusnya. dan seterusnya.

Bukankah seluruh kalimat di atas tersebut unik menurut versi mesin pencari? Nah, bagaimana menurut versi manusia (saya dan Anda)?

Spin artikel bisa dikategorikan sebagai sebuah teknik SEO yang sedikit hitam yang dapat menyebabkan banyaknya duplikasi konten/sampah menurut pengamatan manusia. Tetapi dalam dunia sales online/reseller/affeliate hal ini tidak bisa dihindari. Ya saya ulangi, dalam dunia sales online hal ini tidak bisa dihindari. Satu produk dengan merk yang sama dijual oleh ribuah atau jutaan orang secara online.

Di bawah ini merupakan contoh kode spin artikel bahasa indonesia dengan menggunakan 5 kata dan sinonimnya (seharusnya 5000 kata beserta sinonimnya), yakni saya, pergi, blogger, gmail, akan.
Option Explicit 

Private Function
ChooseWord(choice As Variant, bWord, Optional bUnik As Boolean) As String

Dim i As Integer
Dim
strSpin() As String, strChooseWord As String
strSpin = Split(choice, ",")
If Not bUnik Then
Randomize
i =
CInt((UBound(strSpin) * Rnd) + 1)
strChooseWord = strSpin(i - 1)
Else
Do
Randomize
i =
CInt((UBound(strSpin) * Rnd) + 1)
strChooseWord = strSpin(i - 1)
Loop While strChooseWord = bWord
End If
ChooseWord = strChooseWord

End Function

Private Sub
cmdDoSpin_Click()
Dim strResult As String
Dim
strSource As String
strResult = txtResult.Text
strSource = txtSource.Text

strResult = LCase(strSource)

Dim
arrWord() As String
ReDim
arrWord(4) 'gantilah menjadi 40, 400, atau 4000
'apabila algoritmanya telah dimodif dan mantap maka
'tambahkan sinonim menjadi 40, 400, atau 4000
arrWord(0) = "saya, aku, ane, ana"
arrWord(1) = "pergi, berangkat"
arrWord(2) = " akan, berencana"
arrWord(3) = "blogger, blogspot, blog milik google (blogspot)"
arrWord(4) = "gmail, gmail.com, google mail, layanan email milik google (gmail)"
'--------------------------------------------------------
Dim i As Integer, k As Integer

For i =
LBound(arrWord) To UBound(arrWord)
Dim strSpin() As String
strSpin = Split(arrWord(i), ",")
For k = LBound(strSpin) To UBound(strSpin)
If InStr(1, strSource, strSpin(k)) > 0 Then
strResult = Replace(strResult, strSpin(k), ChooseWord(arrWord(i), strSpin(k), Check1.Value = 1))
Exit For
End If
Next
Next
txtResult.Text = Trim$(strResult)
End Sub

Cobalah Anda kembangkan. Semoga kode spin artikel bahasa indonesia di atas bermanfaat. Terima kasih atas kunjungannya.
READ MORE - Spin Artikel Bahasa Indonesia

Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_TERMINATE As Long = &H1

Public Sub terminateApp(ByVal sWindowTitle As String, ByVal fSilent As Boolean)


Dim lHwnd As Long
Dim lProc As Long
Dim lProcHnd As Long

On Error GoTo ErrHandler

sWindowTitle = "Inbox - Thunderbird"
sWindowTitle = "Test"

lHwnd = FindWindow(vbNullString, sWindowTitle)
If lHwnd = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

GetWindowThreadProcessId lHwnd, lProc
If lProc = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

lProcHnd = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, 0, lProc)
If lProcHnd = 0 Then
If fSilent Then
Exit Sub
Else
Err.Raise 1, , "Can"
End If
End If

If TerminateProcess(lProcHnd, 0&) <> 0 Then
If Not fSilent Then
Err.Raise 1, , "Failed to terminate process"
End If
End If

CloseHandle lProcHnd

Exit Sub

ErrHandler:

Err.Raise Err.Number, , Err.Description

End Sub
READ MORE - Menutup Sebuah Aplikasi Secara Paksa (Force Terminate)

Menutup Sebuah Aplikasi Secara Request

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE As Long = &H10

Public Sub closeApp(ByVal sWindowTitle As String, Optional ByVal fSilent As Boolean = False)
Dim lHwnd As Long
On Error GoTo ErrHandler

lHwnd = FindWindow(vbNullString, sWindowTitle)

If lHwnd = 0 Then
If Not fSilent Then
Err.Raise 1, , "Can"
End If
Else
PostMessage lHwnd, WM_CLOSE, 0, 0
End If

Exit Sub

ErrHandler:
Err.Raise Err.Number, , Err.Description
End Sub
READ MORE - Menutup Sebuah Aplikasi Secara Request

Thursday, June 14, 2012

Contoh Mengambil Image Dari Resource - VB6 Code

Mengenai cara mengambil gambar dari file resource menggunakan pemrograman Visual Basic 6 - Bagaimana kita dapat menggunakan gambar yang terdapat pada resource file, berikut adalah jawabannya:
Private Sub Form_Paint()
Me.PaintPicture VB.LoadResPicture(101, vbResBitmap), 0, 0
End Sub
Walaupun hanya satu baris, semoga bermanfaat.
READ MORE - Contoh Mengambil Image Dari Resource - VB6 Code

Tuesday, June 12, 2012

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

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

Friday, June 8, 2012

Cara Membuat Prosedure Generator Nama Secara Acak (Random)

Fungsi untuk membuat nama secara random (acak) - Di bawah ini merupakan prosedur yang digunakan untuk membuat nama secara acak, fungsi ini memiliki satu parameter untuk mengatur jumlah huruf yang akan digenerate, sedangkan nilai defaultnya adalah 4 huruf. Bagaimana fungsi generator nama secara acak atau random, bisa Anda lihat di bawah ini:
Option Explicit 

Private Function
NamaAcak(Optional k As Integer = 4) As String
Dim
s(1) As String, l As String
Randomize
s(0) = ("aiueo")
s(1) = ("bcdfghjklmnpqrstvwxyz")
For i = 1 To k
l = l
& Mid(s(i Mod 2), Int((4 * Rnd) + 1), 1)
Next
NamaAcak = l
End Function
Contoh penggunaan fungsi di atas:
Private Sub Command1_Click() 
MsgBox NamaAcak(10) 'menampilkan nama acak yang memiliki jumlah huruf 10
'sedangkan contoh di bawah akan mengenerate 20 nama acak
'dengan jumlah huruf 10 karakter
Dim i As Integer
List1.Clear
For i = 1 To 20
List1.AddItem NamaAcak(6)
Next
End Sub
Apakah kegunaan dari generator nama secara acak/random ini? saya juga tidak tahu, mungkin Anda tahu?
READ MORE - Cara Membuat Prosedure Generator Nama Secara Acak (Random)

Memahami Drag and Drop Dalam Visual Basic 6

Posting mengenai contoh operasi Drag and Drop menggunakan OLE pada VB6, Sebelum Anda mencoba kode drag and drop di bawah ini, settinglah property objek Picture1 OLEDropMode = 1 - Manual dan Property AutoSize = True.
Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)  
On Error GoTo
ErrHandler
Picture1.Picture = LoadPicture(Data.Files(1))
Exit Sub

ErrHandler:
MsgBox "Error gambar tidak bisa diload"
End Sub
Untuk melihat cara kerjanya, bukalah Windows Explorer draglah satu file gambar yang terdapat pada Windows Explorer tersebut, selanjutnya drop tepat di atas object PictureBox.
READ MORE - Memahami Drag and Drop Dalam Visual Basic 6

VB Code - Membuat Sound Beep ala Anti Virus AVIRA

Mengenai cara membuat suara beep seperti yang terdapat pada antivirus Avira menggunakan VB6 Code - Pada saat mendeteksi sebuah virus/malware, biasanya anti virus Avira akan mengeluarkan suara yang khas melalui internal speaker. Nah, di bawah ini merupakan cara membuat sound beep ala Avira dengan memanggil fungsi API Beep yang terdapat pada liblary Kernel32. Cobalah untuk mengkalibrasi frekuensi serta durasinya!
Option Explicit 

Private Declare Function Beep
Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub
AvirasBeep()
Beep 1500, 100 'frekuensi 1500khz, durasi 100 milidetik
Beep 2000, 80 'frekuensi 2000khz, durasi 80 milidetik
Beep 3200, 70 'frekuensi 3200khz, durasi 70 milidetik
End Sub

Private Sub
Command1_Click()
AvirasBeep
End Sub
READ MORE - VB Code - Membuat Sound Beep ala Anti Virus AVIRA

Thursday, June 7, 2012

VB6.0 - Code Generator: Add OCX Add DLL Programmatically

Yang dimaksud kode generator disini adalah sebuah aplikasi yang digunakan untuk membuat sebuah project. Adapun tujuan utamanya ialah untuk menghemat waktu, tenaga, dan biaya sedangkan tujuan lainnya yang tidak kalah penting adalah kecepatan. Kode generator sangat baik sekali digunakan untuk pembuatan aplikasi-aplikasi database, karena aplikasi database hampir memliki kode-kode yang sama (insert-update-delete-dsb) hanya objeknya saja yang berbeda. Maka jika kita ingin membuat belasan aplikasi database dengan objek yang berbeda, pembuatan kode generator dengan rancangan yang baik sungguh sangat layak untuk dipertimbangkan. Sebagai contoh Anda dapat mendownload kode generator yang kurang baik atau tepatnya tidak baik disini. Walaupun kurang baik, tapi coba perhatikan apakah keistimewaanya.

Membuat aplikasi kode generator yang baik, tentunya harus memiliki kemampuan menambahkan sembarang OCX dan referensi DLL yang support VB6.0. Bagaimanakah caranya? Di bawah ini merupakan potongan dari kode generator tersebut, gunanya untuk menambahkan referensi DLL dan OCX.
'------------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com
' Administrator
'-------------------------------------------------------------------------------

Public
VBInstance As VBIDE.VBE
Public Connect As Connect

Option Explicit

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

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

Private Sub
Command1_Click()
'Add ListView to VB6 project
InsertOCX "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}"
'Add TreeView
InsertOCX "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}"
'Add MSFlexGrid
InsertOCX "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}"
End Sub

Private Sub
Command2_Click()
'Add scrun.dll Microsoft Scripting Runtime)
InsertReferences "{420B2830-E718-11CF-893D-00A0C9054228}", 1#, 0
'Add msado15.dll Microsoft ActiveX Data Objects 2.8 Library)
InsertReferences "{2A75196C-D9EB-4129-B803-931327F72D5C}", 2, 8
End Sub
Adapun cara menggunakan kode di atas telah saya bahas disini dan disini. Semoga bermanfaat.
READ MORE - VB6.0 - Code Generator: Add OCX Add DLL Programmatically

Tuesday, May 29, 2012

Beberapa masalah penggunaan file manifest dan Penyelesaiannya

Penggunaan file manifest untuk meng- Style XP-kan objek-objek Visual Basic 6.0 ternyata memiliki bebearapa masalah, diantaranya:
  1. Hilangnya shortcut mnemonic
  2. OptionButton dan CheckBox yang disimpan dalam kontainer Frame berubah berwarna hitam mengakibatkan Caption dari dua objek tersebut tidak dapat terbaca.
  3. CommandButton yang property style-nya diset pada mode 1-Graphical tidak mau berubah menjadi Style XP.
  4. MSCOMCTL.OCX TreeView, ToolBar, dsb tidak mau berubah menjadi Style XP.
Penyelesaian:
  • Masalah ke-1: Simpan kode di bawah ini pada module, selanjutnya panggil pada setiap Event Form Load.
    Option Explicit 

    Private Const
    WM_CHANGEUISTATE As Long = &H127
    Private Const UISF_HIDEFOCUS As Integer = &H1
    Private Const UISF_HIDEACCEL As Integer = &H2
    Private Const UIS_CLEAR As Integer = &H2

    Private Declare Function
    SendMessage Lib "user32" Alias "SendMessageA" _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

    Public Sub
    ShowMnemonic(frm As Form)
    Dim uiState As Long
    uiState = MakeLong(UIS_CLEAR, UISF_HIDEFOCUS Or UISF_HIDEACCEL)
    SendMessage frm.hwnd, WM_CHANGEUISTATE, uiState, ByVal 0
    End Sub

    Private Function
    MakeLong(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    MakeLong = wHigh * &H10000 + wLow
    End Function
  • Masalah ke-2: Jangan tempatkan OptionButton dan CheckBox secara langsung di atas Frame, tetapi simpanlah kedua objek tersebut di atas PictureBox, selanjutnya pindahkan PictureBox ini ke dalam Frame.
  • Masalah ke-3: Mengenai permasalah ini Anda dapat mengunjugi situs Edanmo (Eduardo A. Morcillo).
  • Masalah ke-4: Sudah diselesaikan disini.

READ MORE - Beberapa masalah penggunaan file manifest dan Penyelesaiannya

Menampilkan Dialog Modal Ala Office - Visual Basic 6.0

Yang dimaksud mirip office disini bukan style-nya, akan tetapi cara menampilkan form dialog secara modal. Sebenarnya apa perbedaan dari aplikasi-aplikasi yang sering kita buat dengan office dalam hal menampilkan dialog secara modal? nah, marilah kita praktekan saja ....

Pertama: buka ms office.
Kedua: buka sembarang form dialog (misalnya form options)
Ketiga: klik office main form (tampilan tempat kita menulis)

Apa yang terjadi? ... tidak ada kedipan sama sekali pada options form, dan sepertinya lebih baik dan lebih tampak profesional (dalam hal menampilkan dialog form).
sekarang coba bandingkan dengan kode di bawah ini:
Buatlah 2 Form, Form1 dan Form2, selanjutnya tempatkan kode di bawah ini pada Form1.
Private Sub Command1_Click() 
Form2.Show vbModal, Me
End Sub

Selanjutnya klik Form1, apa yang terjadi? bandingkan dengan dialog options office yang di atas.
Mengapa dialog office seperti demikian? ada beberapa kemungkinan:

Pertama: dialog-dialog yang terdapat pada office bukanlah ChildForm.
Kedua: office menggunakan form dummy sebagai OwnerForm.

Jika aplikasi-aplikasi yang Anda buat ingin seperti di atas, maka cobalah sampel kode di bawah ini:
Buatlah 3 form, Form1, Form2, Form3
Option Explicit 

'Kode ini disimpan pada form1
Private Sub Command1_Click()
'tampilkan form2 dengan menggunakan form dummy yakni Form3
'disini form2 tidak akan berkedip walaupun anda klik Form1
Form2.Show vbModal, Form3 'OwnerForm
End Sub




READ MORE - Menampilkan Dialog Modal Ala Office - Visual Basic 6.0