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

Mouse Properties Dialog, Bagaimana Cara Menampilkannya?

Di bawah merupakan kode untuk menampilkan mouse properties dialog menggunakan VB6 (Visual Basic 6) - Bagaimana menampilkan mouse properties dialog ini, bisa Anda lihat di bawah:
Option Explicit 

Private Sub
Command1_Click()
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", 5)
End Sub
READ MORE - Mouse Properties Dialog, Bagaimana Cara Menampilkannya?

Cara Menampilkan Dialog Properties KeyBoard Menggunakan VB6

Berikut merupakan VB6 kode untuk menampilkan kotak dialog properties keyboard:
Option Explicit 

Private Sub
Command1_Click()
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1", 5)
End Sub
READ MORE - Cara Menampilkan Dialog Properties KeyBoard Menggunakan VB6

Mengubah Format DOS 8.3 menjadi Long Filename

Mengubah format DOS 8.3 menjadi long filename, contohnya: G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE menjadi: G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe. Nah bagaimana kode konversi format DOS 8.3 ini, bisa Anda perhatikan di bawah:
Option Explicit 

Private Declare Function
GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long

Public Function
GetLongPath(ByVal Filename As String) As String
On Error Resume Next
Dim
length As Long
Dim s As String
s =
String$(MAX_PATH, 0)
length = GetLongPathName(Filename, s, Len(s))
If (length And Err = 0) Then GetLongPath = Left$(s, length)
End Function
Contoh penggunaan kode di atas:
Private Sub Command1_Click() 
MsgBox GetLongPath("G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE")
End Sub
READ MORE - Mengubah Format DOS 8.3 menjadi Long Filename

GetShortPathName - Mengubah Filename Menjadi DOS 8.3 Format

Di bawah ini merupakan kode untuk mengubah nama file menjadi format DOS 8.3 - Contoh: G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe menjadi: G:\PROJEC~1\BILLIN~1\BILLIN~1\Client\CLIENT~1.EXE. Bagaimana kode mengenai cara mengubah filename menjadi DOS 8.3, bisa Anda lihat di bawah:
Option Explicit 

Private Declare Function
GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Const
MAX_PATH = 260

Public Function
GetShortPath(ByVal Filename As String) As String
Dim
length As Long
GetShortPath = Space(1024)
length = GetShortPathName(Filename, GetShortPath, Len(GetShortPath))
GetShortPath = Left(GetShortPath, length)
End Function
Contoh penggunaan kode di atas:
Private Sub Command1_Click() 
MsgBox GetShortPath("G:\Project-ku\Billing Warnet\Billing Warnet\Client\Client Cafe.exe")
End Sub
READ MORE - GetShortPathName - Mengubah Filename Menjadi DOS 8.3 Format

Notify Form Dengan Effect Transparent Hover

Menjelaskan mengenai cara membuat notify form yang menggunakan effect transparent hover - Apa yang dimaksud dengan notify form itu? notify form adalah form yang bertugas memberitahukan sesuatu kepada user, umumnya notify form muncul sebelah kanan bagian bawah. Beberapa software yang menggunakan notify form diantaranya: Mozilla Firefox, Orbit Downloader, IDM, Avira, software-software Anti Virus, dan banyak lagi. Untuk membuat notify form, khususnya yang memiliki effect transparent hover (terinspirasi dari software notepad++ pada dialog findnya), copy dan pastekan kode di bawah ini:
'---------------------------------------------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com
'coder: Administrator
'----------------------------------------------------------------------------------------------------------
Option Explicit

Dim
blnHighlighted As Boolean
Dim
blnMouseDownClick As Boolean 'bug fixed on flickering

Private Type
POINTAPI
X As Long
Y As Long
End Type

Private Declare Function
ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function
GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function
GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub
InitCommonControls Lib "COMCTL32.DLL" ()

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 color As Long, ByVal X As Byte, ByVal alpha As Long) As Boolean

Const
LWA_BOTH = 3
Const LWA_ALPHA = 2
Const LWA_COLORKEY = 1
Const GWL_EXSTYLE = -20
Const WS_EX_LAYERED = &H80000

Dim
iTransparant As Integer
Dim
blnUp As Boolean

Private Sub
Form_Initialize()
InitCommonControls
End Sub

Private Sub
MakeTransparan(hWndBro As Long, iTransp As Integer)
On Error Resume Next

Dim
ret As Long
ret = GetWindowLong(hWndBro, GWL_EXSTYLE)

SetWindowLong hWndBro, GWL_EXSTYLE, ret Or WS_EX_LAYERED
SetLayeredWindowAttributes hWndBro, RGB(255, 255, 0), iTransp, LWA_ALPHA
Exit Sub

