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

Sunday, April 4, 2010

VB6 Code - Menjadikan Form Semi Transparan

Bagaimana cara membuat form semi transparan menggunakan Visual Basic 6.0?. Simaklah kode VB6 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 fungsi VB6 di atas:
Option Explicit

Private Sub Form_Load()
On Error Resume Next
MakeTransparan Me.hWnd, 75
End Sub
Demikian mengenai cara membuat form menjadi semi transparant menggunakan VB6. Semoga bermanfaat.
READ MORE - VB6 Code - Menjadikan Form Semi Transparan

VB6 Code - Menjadikan Form Berada Paling Depan

Fungsi VB6 di bawah ini merupakana cara menampilkan form agar berada paling depan (Form On Top/Top Most). Adapun kode VB6 untuk melakukan hal tersebut adalah sebagai berikut:
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 menggunakan VB6:
Private Sub Form_Load()
TopMost Me, True
End Sub
Demikian mengenai cara membuat fungsi VB6 (fungsi API) agar menjadikan sebuah form paling depan.
READ MORE - VB6 Code - Menjadikan Form Berada Paling Depan

VB6 Code - Membuat Efek Fade Pada Form

Di bawah ini merupakan fungsi VB6 untuk membuat efek fade pada sebuah form. Adapun kode VB6 untuk membuat efek fade pada sebuah form yang ditampilkan adalah sebagai berikut:
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

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
Demikian kode VB6 untuk membuat efek fade pada sebuah form.
READ MORE - VB6 Code - Membuat Efek Fade Pada Form

VB6 Code - Membuat Explode Effect Pada Form

Membuat efek/animasi blow/explode pada sebuah form menggunakan kode VB6. Adapun cara membut efek animasi blow/explode dengan menggunakan VB6 adalah sebagai berikut:
Option Explicit

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Const IMPLODE_EXPLODE_VALUE = 1500 'you can change the value

Sub ExplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = 1 To Movement
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub

Public Sub ImplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = Movement To 1 Step -1
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub
Contoh penggunaan membuat efek ledakan pada form:
Private Sub Command1_Click()
Call ImplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End
Set Form1 = Nothing
End Sub

Private Sub Form_Load()
Call ExplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End Sub
Demikian mengenai cara membuat efek ledakan (blow/explode) dengan menggunakan kode VB6. Semoga bermanfaat.
READ MORE - VB6 Code - Membuat Explode Effect Pada Form

VB6 Code - Menutup Seluruh Form For...each

Di bawah ini merupakan procedure VB6 untuk menutup seluruh form dengan menggunakan for...each.
Option Explicit

Public Sub CloseAllForm()
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Sub
Contoh penggunaan procedure di atas:
Private Sub Form_Unload(Cancel As Integer)
CloseAllForm
End Sub
Demikian contoh kode VB6 untuk menutup seluruh form menggunakan for .. each. Semoga bermanfaat.
READ MORE - VB6 Code - Menutup Seluruh Form For...each

VB6 Code - Membuat Form Yang Berbentuk Lingkaran

Mengenai cara membuat form yang berbentuk lingkarang menggunakan VB6 - Adapun cara membuat form berbentuk lingkaran menggunakan VB6 adalah sebagai berikut:
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

Function CutCirCle(frm As Form, Left, Top, Fat, Tall)
With frm
.Width = (Fat + 10) * 15
.Height = (Tall + 10) * 15
End With
SetWindowRgn frm.hWnd, CreateEllipticRgn(Left, Top, Fat, Tall), True
End Function
Contoh penggunaan kode VB6 di atas:
Private Sub Command1_Click()
Call CutCirCle(Me, 0, 0, 600, 600)
End Sub

Private Sub Form_Resize()
Command1.Left = ((610 * 15) / 2) - (Command1.Width / 2)
End Sub
Demikian kode VB6 untuk membuat form yang berbentuk lingkaran. Semoga bermanfaat.
READ MORE - VB6 Code - Membuat Form Yang Berbentuk Lingkaran

VB6 Code - Menyimpan Form Di Tengah Layar (screen)

Di bawah ini merupkan procedure VB6 untuk menyimpan/memindahkan form tepat di tengah layar.
Option Explicit

Private Sub CenterForm(frmIn As Object)

Dim iTop As Integer, ileft As Integer

If frmIn.WindowState <> 0 Then
'prevent if form maximized or minimized
'the form must in normal condition
Exit Sub
End If

ileft = (Screen.Width - frmIn.Width) \ 2
iTop = (Screen.Height - frmIn.Height) \ 2
frmIn.Move ileft, iTop

