Showing posts with label Dialog. Show all posts
Showing posts with label Dialog. Show all posts

Monday, December 10, 2012

VB6 Code - Fungsi Untuk Menampilkan BrowseForFolder

Di bawah ini merupakan fungsi VB6 untuk menampilkan BrowseForFolder. Karena menggunakan metode Early Binding maka, Untuk keperluan ini Anda harus mereferensi objek "Microsoft Shell Controls And Automation" atau "Shell32.dll" yang biasa terletak pada SystemRoot\System32 (c:\Windows\System32\Shell32.dll).

Jika Anda ingin menggunakan metode Late Binding maka gantilah kode berikut:

Dim Sh as new Shell32.Shell
Dim Folder As Shell32.Folder

Menjadi:

Dim Sh as Object
Dim Folder
Set Sh = CreateObject("Shell.Application")
Function BrowseForFolder(Title As String, Optional RootFolder = "") As String
On Error Resume Next
Dim sh As New Shell32.Shell
Dim Folder As Shell32.Folder
Set Folder = sh.BrowseForFolder(Me.hwnd, "Open", 1, RootFolder)
SelectFolder = Folder.Items.Item.Path
set sh = nothing
set Folder = nothing
End Function

'Berikut contoh penggunaan Fungsi Untuk Menampilkan BrowseForFolder
Private Sub Command1_Click()
'jika ingin mengeksplore "c:\" saja
MsgBox SelectFolder("Open Folder", "c:\")
'Jika ingin mengeksplore directory keseluruhan
MsgBox SelectFolder("Open Folder")
End Sub
READ MORE - VB6 Code - Fungsi Untuk Menampilkan BrowseForFolder

Sunday, June 17, 2012

Contoh Menggunakan CommonDialog Open Save As

'Contoh untuk CommonDialog Open
Private Sub Command1_Click()

On Error GoTo ErrHandler

Dim strPath As String

With CommonDialog1
.CancelError = True
.Flags = cdlOFNHideReadOnly
.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
.FilterIndex = 2
.DialogTitle = "Open File"
.ShowOpen
strPath = .FileName
End With
'Code selanjutnya
Exit Sub

ErrHandler:

Exit Sub

End Sub

'Contoh untuk CommonDialog Save As
Private Sub Command2_Click()

On Error GoTo ErrHandler

Dim strPath As String

With CommonDialog1
.CancelError = True
.Flags = cdlOFNHideReadOnly
.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
.FilterIndex = 2
.DialogTitle = "Save As"
.ShowSave
strPath = .FileName
End With
'Code selanjutnya
Exit Sub

ErrHandler:

Exit Sub
End Sub

'Contoh untuk CommonDialog Save
Private Sub Command3_Click()

On Error GoTo ErrHandler

Dim strPath As String

With CommonDialog1
.CancelError = True
.Flags = cdlOFNHideReadOnly
.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
.FilterIndex = 2
.DialogTitle = "Save"
.ShowSave
strPath = .FileName
End With
'Code selanjutnya
Exit Sub

ErrHandler:

Exit Sub
End Sub
READ MORE - Contoh Menggunakan CommonDialog Open Save As

Contoh CommonDialog - Print Dengan Range Tertentu

Option Explicit

Private Sub Command1_Click()
Dim myDatabase As Database
Dim rsMyTable As Recordset
Dim i As Integer
Dim j As Integer
Dim startpage As Integer

CommonDialog1.Max = 3
CommonDialog1.FromPage = 1
CommonDialog1.ToPage = 3
CommonDialog1.flags = 0
CommonDialog1.ShowPrinter
startpage = CommonDialog1.FromPage

Printer.FontSize = 18

Set myDatabase = OpenDatabase("nwind.mdb")
Set rsMyTable = myDatabase.OpenRecordset("Customers")

rsMyTable.MoveFirst

If (CommonDialog1.flags And cdlPDPageNums) <> 0 Then
MsgBox " Printing pages " & CommonDialog1.FromPage & " to " & CommonDialog1.ToPage
Select Case startpage
Case 1

Case 2
For i = 1 To 42
rsMyTable.MoveNext
Next

Case 3
For i = 1 To 84
rsMyTable.MoveNext
Next
End Select

If startpage <> 0 Then
For j = startpage To CommonDialog1.ToPage
For i = 1 To 42
If rsMyTable.EOF Then Exit For
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
Printer.Print rsMyTable!CompanyName
rsMyTable.MoveNext
Next
Printer.NewPage
Next
Printer.EndDoc
End If

ElseIf (CommonDialog1.flags And cdlPDSelection) <> 0 Then

rsMyTable.MoveLast
rsMyTable.MoveFirst
For i = 1 To rsMyTable.RecordCount
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
rsMyTable.MoveNext
Next
MsgBox "Select text to be printed"
Else
For i = 1 To rsMyTable.RecordCount
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
rsMyTable.MoveNext
Next
Printer.Print Text1.Text
Printer.EndDoc
MsgBox "Printing all pages"
End If
End Sub

Private Sub Command2_Click()
Printer.Print Text1.SelText
Printer.EndDoc
End Sub

Private Sub Form_Load()
Command1.Caption = "Select Printing Option"
Command2.Caption = "Print selected text"
End Sub
READ MORE - Contoh CommonDialog - Print Dengan Range Tertentu

Cara Menggunakan CommonDialog Printer

Private Sub Command1_Click()
Dim BeginPage, EndPage, NumCopies, i
On Error GoTo ErrHandler
With CommonDialog1
.CancelError = True
.ShowPrinter
BeginPage = .FromPage
EndPage = .ToPage
NumCopies = .Copies
End With

For i = 1 To NumCopies
'simpan kode di sini
Next i
Exit Sub
ErrHandler:
Exit Sub
End Sub
READ MORE - Cara Menggunakan CommonDialog Printer

CommonDialog Help, Cara Menggunakannya

Private Sub Command1_Click()
With CommonDialog1
.HelpFile = "mis.chm"
.HelpCommand = cdlHelpContents
.ShowHelp
End With
End Sub
READ MORE - CommonDialog Help, Cara Menggunakannya

CommonDialog Font, Cara Menggunakannya

Private Sub Command1_Click()
With CommonDialog1
.CancelError = True
On Error GoTo ErrHandler
.Flags = cdlCFEffects Or cdlCFBoth
.ShowFont
Text1.Font.Name = .FontName
Text1.Font.Size = .FontSize
Text1.Font.Bold = .FontBold
Text1.Font.Italic = .FontItalic
Text1.Font.Underline = .FontUnderline
Text1.FontStrikethru = .FontStrikethru
Text1.ForeColor = .Color
End With
Exit Sub
ErrHandler:
Exit Sub
End Sub
READ MORE - CommonDialog Font, Cara Menggunakannya

CommonDialog Color, Cara Menggunakannya

Private Sub Command1_Click()
With CommonDialog1
.CancelError = True
On Error GoTo ErrHandler
.Flags = cdlCCRGBInit
.ShowColor
Form1.BackColor = .Color
End With
Exit Sub
ErrHandler:
End Sub
READ MORE - CommonDialog Color, Cara Menggunakannya

Thursday, June 14, 2012

Menampilkan Dialog Regional Setting Menggunakan VB6

Private Sub Command1_Click()
Call Shell("RunDLL32.exe Shell32.dll Control_RunDLL InetCpl.cpl", vbNormalFocus)
End Sub
READ MORE - Menampilkan Dialog Regional Setting Menggunakan VB6

Tuesday, June 12, 2012

Bagaimana cara menjalankan Speech Properties Dialog - VB6

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

Sunday, April 4, 2010

VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

Di bawah ini merupakan fungsi VB6 untuk melakukan konfirmasi sebelum keluar dari aplikasi. Mengapa dibuat menjadi fungsi? agar memiliki sifat mudah digunakan kembali, karena hampir tiap software yang dibuat, memerlukan fungsi di bawah ini:
Option Explicit

Public Function ConfirmExit(Optional Title As String = "Konfirmasi") As Boolean
If MsgBox("Are you sure want to exit?", vbQuestion + vbYesNo, Title) = vbYes Then
ConfirmExit = ConfirmExit
Else
ConfirmExit = True
End If
End Function
Contoh penggunaan fungsi di atas:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = ConfirmExit
End Sub
Penggunaan fungsi di atas dapat kita tempatkan pada event Unload ataupun QueryUnload.
READ MORE - VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

VB6 Code - Menampilkan Dialog Properties Sebuah File

Di bawah ini merupakan fungsi VB6 untuk menampilkan kotak dialog properties sebuah file.
Option Explicit

Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type

Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

Public Sub ShowProps(FileName As String, OwnerhWnd As Long)

Dim SEI As SHELLEXECUTEINFO
Dim lngReturn As Long

With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or _
SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = FileName
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With

lngReturn = ShellExecuteEX(SEI)

End Sub
Contoh menggunakan dialog properties sebuah file
Option Explicit

Private Sub Command1_Click()
Call ShowProps("C:\boot.ini", Me.hwnd)
End Sub
READ MORE - VB6 Code - Menampilkan Dialog Properties Sebuah File

VB6 Code - Fungsi API Untuk Browse For Folder

Mengenai fungsi-fungsi API untuk menampilkan dialog browse for folder dengan menggunakan kode-kode VB6:
Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public Function BrowseForFolder(hwnd As Long, Optional Title As String = "Browse For Folder") As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "This Is My Title"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
End If
End Function
Adapun contoh untuk fungsi API diatas:

Private Sub Command1_Click()
Text1.Text = BrowseForFolder(Me.hwnd)
End Sub
READ MORE - VB6 Code - Fungsi API Untuk Browse For Folder

Saturday, April 3, 2010

VB6 Code - Menampilkan Kotak Dialog Shutdown

Di bawah ini merupakan fungsi API untuk menampilkan kotak dialog shutdown menggunakan kode VB6. Fungsi yang digunakan adalah SHShutDownDialog yang terdapat pada Shell32.dll.
Option Explicit

Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal sParam As Long) As Long
Contoh penggunaan fungsi API di atas:
Private Sub Command1_Click()
SHShutDownDialog 0
End Sub
READ MORE - VB6 Code - Menampilkan Kotak Dialog Shutdown

