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

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

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