End Sub
Cara penggunaan kode VB6 di atas:
Private Sub Form_Load()
Form_Resize
End Sub

Private Sub Form_Resize()
CenterForm Me
End Sub
READ MORE - VB6 Code - Menyimpan Form Di Tengah Layar (screen)

VB6 Code - Membuat Form Yang Berbentuk Elips

Bagaimanakah cara membuat form yang berbentuk elips menggunakan kode Vb6? tentu saja untuk keperluan ini kita harus memanggil beberapa fungsi API. Bagaimana kode lengkap dari VB6 tersebut \? 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
Demikian kode VB6 untuk membuat form yang berbentuk lingkaran.
READ MORE - VB6 Code - Membuat Form Yang Berbentuk Elips

Saturday, April 3, 2010

VB6 Code - Drag Form Yang Tidak Memiliki Controlbox

Di bawah ini merupakan fungsi VB6 (menggunakan fungsi API) untuk men-drag form yang tidak memiliki Control Box.
Option Explicit

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 Declare Sub ReleaseCapture Lib "User32" ()

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Public Sub DragForm(frm As Form)
Dim lngReturnValue As Long
Call ReleaseCapture
lngReturnValue = SendMessage(frm.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
Contoh penggunaan drag form yang tidak memiliki controlbox
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragForm Me
End Sub
READ MORE - VB6 Code - Drag Form Yang Tidak Memiliki Controlbox

VB6 Code - Fungsi Untuk Membentuk Form Dari Huruf

Di bawah ini merupakan fungsi VB6 untuk membentuk form dari sebuah huruf, kata, atau kalimat. Untuk keperluan ini Anda dapat memodifikasi besar serta jenis hurufnya. Untuk keperluan-keperluan yang seperti ini, kita tidak bisa memprogramnya secara langsung akan tetapi harus melewati fungsi-fungsi API. Bagaimana implementasinya dalam Visual Basic 6.0? bisa Anda simak implementasinya di bawah ini:
Option Explicit

Private Declare Function SelectClipPath Lib "gdi32" (ByVal hDC As Long, ByVal iMode As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Const txt = "ASEP" & vbCrLf & "HIBBAN"

Public Function MakeFormChar(frm As Form)
Dim hRgn As Long

With frm.Font
.Name = "Comic Sans MS"
.Bold = True
.Size = 100
End With

With frm
.Width = frm.TextWidth(txt)
.Height = frm.TextHeight(txt)
BeginPath .hDC
.CurrentX = 0
.CurrentY = 0
frm.Print txt
EndPath .hDC
hRgn = PathToRegion(.hDC)
SetWindowRgn .hwnd, hRgn, False
.Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
End With

End Function
READ MORE - VB6 Code - Fungsi Untuk Membentuk Form Dari Huruf

Thursday, December 24, 2009

VB6 Code - Form Yang Mengikuti Pointer Mouse

Kali ini kita akan membuat sebuah project yang diberi judul 'Form Yang Mengikuti Pointer Mouse'. Maksudnya sebuah form yang mengikuti koordinat pointer mouse. Fungsinya telah diperbaiki sehingga sebuah form tidak akan melebihi ukuran layar. Lalu apa kegunaannya? Jawabannya dapat Anda lihat pada Pelengkap Kamus2.04 yang sengaja kami sisakan bug (form yang melebihi ukuran layar yang terlihat pada saat pointer terlampau ke kiri atau terlampau ke bawah) .

Berikut kodenya yang dibuat dengan Microsoft Visual Basic 6.0:
'Kode pada form1
Option Explicit

Private Sub Timer1_Timer()
PosisikanForm Form1
End Sub

'Kode pada module
Option Explicit

Private Declare Function GetCursorPosXY Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Public Sub GetCursorPos(xX As Long, xy As Long)
Dim pt As POINTAPI
Call GetCursorPosXY(pt)
xX = pt.x
xy = pt.y
End Sub

Public Sub PosisikanForm(frm As Form)
Dim x As Long
Dim y As Long
GetCursorPos x, y
'Kode di bawah merupakan inti dari project ini dengan fungsi yang telah diperbaiki
If ((y) + frm.Height / 15) > (Screen.Height / Screen.TwipsPerPixelY) Then
frm.Top = (y * 15) - (frm.Height)
Else
frm.Top = (y * 15) + 200
End If

If ((x) + frm.Width / 15) > (Screen.Width / Screen.TwipsPerPixelX) Then
frm.Left = (x * 15) - frm.Width
Else
frm.Left = (x * 15) + 200
End If

End Sub
READ MORE - VB6 Code - Form Yang Mengikuti Pointer Mouse