Showing posts with label Form. Show all posts
Showing posts with label Form. Show all posts

Monday, December 10, 2012

VB6 - Menampilkan Sebuah Form Dari Form Yang Lain

Bagaimanakah cara menampilkan atau memanggil sebuah form dari form yang lain menggunakan kode Visual Basic 6.0? Misalnya kita membuat dua buah form, dan diberi nama Form1 dan Form2. Selanjutnya Form1 ingin menampilkan Form2, maka kodenya adalah sebagai berikut:
Private Sub Command1_Click() 
Form2.Show
End Sub
Sederhana bukan? Nah, demikian mengenai cara menampilkan sebuah form dari form yang lain menggunakan VB6 Code. Semoga bermanfaat.
READ MORE - VB6 - Menampilkan Sebuah Form Dari Form Yang Lain

Sunday, June 17, 2012

Form dan Control Yang Terbebas Resolusi Layar

'Kode Pada Form
Option Explicit

Dim MyForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer

Private Sub Form_Load()
Dim ScaleFactorX As Single, ScaleFactorY As Single ' Scaling factors
' Size of Form in Pixels at design resolution
DesignX = 800
DesignY = 600
RePosForm = True ' Flag for positioning Form
DoResize = False ' Flag for Resize Event
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips ' X Pixel Resolution

' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
ScaleMode = 1 ' twips
'Exit Sub ' uncomment to see how Form1 looks without resizing
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
" by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

Private Sub Form_Resize()
Dim ScaleFactorX As Single, ScaleFactorY As Single

If Not DoResize Then ' To avoid infinite loop
DoResize = True
Exit Sub
End If

RePosForm = False
ScaleFactorX = Me.Width / MyForm.Width ' How much change?
ScaleFactorY = Me.Height / MyForm.Height
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

Private Sub Command1_Click()
Dim ScaleFactorX As Single, ScaleFactorY As Single

DesignX = Xpixels
DesignY = Ypixels
RePosForm = True
DoResize = False
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips ' X Pixel Resolution

' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
" by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

'Kode pada Module
Option Explicit

Public Xtwips As Integer, Ytwips As Integer
Public Xpixels As Integer, Ypixels As Integer

Type FRMSIZE
Height As Long
Width As Long
End Type

Public RePosForm As Boolean
Public DoResize As Boolean

Sub Resize_For_Resolution(ByVal SFX As Single, ByVal SFY As Single, MyForm As Form)
Dim I As Integer
Dim SFFont As Single

SFFont = (SFX + SFY) / 2
On Error Resume Next
With MyForm
For I = 0 To .Count - 1
If TypeOf .Controls(I) Is ComboBox Then
.Controls(I).Left = .Controls(I).Left * SFX
.Controls(I).Top = .Controls(I).Top * SFY
.Controls(I).Width = .Controls(I).Width * SFX
Else
.Controls(I).Move .Controls(I).Left * SFX, .Controls(I).Top * SFY, .Controls(I).Width * SFX, .Controls(I).Height * SFY
End If
.Controls(I).FontSize = .Controls(I).FontSize * SFFont
Next I
If RePosForm Then
.Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
End If
End With
End Sub
READ MORE - Form dan Control Yang Terbebas Resolusi Layar

PrintWindow - Capture Form Beserta Seluruh Objeknya

Option Explicit