End Sub

Private Sub
cmdOK_Click()
'Kode selanjutnya disini ....
blnUp = False
tmrNotify.Enabled = True
End Sub

Private Sub
cmdCancel_Click()
'kode selanjutnya disini ....
blnUp = False
tmrNotify.Enabled = True
End Sub

Private Sub
Form_Load()
MakeTransparan Me.hwnd, 100
Top = ((GetSystemMetrics(17) + GetSystemMetrics(4)) * Screen.TwipsPerPixelY)
Left = (GetSystemMetrics(16) * Screen.TwipsPerPixelX) - Width
blnUp = True
End Sub

Private Sub
Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
blnMouseDownClick = True
End Sub

Private Sub
Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If blnHighlighted Then Exit Sub
blnHighlighted = True
tmrSemiTransparent.Enabled = True
MakeTransparan Me.hwnd, 255
End Sub

Private Sub
Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
blnMouseDownClick = False
End Sub

Private Sub
tmrSemiTransparent_Timer()
If blnMouseDownClick Then Exit Sub
Dim pt As
POINTAPI
GetCursorPos pt
ScreenToClient hwnd, pt
If
(pt.X < 0 Or pt.Y < 0) Or _
(pt.X > (Me.ScaleLeft + Me.ScaleWidth) / Screen.TwipsPerPixelX) Or _
(pt.Y > (Me.ScaleTop + Me.ScaleHeight) / Screen.TwipsPerPixelY) Then
blnHighlighted = False
tmrSemiTransparent.Enabled = False
MakeTransparan Me.hwnd, 100
End If
End Sub

Private Sub
tmrNotify_Timer()
Const s = 100
Dim v As Single
v =
(GetSystemMetrics(17) + GetSystemMetrics(4)) * Screen.TwipsPerPixelY
If blnUp = True Then
If
Top - s <= v - Height Then
Top = Top - (Top - (v - Height))
tmrNotify.Enabled = False
Else
Top = Top - s
End If
Else
Top = Top + s
If
Top >= v Then End
End If
End Sub
READ MORE - Notify Form Dengan Effect Transparent Hover

Memeriksa Apakah Pointer Mouse Masuk Di atas Sebuah Objek

Menjelaskan mengenai cara untuk memeriksa apakah pointer/cursor mouse berada di atas sebuah objek - Terkadang kita memerlukan sebuah kode untuk memeriksa apakah cursor atau pointer berada di atas sebuah objek, misalnya untuk keperluan hover, dsb. Untuk kasus objek yang memiliki property .hwnd hal tersebut mudah sekali dilakukan yaitu dengan memanggil fungsi API SetCapture dan ReleaseCapture, tapi bagaimana jika objek tersebut tidak memiliki property .hwnd, misalnya objek label atau image?

Di bawah ini merupakan module untuk memeriksa apakah pointer atau cursor berada di atas sebuah objek, untuk mengujinya sediakan 1 Timer dengan property Name = tmrInBox, kemudian 1 PictureBox dengan properpty Name = Picture1 (default).
'simpan kode di bawah pada sebuah module 
Option Explicit

Private Declare Function
ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function
GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type
POINTAPI
x As Long
y As Long
End Type

Public Function
InBox(ctl As Control) As Boolean
Dim pt As
POINTAPI
GetCursorPos pt
ScreenToClient ctl.Parent.hwnd, pt
InBox = Not (pt.x < ctl.Left Or pt.y < ctl.Top Or pt.x > ctl.Left + ctl.Width Or pt.y > ctl.Top + ctl.Height)
End Function

'simpan kode di bawah pada form 
Option Explicit

Dim
blnFlag As Boolean

Private Sub
Form_Load()
Form1.ScaleMode = vbPixels 'pixels units
tmrInBox.Interval = 10 'or 1 if posible
End Sub

Private Sub
tmrInBox_Timer()
If Not InBox(Picture1) Then
blnFlag = False
tmrInBox.Enabled = False
Picture1.BackColor = vbBlack
End If
End Sub

Private Sub
Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If blnFlag Then Exit Sub
blnFlag = True
tmrInBox.Enabled = True
Picture1.BackColor = vbWhite
End Sub
READ MORE - Memeriksa Apakah Pointer Mouse Masuk Di atas Sebuah Objek

Mengenai cara menampilkan kotak dialog About

Mengenai cara menampilkan kotak dialog About default windows menggunakan Visual Basic 6 - Apabila kita malas membuat tampilan kotak dialog About, mungkin kode di bawah adalah alternatif yang tepat, selain itu ia memiliki tampilan (GUI) yang menarik, adapun cara menampilkan kotak dialog about default windows adalah sebagai berikut:
'simpan kode di bawah ini pada module 
Option Explicit