Monday, March 22, 2010

Data Link Properties Dialog Box Cara Menampilkannya

'simpan kode di bawah pada modul Option Explicit 

Public Function
getADOConnectionString(Optional ByVal cnStringToEdit As String = "", Optional sPrePromptUserMessage As String = "") As String

Dim
sActivity As String
Dim
dl As Object
Dim
cn As Object

On Error GoTo
ErrGetAdoConnectionString
sActivity = "Creating Datalinks object."

Set
dl = CreateObject("DataLinks")

If Not
"" = cnStringToEdit) Then

If Not
"" = sPrePromptUserMessage) Then
MsgBox sPrePromptUserMessage, vbInformation, "Connecting to Database..."
End If
sActivity = "Creating ADODB.Connection object"
Set cn = CreateObject("ADODB.Connection")

cn.ConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=PUBS"

sActivity = "Prompting user to edit connect string"
dl.PromptEdit cn

Else
sActivity = "Prompting user for new connect string"
Set cn = dl.PromptNew()

End If

If
cn Is Nothing Then
getADOConnectionString = ""
Exit Function
End If

getADOConnectionString = cn.ConnectionString

Set
cn = Nothing

Exit Function

ErrGetAdoConnectionString:

Dim
sMsg As String

Set
cn = Nothing