Private Declare Function PrintWindow Lib "user32" (ByVal hwnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long

Private Sub Command2_Click()
Picture1.AutoRedraw = True
Set Picture1.Picture = Nothing
PrintWindow Me.hwnd, Picture1.hDC, 0
Picture1.Refresh
End Sub
READ MORE - PrintWindow - Capture Form Beserta Seluruh Objeknya

Manipulasi ShowInTaskBar Pada Form

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_APPWINDOW = &H40000

Private Function ShowInTheTaskbar(frm As Form, b As Boolean)
Dim l As Long
frm.Hide
l = IIf(b, Not WS_EX_APPWINDOW, WS_EX_APPWINDOW)
SetWindowLong frm.hWnd, GWL_EXSTYLE, (GetWindowLong(hWnd, GWL_EXSTYLE) And l)
frm.Show
End Function

Private Sub Check1_Click()
ShowInTheTaskbar Me, Check1.Value = 1 'toggle
End Sub
READ MORE - Manipulasi ShowInTaskBar Pada Form

Membikin Area Transparan Obyek Geometri - (API Call)

Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Function fMakeATranspArea(AreaType As String, pCordinate() As Long) As Boolean
Const RGN_DIFF = 4
Dim lOriginalForm As Long
Dim ltheHole As Long
Dim lNewForm As Long
Dim lFwidth As Single
Dim lFHeight As Single
Dim lborder_width As Single
Dim ltitle_height As Single
On Error GoTo Trap
lFwidth = ScaleX(Width, vbTwips, vbPixels)
lFHeight = ScaleY(Height, vbTwips, vbPixels)
lOriginalForm = CreateRectRgn(0, 0, lFwidth, lFHeight)

lborder_width = (lFHeight - ScaleWidth) / 2
ltitle_height = lFHeight - lborder_width - ScaleHeight
Select Case AreaType

Case "Elliptic"
ltheHole = CreateEllipticRgn(pCordinate(1), pCordinate(2), pCordinate(3), pCordinate(4))
Case "RectAngle"
ltheHole = CreateRectRgn(pCordinate(1), pCordinate(2), pCordinate(3), pCordinate(4))
Case "RoundRect"
ltheHole = CreateRoundRectRgn(pCordinate(1), pCordinate(2), pCordinate(3), pCordinate(4), pCordinate(5), pCordinate(6))
Case "Circle"
ltheHole = CreateRoundRectRgn(pCordinate(1), pCordinate(2), pCordinate(3), pCordinate(4), pCordinate(3), pCordinate(4))
Case Else
MsgBox "Unknown Shape!!"
Exit Function
End Select
lNewForm = CreateRectRgn(0, 0, 0, 0)
CombineRgn lNewForm, lOriginalForm, _
ltheHole, RGN_DIFF

SetWindowRgn hWnd, lNewForm, True
Me.Refresh
fMakeATranspArea = True
Exit Function
Trap:
MsgBox "error Occurred. Error # " & Err.Number & ", " & Err.Description
End Function

Private Sub Command1_Click()
Dim lParam(1 To 6) As Long
lParam(1) = 100
lParam(2) = 100
lParam(3) = 250
lParam(4) = 250
lParam(5) = 50
lParam(6) = 50
Call fMakeATranspArea("Circle", lParam())
End Sub
READ MORE - Membikin Area Transparan Obyek Geometri - (API Call)

Tuesday, June 12, 2012

Membuat GUI Tanpa Terpengaruh Resolusi Screen - Tips dan Trik VB

Setelah memahami perbedaan .Top, .Left, .Width, .Height dengan .ScaleTop, .ScaleLeft, .ScaleWidth, .ScaleHeight maka kita sekarang melangkah pada bagian selanjutnya mengenai tampilan yang tidak terpengaruh oleh resolusi layar.

Sederhanya agar sebuah form memiliki ukuran relatif sama adalah membagi ukurannya lebar dan tinggi berdasarkan prosentase. Perhatikan 2 baris kode di bawah:
Option Explicit 

Private Sub
Form_Resize()
With Form1
.Left = 0
.Top = 0
.Height = Screen.Height
.Width = Screen.Width
End With
End Sub

Kode di atas akan membuat sebuah form memiliki ukuran sama dengan tinggi dan lebar layar, berapapun resolusinya. Maka kode di bawah akan membuat form memiliki ukuran 1/2 dari ukuran layar baik tinggi maupun lebarnya, berapapun resolusi layar yang Anda setting.
Option Explicit 

Private Sub
Form_Resize()
With Form1
.Left = 0
.Top = 0
.Height = (Screen.Height * 0.5) 'Ini akan membuat tinggi Form setengahnya dari layar
.Width = (Screen.Width * 0.5) 'Ini akan membuat lebar Form setengahnya dari layar.
End With
End Sub

Sekarang coba Anda rubah resolusi layar ke posisi paling ektrim terbesar atau ke posisi ektrim terendah, Apakah tinggi dan lebar Form tersebut berubah? tidak, dia tetap setengahnya dari layar. Lalu apa yang harus Anda lakukan selanjutnya, melakukan resize terhadap seluruh control (CommandButton, TextBox, Label, dan lain-lain. Nah, bagaimana caranya?

READ MORE - Membuat GUI Tanpa Terpengaruh Resolusi Screen - Tips dan Trik VB

Memberi Batas Minimal - Maksimal Sebuah Aplikasi - VB6

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

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

Private Type
POINTAPI
X As Long
Y As Long
End Type

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

Global lpPrevWndProc As Long
Global gHW As Long

Private Declare Function
DefWindowProc Lib "user32" Alias _
"DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function
CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function
SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub
CopyMemoryToMinMaxInfo Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "kernel32" Alias _
"RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
ByVal cbCopy As Long)

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

Public Sub
Unhook()
Dim temp As Long

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

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

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

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

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

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

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

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

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

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

Agar Form Tidak Bisa Digeser Atau Dipindahkan - VB6

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

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

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

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

Cara Membuat Form Transparan Menggunakan VB6

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

Bagaimanakah kode untuk membuat form transparant ini:
Option Explicit 

Private Declare Function
GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function
SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function
SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

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

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

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

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

Friday, June 8, 2012

VB6 Code - Menghilangkan Tombol Max-Min Pada Saat Runtime

Mengenai cara menghilangkan tombol max dan tombol min yang terdapat pada sebelah kanan atas sebuah form - Seperti yang kita tahu bahwa pada form sebelah kanan bagian atas terdapat 3 tombol, yaitu: tombol max, tombol min, dan tombol close. Nah pada kesempatan kali ini kita akan menyembunyikan seluruh tombol menggunakan fungsi API, adapun kodenya adalah sebagai berikut:
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
GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Const
WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Const WS_SYSMENU = &H80000

Private Sub
Form_Load()
Dim l As Long
l =
GetWindowLong(Me.hwnd, GWL_STYLE)
l = (l And Not WS_SYSMENU)
l = SetWindowLong(Me.hwnd, GWL_STYLE, l)
End Sub
READ MORE - VB6 Code - Menghilangkan Tombol Max-Min Pada Saat Runtime

VB6 Code - Form SDI, Cara Menonaktifkan Tombol Close

Sebelumnya telah diposting mengenai cara mendisable tombol close pada MDI form, nah sekarang mengenai cara menonaktifkan tombol close yang terdapat pada control box SDI form menggunakan VB6 code. Di bawah ini merupakan kode untuk menghilangkan tombol close atau button X yang terdapat pada SDI form.
Option Explicit 

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

Private Const MF_BYPOSITION = &H400&

Public Sub RemoveButtonX(frm As Form)
Dim hSysMenu As Long
hSysMenu = GetSystemMenu(frm.hWnd, 0)
Call RemoveMenu(hSysMenu, 6, MF_BYPOSITION)
Call RemoveMenu(hSysMenu, 5, MF_BYPOSITION)
End Sub
Contoh penggunaan kode di atas.
Option Explicit 

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = -1 'untuk mendisable Alt + F4 </i>
End Sub

Private Sub Form_Load()
RemoveButtonX Me
End Sub
READ MORE - VB6 Code - Form SDI, Cara Menonaktifkan Tombol Close

VB6 Code - Disable Button X atau Tombol Close Pada MDI

Kode untuk mendisable button x atau tombol close pada MDI form - Di bawah ini merupakan cara menghilangkan button 'x' atau tombol close pada MDI Form.
'simpan kode di bawah pada module 
Option Explicit

Private Declare Function DeleteMenu Lib "user32" ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function
GetSystemMenu Lib "user32" ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Const MF_BYPOSITION = &H400&

Dim hMenu As Long

Public Sub RemoveMenus(frm As Form, Optional brestore As Boolean, Optional bmove As Boolean, Optional bsize As Boolean, Optional bminimize As Boolean, Optional bmaximize As Boolean, Optional bseperator As Boolean, Optional bclose As Boolean)
hMenu = GetSystemMenu(frm.hwnd, False)
If
bclose Then DeleteMenu hMenu, 6, MF_BYPOSITION
If
bseperator Then DeleteMenu hMenu, 5, MF_BYPOSITION
If
bmaximize Then DeleteMenu hMenu, 4, MF_BYPOSITION
If
bminimize Then DeleteMenu hMenu, 3, MF_BYPOSITION
If
bsize Then DeleteMenu hMenu, 2, MF_BYPOSITION
If
bmove Then DeleteMenu hMenu, 1, MF_BYPOSITION
If
brestore Then DeleteMenu hMenu, 0, MF_BYPOSITION
End Sub
Contoh penggunaan kode di atas:
'simpan kode di bawah pada MDI Form.  
Option Explicit

Private Sub MDIForm_Load()
'nilai true untuk remove, sesuaikan kodenya!
RemoveMenus Me, , , , , , True, True
End Sub
READ MORE - VB6 Code - Disable Button X atau Tombol Close Pada MDI

Saturday, June 2, 2012

Manipulasi ShowInTaskBar Pada Form

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_APPWINDOW = &H40000

Private Function ShowInTheTaskbar(frm As Form, b As Boolean)
Dim l As Long
frm.Hide
l = IIf(b, Not WS_EX_APPWINDOW, WS_EX_APPWINDOW)
SetWindowLong frm.hWnd, GWL_EXSTYLE, (GetWindowLong(hWnd, GWL_EXSTYLE) And l)
frm.Show
End Function

Private Sub Check1_Click()
ShowInTheTaskbar Me, Check1.Value = 1 'toggle
End Sub
READ MORE - Manipulasi ShowInTaskBar Pada Form

Tuesday, May 29, 2012

Modal, Modeless, Non Modal Non Modeless - VB6

Dalam menampilkan sebuah form, apalagi jika bukan method .Show yang digunakan. Method .Show ini memiliki dua parameter, yaitu [Modal] dan [OwnerForm], jadi lengkapnya adalah seperti ini Form.Show ([Modal], [OwnerForm]). Karena dua parameter (Modal, OwnerForm) ini bersifat Optional, maka kita memiliki pilihan antara memasukan argumen (satu atau kedua-duanya) atau tidak. Yang menjadi pertanyaan disini adalah, bagaimana kita dapat mengetahui perbedaan antara argumen yang dimasukan (Modal, Modeless, Non Modal Non Modeless)?

Untuk memahami perbedaan antara Modal, Modeless, Non Modal Non Modeless lebih baik kita praktekan saja. Buatlah Project Standar Exe dengan dua Form, Form1 dan Form2. Pada Form1 berilah satu CommandButton. Masukan kode di bawah ini pada Form1.
Option Explicit 

Private Sub
Command1_Click()
Form2.Show 'Non Modal Non Modeless
MsgBox "Non Modal Non Modeless"
End Sub
Jalankan kode di atas, Klik sembarang pada Form1.

Kesimpulan: Pertama, dengan menggunakan kode di atas, kode-kode selanjutnya akan tetap dijalankan (disini diwakili dengan MessageBox). Kedua, Form1 dapat menempati posisi paling depan (Zorder 0). Nah, sekarang rubahlah kodenya menjadi:
Option Explicit 

Private Sub
Command1_Click()
Form2.Show vbModal, Me 'Modal
MsgBox "Non Modal Non Modeless"
End Sub
Jalankan kode di atas, Klik sembarang pada Form1.

Kesimpulan: Pertama, dengan menggunakan kode kedua, kode-kode selanjutnya tidak bisa dijalankan (disini diwakili oleh MessageBox) sebelum Form2 di tutup. Kedua, Form1 tidak bisa menempati posisi paling depan. Sekarang, rubahlah kodenya menjadi:
Option Explicit 

Private Sub
Command1_Click()
Form2.Show vbModeless, Me
MsgBox "Non Modal Non Modeless"
End Sub
Jalankan kode di atas, klik sembarang pada Form2.

Kesimpulan: Pertama, kode-kode selanjutnya bisa dijalankan (diwakilik MessageBox). Kedua: Form1 tidak bisa menempati posisi paling depan (Zorder 0).
Nah, sekarang Anda telah memahami perbedaan antara Modal, Modeless, Non Modal Non Modeless. Mengenai argumen-argumen ini ada sebuah trik yang sangat bagus (setidaknya menurut saya sendiri), dan bisa Anda baca disini.

Semoga Bermanfaat.
READ MORE - Modal, Modeless, Non Modal Non Modeless - VB6

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

Menguji Kecepatan Sebuah Form Ketika Diload

Di bawah ini merupakan fungsi untuk menguji kecepatan load sebuah form. Berbicara mengenai uji menguji kecepatan, maka fungsi API yang digunakan umumnya GetTickCount yang terdapat dalam core dll windows yakni Kernel32.dll. Selain untuk menguji kecepatan form, kode di bawah ini bisa Anda modifikasi untuk keperluan lain, misalnya menguji kecepatan sebuah fungsi/kode dan lain-lain. Ide pembuatan fungsi ini kami dapatkan dari o-om.com, terima kasih.
Option Explicit 

Private Declare Function
GetTickCount Lib "kernel32" () As Long

Public Function
FormTestSpeed(frm As Form) As Long
Dim
lSpeedTime As Long
Dim
SInfoSpeed As String
lSpeedTime = GetTickCount
Unload frm
Load frm
frm.Show
lSpeedTime = GetTickCount - lSpeedTime
' this is only simulation
If lSpeedTime <= 50 Then
SInfoSpeed = "[Very Fast]"
ElseIf lSpeedTime >= 50 And lSpeedTime <= 100 Then
SInfoSpeed = "[Normal]"
ElseIf lSpeedTime >= 100 And lSpeedTime <= 200 Then
SInfoSpeed = "[Slow]"
ElseIf lSpeedTime >= 200 Then
SInfoSpeed = "[Very Slow]"
End If
frm.Caption = "Time Speed Form: " & lSpeedTime & " Milliseconds - " & SInfoSpeed
End Function

Contoh penggunaan fungsi di atas:
Private Sub Command1_Click() 
FormTestSpeed Form2
End Sub
READ MORE - Menguji Kecepatan Sebuah Form Ketika Diload

Monday, May 28, 2012

Membuat Efek Fade-In Fade-Out Pada Form - VB6 Code

Di bawah ini merupakan fungsi untuk membuat efek fade pada sebuah form.
Option Explicit 

Private Declare Function
GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function
SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function
SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal 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

Public 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 Command1_Click() 
Unload Me
End Sub

Private Sub Form_Load() 

Timer1.Enabled = False
Timer2.Enabled = False
Timer1.Interval = 1
Timer2.Interval = 1
Me.Visible = False
Timer1.Enabled = True

End Sub

Private Sub
Form_Unload(Cancel As Integer)
Cancel = 1
Timer1.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub
Timer1_Timer()
On Error Resume Next
iTransparant = iTransparant + 5
If iTransparant > 255 Then
iTransparant = 255
Timer1.Enabled = False
End If
MakeTransparan Me.hWnd, iTransparant
Me.Show
End Sub

Private Sub
Timer2_Timer()
On Error Resume Next
iTransparant = iTransparant - 5
If iTransparant < 0 Then
iTransparant = 0
Timer2.Enabled = False
End
End If
MakeTransparan Me.hWnd, iTransparant
End Sub
READ MORE - Membuat Efek Fade-In Fade-Out Pada Form - VB6 Code

Menjadikan Form Berada Paling Depan

Fungsi di bawah ini merupakana cara menampilkan form agar berada paling depan (Form On Top/Top Most)
Option Explicit 

Public Declare Function
SetWindowPos Lib "user32" ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const
HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Function
TopMost(frm As Form, bTopMost As Boolean)
If bTopMost Then
Call
SetWindowPos(frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
Call
SetWindowPos(frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Function
Contoh penggunaan menjadikan form berada paling depan
Private Sub Form_Load()
TopMost Me, True
End Sub
READ MORE - Menjadikan Form Berada Paling Depan

Menjadikan Form Semi Transparan

Bagaimana cara membuat form semi transparan menggunakan Visual Basic 6.0. Simaklah kodenya di bawah ini:
Option Explicit 

Private Declare Function
GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function
SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function
SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal 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

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

Contoh penggunaan membuat form semi transparan
Option Explicit 

Private Sub
Form_Load()
On Error Resume Next
MakeTransparan Me.hWnd, 75
End Sub
READ MORE - Menjadikan Form Semi Transparan

Membuat Form Yang Berbentuk Elips

Bagaimanakah cara membuat form yang berbentuk elips? tentu saja untuk keperluan ini kita harus memanggil beberapa fungsi API. Bagaimana kodenya? simaklah di bawah ini:
Option Explicit 

Private Declare Function
CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function
SetWindowRgn Lib "USER32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Contoh penggunaan fungsi API agar form berbentuk Elips
Private Sub Form_Click() 
Unload Me
End Sub

Private Sub
Form_Load()
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 299, 200), True
End Sub
READ MORE - Membuat Form Yang Berbentuk Elips