Public Declare Function
ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Public Sub
ShowAboutDialog(hwnd As Long, Caption As String, Txt As String, Icon As Long)
Call ShellAbout(hwnd, Caption, Txt, Icon)
End Sub
Contoh penggunaan kode untuk menampilkan kotak dialog about:
'simpan kode di bawah ini dalam module 
Option Explicit

Private Sub
cmdAbout_Click()
ShowAboutDialog Me.hwnd, "About My-Sofware", "Software Versi ke-1", Me.Icon
End Sub
READ MORE - Mengenai cara menampilkan kotak dialog About

Membuat HyperLink Label Menggunakan Visual Basic 6

Mengenai cara membuat link label atau hyperlink label menggunakan VB6 - Link label atau hyperlink label merupakan label yang apabila diklik akan membuka browser dengan alamat website atau blog yang kita miliki. Bagaimana kode mengenai hiperlink label ini, berikut merupakan kode untuk membuat link label atau hyperlink label menggunakan Visual Basic 6:
'simpan kode ini pada module, atau satukan dengan form, jika ingin disatukan dengan form 
'gantilah Public menjadi Private
Option Explicit

Public Declare Function
ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const
SW_SHOW = 5
contoh penggunaan fungsi API di atas:
'simpan kode ini pada form 
'gantilah label caption dengan alamat blog atau website
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ShellExecute hwnd, "open", "http://khoiriyyah.blogspot.com", vbNullString, vbNullString, SW_SHOW
End Sub
Demikianlah mengenai cara pembuatan hyperlink label atau link label menggunakan Visual Basic 6. Selamat mencoba.
READ MORE - Membuat HyperLink Label Menggunakan Visual Basic 6

Cara Mengatasi Aplikasi Crash Akibat OCX Third Party

Bagaimana kita dapat mengatasi aplikasi yang menjadi crash pada saat keluar (exit) dari program akibat dari ocx yang dibuat oleh pihak ketiga (third party)? Penggunaan ocx yang kurang stabil (pada aplikasi yang telah dicompile/dijadikan exe), seringkali menyebabkan crash yaitu pada saat keluar dari aplikasi tersebut. Kondisi ini tentu saja sangat mengganggu, karena aplikasi, tidak akan pernah menjalankan kode-kode yang berada pada event Unload atau QueryUnload, seperti kode untuk mengatur settingan pada registry, settingan pada file .ini, dsb. Bagaimana cara mengatasi keadaan tersebut? ikuti langkah-langkah berikut:
  • Tambahkan satu CommonDialog biarkan dengan nama default CommondDialog1
  • Tambahkan satu UserControl biarkan dengan nama default UserControl1
  • Biarkan CommonDialog dan UserControl tersebut tanpa ditambahkan kode.
Lakukan compile ulang, dan lihatlah hasilnya, dalam banyak kasus kondisi di atas bisa diatasi, tapi bila masih crash sebaiknya Anda mencari pengganti dari ocx tersebut.
READ MORE - Cara Mengatasi Aplikasi Crash Akibat OCX Third Party

Tips Menempatkan CommonDialog Pada Posisi Yang Diinginkan

Posting mengenai cara mudah menempatkan CommonDialog pada koordinat yang diinginkan - Dari beberapa common dialog yang terdapat pada COMDLG32.OCX, ada beberapa common dialog yang sulit untuk diatur posisinya, dalam arti ia selalu tampil pada sisi kiri bagian atas, mengapa demikian? karena sebelum tampil ia (COMDLG32.OCX) membaca terlebih dahulu koordinat yang diperoleh dari hwnd parentnya. Nah, untuk memposisikan commondialog pada saat tampil, ikuti langkah-langkah berikut:
  1. Pada form tambahkan satu PictureBox jadikan property visible = false
  2. Samakan ukurannya dengan COMDLG32.OCX (agar tidak menghabiskan space).
  3. Masukan COMDLG32.OCX pada PictureBox tadi
  4. Aturlah posisi PictureBox tadi pada koordinat tertentu
Sekarang CommonDialog akan selalu tampil mengikuti koordinat PictureBox yang menjadi parentnya. Untuk mengujinya (dengan mengikuti langkah di atas) buatlah kode seperti di bawah ini:
'kode di bawah simpan pada form 
'tambahkan CommandButton dengan nama default Command1
'tambahkan CommonDialog dengan nama default CommonDialog1
Option Explicit

Private Sub
Command1_Click()
CommonDialog1.ShowColor
End Sub
Selanjutnya jadikan property form WindowState = 2 - Maximize, bandingkan hasilnya sebelum dan sesudah menggunakan PictureBox. Demikian mengenai cara menempatkan CommonDialog pada posisi yang diinginkan. Semoga bermanfaat.
READ MORE - Tips Menempatkan CommonDialog Pada Posisi Yang Diinginkan

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)