sMsg = "Error While [" + sActivity + "]. Details are below: " + vbCrLf
sMsg = sMsg + "Description:[" + Err.Description + "]." + vbCrLf
sMsg = sMsg + "Source:[" & Err.Source & "]." + vbCrLf
sMsg = sMsg + "Number:[" & Err.Number & "]." + vbCrLf
sMsg = sMsg + "Help File:[" & Err.HelpFile & "]." + vbCrLf
MsgBox sMsg, vbCritical, "Error Connecting to Database."

End Function
Contoh penggunaan fungsi di atas:
'simpan kode di bawah pada form Option Explicit 

Private Sub
Command1_Click()

On Error GoTo
ErrHandler

Dim
strCon As String
strCon = getADOConnectionString()
If strCon = "" Then Exit Sub
'kode selanjutnya disini
Exit Sub

ErrHandler:

MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Connection Error"

End Sub
READ MORE - Data Link Properties Dialog Box Cara Menampilkannya

VB6 Code - Menampilkan Dialog Open With

Di bawah ini merupakan kode VB6 untuk menampilkan Dialog Open With. Bagaimanakah caranya:
Option Explicit

Private Sub ShowOpenWith(Filename As String)
Dim x As Long
x = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & Filename)
End Sub
Contoh penggunaan menampilkan dialog open with:
Private Sub Command1_Click()
ShowOpenWith "C:\boot.ini"
End Sub
READ MORE - VB6 Code - Menampilkan Dialog Open With