Spoiler Kode Seperti Yang Terdapat pada Spoiler Wikipedia?

Mengenai cara membuat spoiler seperti yang terdapat pada Wikipedia. Untuk menjalankannya copy dan pastekan kode di bawah ini, selanjutnya gantilah Spoiler Title: dan Text Spoiler.
<div style="padding: 10px; border:1px solid #ccc;background:#f9f9f9"><div style="margin-bottom: 0px;font-family: arial;font-size:12px;"><b>Spoiler Title:</b><input value="Show" style="border:0px solid #000;margin:0px;color:#0000FF;font-family: arial; font-size: 12px; height:16; background:#f9f9f9" onclick="if (this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display != '') { this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display = ''; this.innerText = ''; this.value = 'Hide'; } else { this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display = 'none'; this.innerText = ''; this.value = 'Show'; }" type="button"> </div><div style="margin: 0 10px 0px 10px; padding: 0px; border: 0px inset #fff;"><div style='display:none'><br/>Text Spoiler</div></div></div>
Demo spoiler code ala Wikipedia:
Enhanced Pair-Bi:
'simpan kode di bawah pada Form 
Option Explicit 
'buatlah satu project dengan 1 Form, 1 CommandButton, 1 TextBox 
Private Sub Command1_Click() 
    Dim g As String 
    Dim i As Integer 
    Dim s() As String 
    Dim x As String 
    g = Text1.Text 
    g = RemoveEndCrlf(g) 
    If Trim(g) = "" Then Exit Sub 
    If InStr(1, g, "<b></b>") > 0 Then 
        g = Replace(g, "<b></b>", "") 
        Text1.Text = RemoveEndCrlf(g) 
        Exit Sub 
    Else 
        s = Split(g, vbCrLf) 
        For i = 0 To UBound(s) 
            x = x & "<b></b>" & s(i) & vbCrLf 
        Next 
    End If 
    Text1.Text = RemoveEndCrlf(x) 
End Sub 
 
'fungsi di bawah digunakan untuk menghilangkan karakter CRLF 
'yang terdapat pada akhir kode 
Private Function RemoveEndCrlf(s As String) 
    Dim str As String 
    str = s 
    If Right(str, 2) = vbCrLf Then 
        Do While Right(str, 2) = vbCrLf 
            str = Left(str, Len(str) - 2) 
        Loop 
    End If 
    RemoveEndCrlf = str 
End Function 
Selain menggunakan untuk text spoiler juga bisa digunakan untuk menampilkan dan menyembunyikan gambar.

Catatan Penting: kode-kode HTML/XML yang akan dijalankan (bukan tulisan [ seperti kode spoiler di atas]) harus dibuat satu baris, mengapa demikian?
READ MORE - Spoiler Kode Seperti Yang Terdapat pada Spoiler Wikipedia?

VB6 Code - Mengambil URL Dari Address Bar IE

Mengenai cara mengambil URL dari adress bar yang terdapat pada IE menggunakan fungsi API, dengan melakukan spy terhadap HWND induk dan turunannya. Selain dengan API di bawah ini, kita pun bisa mengambil URL yang terdapat pada adress bar IE atau Firefox dengan menggunakan DDE.
Option Explicit 
Private Declare Function
FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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 Const
WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private Sub
FindIt(ByVal sClassName As String)
On Error GoTo CallErrorA
lhWnd = FindWindowEx(lhWnd, 0, sClassName, vbNullString)
End Sub
Private Function
GetAddressText() As String
On Error GoTo
CallErrorA
Dim usText() As Byte
Dim
iPos As Integer
lhWnd = 0
Call FindIt("IEFrame")
Call FindIt("WorkerA")
Call FindIt("ReBarWindow32")
Call FindIt("ComboBoxEx32")
Call FindIt("ComboBox")
Call FindIt("Edit")
ReDim usText(0 To SendMessage(lhWnd, WM_GETTEXTLENGTH, 0, ByVal 0&) + 1)
If
UBound(usText) = 1 Then
GetAddressText = ""
Else
usText(0) = UBound(usText) And 255
usText(1) = UBound(usText) 256
Call SendMessage(lhWnd, WM_GETTEXT, UBound(usText), usText(0))
GetAddressText = StrConv(usText, vbUnicode)
iPos = InStr(GetAddressText, vbNullChar)
If iPos > 0 Then GetAddressText = Left(GetAddressText, iPos - 1)
End If
End Function
READ MORE - VB6 Code - Mengambil URL Dari Address Bar IE

Cara Membuat Direktori lebih dari 1 level - (Pengelolaan Fil

Fungsi yang menjelaskan mengenai cara membuat direktori lebih dari satu level, 2, 3 dan seterusnya - Mengenai kode membuat direktori lebih dari 1 level bisa Anda lihat di bawah ini:
Option Explicit 

Private Function
CreateDir(strDir As String) As Boolean
On Error Resume Next
Dim
s() As String
s =
Split(strDir, "\")
Dim i As Integer
For i =
1 To UBound(s)
s(0) = s(0) & "\" & s(i)
MkDir s(0)
Next
End Function

'contoh penggunaan fungsi di atas
Private Sub Command1_Click()
CreateDir "C:\test1\test2\test3\test4 dan test5\test6\test7 dan test8"
End Sub
READ MORE - Cara Membuat Direktori lebih dari 1 level - (Pengelolaan Fil

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

VB6 Code - Compact And Repair Database MS Access

Di bawah ini merupakan fungsi untuk mengcompact dan merepair database Microsoft Access. Kegunaan Compact And Repair database untuk menghilangkan secara permanen data-data yang terhapus. Bagaimana Fungsi mengenai Compact And Repair Database MS Access.
Option Explicit 

Private Function
CompactDB(Filename As String) As Boolean
On Error GoTo
ErrHandler

Dim
DC As New DBEngine

Screen.MousePointer = vbHourglass
DC.CompactDatabase Filename, App.Path & "\~database.tmp"
Kill Filename
Name App.Path & "\~database.tmp" As Filename
Screen.MousePointer = vbDefault
CompactDB = True
Exit Function

ErrHandler:

CompactDB = False

End Function
Contoh penggunaan Compact and Repair Database:
Private Sub Command1_Click() 
MsgBox CompactDB(App.Path & "\database.mdb") 'true jika database sukses di compact dan repair
End Sub
READ MORE - VB6 Code - Compact And Repair Database MS Access

Kode VB untuk Mencetak Sebuah Garis Ke Printer

Di bawah ini merupakan contoh sederhana untuk mencetak sebuah garis ke printer menggunakan Visual Basic 6, diharapkan Anda dapat mengembangkannya lebih lanjut, adapun kode untuk mencetak sebuah garis ke printer adalah sebagai berikut:
Private Sub PrintLine(LineWidth As Single) 
Printer.Line (0, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY + LineWidth), , BF
Printer.EndDoc
End Sub
Contoh penggunaan kode untuk mencetak garis ke printer:
Private Sub Command1_Click() 
PrintLine (60) '60 adalah lebar garis
End Sub
READ MORE - Kode VB untuk Mencetak Sebuah Garis Ke Printer

Memeriksa Apakah Terdapat Printer Yang Terinstall - Visual B

Di bawah ini merupakan kode untuk memeriksa apakah komputer memiliki printer yang terinstall menggunakan Visual Basic 6, Adapun kode untuk memeriksa printer yang terinstall dalam komputer sebagai berikut:
Public Function IsPrinterInstalled() As Boolean 
If
VB.Printers.Count <= 0 Then
IsPrinterInstalled = False
Exit Sub
Else
IsPrinterInstalled = True
End If
End Function
Atau Anda pun dapat merubah juga kode di atas (agar lebih simple) seperti di bawah ini (hasilnya akan sama):
Public Function IsPrinterInstalled() As Boolean 
IsPrinterInstalled = (VB.Printers.Count > 0)
End Function
READ MORE - Memeriksa Apakah Terdapat Printer Yang Terinstall - Visual B

Menentukan Objek Font Yang Dikirimkan Ke Printer

Contoh sederhana untuk menentukan name, underline, bold, italic, size (properties objek font) yang dikirimkan ke sebuah printer. Adapun contohnya sebagai berikut:
Private Sub Command1_Click() 
With Printer
.FontName = "Arial"
.FontUnderline = False
.FontBold = False
.FontItalic = True
.FontSize = "30"
.Print "Ini contoh objek font dalam printer"
.EndDoc
End With
End Sub
READ MORE - Menentukan Objek Font Yang Dikirimkan Ke Printer

Membuat About Box Dengan Memanfaatkan Default Windows

Mengenai cara menampilkan kotak dialog About default windows menggunakan Visual Basic 6 - Apabila kita malas membuat tampilan kotak dialog About, mungkin kode di bawah adalah alternatif yang tepat, selain itu ia memiliki tampilan (GUI) yang menarik, adapun cara menampilkan kotak dialog about default windows adalah sebagai berikut:
'simpan kode di bawah ini dalam module 
Option Explicit

Public Declare Function
ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Public Sub
ShowAboutDialog(hwnd As Long, Caption As String, Txt As String, Icon As Long)
Call ShellAbout(hwnd, Caption, Txt, Icon)
End Sub
Contoh penggunaan kode untuk menampilkan kotak dialog about:
Private Sub cmdAbout_Click() 
ShowAboutDialog Me.hwnd, "About My-Sofware", "Software Versi ke-1", Me.Icon
End Sub
READ MORE - Membuat About Box Dengan Memanfaatkan Default Windows

Animasi Copy Seperti Di Windows Explorer

Option Explicit 

Private Const
FO_COPY = &H2&
Private Const FO_DELETE = &H3&
Private Const FO_MOVE = &H1&
Private Const FO_RENAME = &H4&
Private Const FOF_ALLOWUNDO = &H40&
Private Const FOF_CONFIRMMOUSE = &H2&
Private Const FOF_CREATEPROGRESSDLG = &H0&
Private Const FOF_FILESONLY = &H80&
Private Const FOF_MULTIDESTFILES = &H1&
Private Const FOF_NOCONFIRMATION = &H10&
Private Const FOF_NOCONFIRMMKDIR = &H200&
Private Const FOF_RENAMEONCOLLISION = &H8&
Private Const FOF_SILENT = &H4&
Private Const FOF_SIMPLEPROGRESS = &H100&
Private Const FOF_WANTMAPPINGHANDLE = &H20&

Private Type
SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Sub
CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long

Private Sub
cmdCopy_Click()
Dim result As Long
Dim
lenFileop As Long
Dim
foBuf() As Byte
Dim
fileop As SHFILEOPSTRUCT

lenFileop = LenB(fileop)
ReDim foBuf(1 To lenFileop)

With
fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
.pFrom = App.Path & "\readme.html" & vbNullChar & App.Path & "\readme.doc" & vbNullChar & App.Path & "\readme.txt" & vbNullChar & vbNullChar
.pTo = "C:\"
.fFlags = FOF_CREATEPROGRESSDLG
.lpszProgressTitle = "VB HowTo Copy Example " & vbNullChar & vbNullChar
End With

Call
CopyMemory(foBuf(1), fileop, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12)

result = SHFileOperation(foBuf(1))

If
result <> 0 Then
MsgBox Err.LastDllError
Else
If
fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If

End Sub
READ MORE - Animasi Copy Seperti Di Windows Explorer

Memutarkan huruf pada watermark, bagaimana caranya?

Mengenai cara memutarkan atau merotasi font pada watermark menggunakan VB6 (belajar Visual Basic 6 untuk pemula) - Posting ini merupakan kelanjutan dari posting yang telah ditulis terdahulu. Disini kita akan menambahkan beberapa kemampuan pada project watermark yang sedang kita buat. Perhatikan kode di bawah ini:
'--------------------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com
' coder: Administrator
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Sub
InitCommonControls Lib "comctl32.dll" ()

Dim
intCurrentX As Integer 'variabel untuk menyimpan koordinat X
Dim intCurrentY As Integer 'variabel untuk menyimpan koordinat Y

Private Sub
Command1_Click()
'memanggil prosedur RotateFont
RotateFont Picture1, Val(txtSize), txtFontName, intCurrentX, intCurrentY, Val(txtDegree), txtWatermark
'menyimpan hasil gambar yang telah diberi teks
SavePicture Picture1.Image, App.Path & "\watermark_sample.bmp" 'and save Exit Sub
End Sub

Private Sub
Form_Initialize()
InitCommonControls 'XP style
End Sub

Private Sub
Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Label3 = "X: " & x 'menampilkan koordinat X ke dalam label
Label4 = "Y: " & y 'menampilkan koordinat Y ke dalam label
intCurrentX = x 'simpan koordinat x dalam variabel intCurrentX
intCurrentY = y 'simpan koordinat y dalam variabel intCurrentY
WaterMarkIt 'panggil prosedur WaterMarkIt
End Sub

Private Sub
txtDegree_Change()
'apabila bukan angka, jadikan txtDegree.Text = 90
If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90"
End Sub

Private Sub
VScroll1_Scroll()
'panggil prosedur WaterMarkIt pada saat terjadi Scroll
WaterMarkIt
End Sub

Private Sub
VScroll1_Change()
'panggil prosedur WaterMarkIt pada saat terjadi perubahan nilai
WaterMarkIt
End Sub

Private Sub
VScroll2_Change()
WaterMarkIt 'panggil prosedur WaterMarkIt
End Sub

Private Sub
VScroll2_Scroll()
WaterMarkIt 'panggil prosedur WaterMarkIt
End Sub
'--------------------------------------------------------------------
' Prosedur WaterMarkIt
'--------------------------------------------------------------------
Private Sub WaterMarkIt()
Command1_Click 'panggil Command1_Click (Rotasi dan simpan image)
txtDegree.Text = VScroll1.Value 'txtDegree berdasarkan nilai VScroll1
txtSize.Text = VScroll2.Value 'txtSize berdasarkan nilai VScroll2
End Sub

READ MORE - Memutarkan huruf pada watermark, bagaimana caranya?

Membuat Spoiler Pada Blog di Blogspot

Menjelaskan cara membuat spoiler pada blog khususnya di blogspot/blogger - Untuk membuat spoiler pada blog copy dan pastekan kode di bawah ini:
<div style="margin: 5px 10px 10px;"> <div class="smallfont" style="margin-bottom: 1px;"> <b> <strong>Judul</strong> </b> <br /> <input onclick="if (this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display != '') { this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display = ''; this.innerText = ''; this.value = 'Hide'; } else { this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display = 'none'; this.innerText = ''; this.value = 'Show'; }" style="font-size: 10px; margin: 0px; padding: 0px; width: 70px;" type="button" value="Show" /> </div> <br /> <div class="alt2" style="border: 1px inset; margin: 0px; padding: 6px;"> <div style="display: none;"> <strong>Text spoiler yang akan ditampilkan</strong> </div> </div> </div>
Maka dari kode di atas, hasil yang ditampilkan adalah seperti di bawah ini:
Judul

Text spoiler yang akan ditampilkan

Rubahlah judul dan text spoilernya untuk disesuaikan dengan kebutuhan.

Catatan: Kode di atas harus di buat satu baris.
READ MORE - Membuat Spoiler Pada Blog di Blogspot

Rotasi Font Menggunakan Visual Basic 6.0

Modul untuk memutarkan atau merotasi font berdasarkan derajat tertentu serta koordinat tertentu menggunakan VB6 - Bagaimana kode serta contoh penggunaannya, bisa Anda lihat di bawah ini:
Option Explicit 

Public Type
LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFacename As String * 33
End Type

Public Declare Function
CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function
SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function
DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Sub
RotateFont(pic As PictureBox, fontsize As Integer, fontname As String, x As Integer, y As Integer, degree As Integer, txt As String)

On Error GoTo
ErrHandler

Dim F As
LOGFONT
Dim hPrevFont As Long
Dim
hFont As Long
pic.Cls

F.lfEscapement = 10 * Val(degree)
F.lfFacename = fontname
F.lfHeight = (fontsize * -20) / Screen.TwipsPerPixelY
pic.fontname = "Arial Black" + Chr$(0)
hFont = CreateFontIndirect(F)
hPrevFont = SelectObject(pic.hdc, hFont)

pic.CurrentX = x
pic.CurrentY = y
pic.Print txt

hFont = SelectObject(pic.hdc, hPrevFont)
DeleteObject hFont
Exit Sub

ErrHandler:

MsgBox Err.Description

End Sub
Modul di atas memiliki 7 parameter, Adapun contoh penggunaannya sebagai berikut:
Private Sub Command1_Click() 
RotateFont Picture1, 12, "Arial", 90, 2500, _
40, "khoiriyyah.blogspot.com"
'Keterangan:
' 1. Picture1 = PictureBox
' 2. 12 = ukuran huruf
' 3. Arial = nama huruf
' 4. 90 = koordinat X
' 5. 2500 = koordinat Y
' 6. 40 = derajat putaran (0 derajat = normal, 90 derajat = tegak lurus)
' 7. khoiriyyah.blogspot.com = text yang dimasukan ke dalam PictureBox
End Sub
READ MORE - Rotasi Font Menggunakan Visual Basic 6.0

Menentukan Titik Koordinat Text Pada Watermark | VB6

Artikel yang menjelaskan cara menempatkan text (watermark) berdasarkan titik koordinat, posting ini merupakan kelanjutan dari posting sebelumnya mengenai dasar-dasar membuat software watermark (Belajar Visual Basic 6 untuk pemula melalui praktik). Selanjutnya agar text watermark dapat ditempatkan sesuai keinginan, maka kita harus menentukan titik koordinatnya terlebih dahulu. Adapun kode lengkap untuk menentukan titik koordinat text watermark adalah sebagai berikut:
'--------------------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com 
' coder: Administrator 
'--------------------------------------------------------------------------------------- 
Option Explicit 

Dim intCurrentX As Integer 'variabel untuk menyimpan koordinat X 
Dim intCurrentY As Integer 'variabel untuk menyimpan koordinat Y 
 
Private Sub Command1_Click() 
    Picture1.Cls 'bersihkan Picture1 dari seluruh text 
    Picture1.CurrentX = intCurrentX 'ambil nilai X dari variabel di atas 
    Picture1.CurrentY = intCurrentY 'ambil nilai Y dari variabel di atas 
    Picture1.Print "http://khoiriyyah.blogspot.com" 'beri watermark! 
    SavePicture Picture1.Image, App.Path & "\watermark_sample.bmp" 'jadikan file dan simpan. 
End Sub 

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    intCurrentX = X 'masukan nilai X pada variabel berdasarkan koordinat klik mouse 
    intCurrentY = Y 'masukan nilai Y pada variabel berdasarkan koordinat klik mouse 
End Sub 
Dengan menggunakan kode di atas, maka kita dapat menentukan titik koordinat text watermark seperti pada gambar berikut:
READ MORE - Menentukan Titik Koordinat Text Pada Watermark | VB6

Menonaktifkan/Disable Task Manager Menggunakan VB6

Posting yang menjelaskan mengenai cara menonaktifkan task manager melalui kode Visual Basic 6.0 - Mendisable atau menonaktifkan task manager terkadang diperlukan untuk pembuatan aplikasi-aplikasi tertentu sebut saja billing warnet. Umumnya kode yang digunakan untuk menonaktifkan task manager dengan mengubah nilai registry, namun berbeda dengan kode di bawah ini yang mendisable task manager tanpa mengubah nilai registry. Bagaimana implementasi kode untuk mendisable task manager, bisa Anda lihat di bawah ini:
'simpan kode di bawah pada module 
Option Explicit

Private Declare Function
Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function
FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Type
NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Const
NIM_DELETE = &H2

Public Function
DisableTaskManager()
Dim tskWin As Long, t As NOTIFYICONDATA
Shell "taskmgr.exe", vbHide
Do Until tskWin <> 0
tskWin = FindWindow("#32770", "Windows Task Manager")
Loop
t.hWnd = tskWin
Shell_NotifyIcon NIM_DELETE, t
End Function
Contoh penggunaan kode di atas:
Option Explicit 'simpan kode ini pada form 

Private Sub
Form_Load()
DisableTaskManager
End Sub
READ MORE - Menonaktifkan/Disable Task Manager Menggunakan VB6

VB6 Code - 2 Baris Kode Inti Membuat Software Watermark

Apakah gambar yang diberi watermark itu? mengapa gambar diberi watermark? mengenai hal ini, saya percaya Anda (blogger) lebih tahu jawabannya. Posting kali ini kita akan membahas tentang project VB6 step by step tentang pembuatan software watermark. Dalam membuat software, tentu kita harus dapat membedakan mana yang menjadi kode inti (primer) mana yang menjadi kode tambahan (sekunder). Dengan demikian, maka kita akan dengan mudah mengatur, memelihara, menambah, mengurangi, menghilangkan, mengupdate, software tersebut. Kode inti merupakan kode utama pembentuk software. Sedangkan kode tambahan (sekunder) kode-kode yang melengkapi kode primer tadi, sehingga bisa disebut: plug-ins, add-ons, add-ins, fasilitas, tambahan, pelengkap, penyempurna, dan seluruh kata yang setara dengan itu. Umumnya dengan kode-kode sekunder tadi maka sebuah software akan memiliki versi-versi, versi 1.0, versi 1.0.1, versi 1.0.2 dan seterusnya, lengkap dengan history, bug fixed, kekurangan, serta kelebihannya. Disini saya memiliki contoh yang baik mengenai hal yang telah dijelaskan di atas, yaitu mengenai pembuatan software watermark. Kode intinya hanya 2 baris saja. Berikut kode inti dari software watermark tersebut:
'--------------------------------------------------------------------------------------- 
' http://khoiriyyah.blogspot.com 
' coder: Administrator 
'--------------------------------------------------------------------------------------- 
Option Explicit 
 
Private Sub Command1_Click() 
    Picture1.Print "http://khoiriyyah.blogspot.com" 'watermark! 
    SavePicture Picture1.Image, App.Path & "\watermark_sample.bmp" 'and save 
End Sub 
dan hasilnya (walaupun harus menggunakan yang lain untuk mengkonversi dari bmp ke jpg):

contoh gambar yang sudah diberi watermark
Untuk selanjutnya (To Do):
  1. Mencari/membuat class, module, ocx, dll untuk merubah ke format lain (gif, jpg, jpeg, png, dsb)
  2. Rotasi huruf
  3. Memindahkan huruf berdasarkan koordinat
  4. dsb saja (terlalu banyak untuk dituliskan).


READ MORE - VB6 Code - 2 Baris Kode Inti Membuat Software Watermark