Tutorial Membuat Deteksi IP Komputer dengan VB 6

ehmm ,,, misi si tampan ini ( Tampan :ooo )mau share Cara membuat Deteksi IP Komputer dengan VB 6 semoga no soalnya udah muter - muter gak nemu juga tutorial ini kalo  tutup thered aja om momod, ikuti langkah - langkah ini ya harus sama persis :inidia :


Persiapan : 

1. Visual Basic 6.0 << Cari di engkong gugle usahakan yang vull ya 
2. Kopi + Rokok << Biar gak mumet 
3. Lagu om Bob Marley << Biar gak pusing 

Tutorial : 

1. Buka VB 6 dan pilih standart EXE.
2. Masukkan Komponen Winsock & Microsoft Windows Common Controls 6 (SP6) dengan cara klik kanan pada Toolbox dan pilih Components Untuk lebih jelas lihat gambar berikut : 

spoiler for 'SS': 

Beri tanda centang pada Microsoft Winsock Control 6.0 & Microsoft Windows Common Controls 6 (SP6).

3. Masukkan 1 buah progressbar, 1 buah timer, 4 buah label dan 2 buah command button. Atur propertinya sebagai berikut :

>> Progressbar ( Max = 30000)
>> Timer1 (Enabled = False dan Interval = 1000)
>> Label1 (Caption = Waktu)
>> Label2 (Caption = Nama Komputer)
>> Label3 (Caption = IP Komputer)
>> Label4 (Caption = Port)
>> Command1 (Caption = Deteksi)
>> Command2 (Caption = Keluar)

Berikut ini adalah tampilan Form yang telah diubah propertinya :

Spoiler: 

4. Kode : 

PHP Code:

Dim a As IntegerPrivate Sub Command1_Click()
For a = 1 To 30000
    ProgressBar1.Value = a
Next a
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()End
End Sub
Private Sub Timer1_Timer()Label1.Caption = Format _
    (Now, "HH:MM:SS - dd mmmm yyyy")Label2.Caption = "Nama Komputer : " _
    & Winsock1.LocalHostName
Label3.Caption = "IP Komputer : " & _
    Winsock1.LocalIP
Label4.Caption = "Port : " _
    & Winsock1.LocalPort
End Sub 

5. Tes program sederhana ini dengan menekan tombol F5'

Read More

Cara Buat Form Transparan

Langsung Aja

- Buat 1 Form Dengan Name Terserah Anda

-Tambahkan 2 Timer 1 dan Timer2 di Form Anda Dengan Interval 500

-Tambahkan Lagi 1 Module dengan Name Module1


Isi Code Berikut Pada Module

Spoiler:

Option Explicit Type xparticle x As Integer y As Integer oldX As Integer oldY As Integer iStopped As Integer End Type Global Const kecepatan_salju = 400 Global Const ukuran_salju = 1 Global snow(0 To kecepatan_salju) As xparticle

PostSubyek: Buat Form BerSalju Yesterday at 9:52 am Balas dengan kutipan Ubah/Hapus pesan Hapus post ini Lihat IP pengirim
Langsung Aja

- Buat 1 Form Dengan Name Terserah Anda

-Tambahkan 2 Timer 1 dan Timer2 di Form Anda Dengan Interval 500

-Tambahkan Lagi 1 Module dengan Name Module1

Isi Code Berikut Pada Module
Spoiler:
Option Explicit

Type xparticle
x As Integer
y As Integer
oldX As Integer
oldY As Integer
iStopped As Integer
End Type

Global Const kecepatan_salju = 400
Global Const ukuran_salju = 1
Global snow(0 To kecepatan_salju) As xparticle


Tambahkan Code Di Bawah Pada Form

Spoiler:

option Explicit Dim jalan As Boolean Private Sub Form_Load() ScaleMode = vbPixels DrawWidth = ukuran_salju BackColor = vbBlack Dim i As Integer For i = 0 To kecepatan_salju snow(i).x = CInt(Int(ScaleWidth * Rnd)) snow(i).y = CInt(Int(ScaleHeight * Rnd)) Next jalan = True Timer1.Enabled = True Const sTEXT = "Karamecat" ForeColor = vbRed FontSize = 20 CurrentX = ScaleWidth / 2 - TextWidth(sTEXT) / 2 CurrentY = ScaleHeight / 2 - TextHeight(sTEXT) / 2 - 5 Print sTEXT Const sText2 = "karameca.forumid.net" CurrentX = ScaleWidth / 2 - TextWidth(sText2) / 2 CurrentY = ScaleHeight / 2 + TextHeight(sText2) + 2 Print sText2 ForeColor = vbWhite End Sub Sub DrawSnow() Dim i As Integer Dim newX As Integer Dim newY As Integer Timer1.Enabled = False Do While jalan For i = 0 To kecepatan_salju PSet (snow(i).oldX, snow(i).oldY), vbBlack PSet (snow(i).x, snow(i).y) Next i For i = 0 To kecepatan_salju snow(i).oldX = snow(i).x snow(i).oldY = snow(i).y newX = snow(i).x + Int(2 * Rnd) newX = newX - Int(2 * Rnd) newY = snow(i).y + 1 If Point(newX, newY) = vbBlack Then snow(i).y = newY snow(i).x = newX Else If snow(i).iStopped = 10 Then If Point(snow(i).x + 1, snow(i).y + 1) = vbBlack Then snow(i).x = snow(i).x + 1 snow(i).y = snow(i).y + 1 snow(i).iStopped = 0 ElseIf Me.Point(snow(i).x - 1, snow(i).y + 1) = vbBlack Then snow(i).x = snow(i).x - 1 snow(i).y = snow(i).y + 1 snow(i).iStopped = 0 Else NewParticle (i) End If Else snow(i).iStopped = snow(i).iStopped + 1 End If End If Next i DoEvents Loop End Sub Sub NewParticle(i As Integer) snow(i).x = CInt(Int(ScaleWidth * Rnd)) snow(i).y = 0 snow(i).oldX = 0 snow(i).oldY = 0 snow(i).iStopped = 0 End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) jalan = False End Sub Private Sub Timer1_Timer() DrawSnow End Sub

Kemudian coba di jalankan programnya

Read More

Membuat Form Berbintang Dan Berjam

Buat :

[-] 1 form
[-] 1 timer-> dengan Name Timer1
[-] 1 timer > tmrjam
[-] 1 label > jam dengan capt. 00:00:00


masukin code form :

Spoiler:

Private Sub Form_Load() tmrjam.Interval = 1 End Sub Private Sub tmrjam_Timer() jam.Caption = Time End Sub Dim X(100), Y(100), Z(100) As Integer Dim tmpX(100), tmpY(100), tmpZ(100) As Integer Dim K As Integer Dim Zoom As Integer Dim Speed As Integer Private Sub Form_Activate() Speed = -1 K = 2038 Zoom = 256 Timer1.Interval = 1 For i = 0 To 100 X(i) = Int(Rnd * 1024) - 512 Y(i) = Int(Rnd * 1024) - 512 Z(i) = Int(Rnd * 512) - 256 Next i End Sub Private Sub Timer1_Timer() For i = 0 To 100 Circle (tmpX(i), tmpY(i)), 5, BackColor Z(i) = Z(i) + Speed If Z(i) > 255 Then Z(i) = -255 If Z(i) < -255 Then Z(i) = 255 tmpZ(i) = Z(i) + Zoom tmpX(i) = (X(i) * K / tmpZ(i)) + (Form1.Width / 2) tmpY(i) = (Y(i) * K / tmpZ(i)) + (Form1.Height / 2) Radius = 1 StarColor = 256 - Z(i) Circle (tmpX(i), tmpY(i)), 5, RGB(StarColor, StarColor, StarColor) Next i End Sub

Read More

Cara Membuat Form Transparan

Bahan:
1. Buat 1 Form
2. Buat 1 Module
3. Buat 1 Timer
4. Buat 3 Label
5. Buat 1 Gambar

Source Code Form1:

Spoiler:

Private Sub Form_Initialize() Call SetTransparency(Me.hWnd, Me.BackColor) End Sub Private Sub Label1_Click() End End Sub Private Sub Timer1_Timer() If Label3.Visible = False Then Label3.Visible = True Else Label3.Visible = False End If End Sub

Source Code Module1:

Spoiler:

Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Sub SetTransparency(piHwnd As Long, piColor As OLE_COLOR) Const G_E = &HFFEC Const W_E = &H80000 Const LW_KEY = &H1 SetWindowLong piHwnd, G_E, GetWindowLong(piHwnd, G_E) Or W_E SetLayeredWindowAttributes piHwnd, piColor, 0, LW_KEY End Sub

Read More

Cara Membuat Form Auto Resize

Langsung aja Cara Membuat Form Auto Resize.   

pertama masukan ini Di module

Quote:Public Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long
If plLeft < 0 Then
ActualPos = plLeft + 75000
Else
ActualPos = plLeft
End If
End Function

Private Function FindForm(pfrmIn As Object) As Long
Dim i As Long

FindForm = -1
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
FindForm = i
Exit Function
End If
Next i
End If
End Function


Private Function AddForm(pfrmIn As Object) As Long
Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)

FormRecord(MaxForm).Name = pfrmIn.Name
FormRecord(MaxForm).Top = pfrmIn.Top
FormRecord(MaxForm).Left = pfrmIn.Left
FormRecord(MaxForm).Height = pfrmIn.Height
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight

FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1

For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)
If i < 0 Then i = AddControl(FormControl, pfrmIn.Name)
Next FormControl
End Function

Private Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long

FindControl = -1
For i = 0 To (MaxControl - 1)
If ControlRecord(i).Parrent = inName Then
If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next

If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If
On Error GoTo 0

End If
End If
Next i
End Function

Private Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next

ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName

If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If

inControl.IntegralHeight = False

On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function

Private Function PerWidth(pfrmIn As Object) As Long
Dim i As Long

i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)

PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function

Private Function PerHeight(pfrmIn As Object) As Single
Dim i As Long

i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)

PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function

Private Sub ResizeControl(inControl As Control, pfrmIn As Object)
On Error Resume Next
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long

yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)

If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If

lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)

If TypeOf inControl Is Line Then
If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If

inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
End If

inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
inControl.Move lLeft, lTop, lWidth, lHeight
inControl.Move lLeft, lTop, lWidth
inControl.Move lLeft, lTop
End If
End Sub

Public Sub ResizeForm(pfrmIn As Object)

Dim FormControl As Control
Dim isVisible As Boolean
Dim StartX, StartY, MaxX, MaxY As Long
Dim bNew As Boolean


If Not bRunning Then
bRunning = True



If FindForm(pfrmIn) < 0 Then
bNew = True
Else
bNew = False
End If

If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
'pfrmIn.Visible = False

Else
If bNew Then
StartY = pfrmIn.Height
StartX = pfrmIn.Width
On Error Resume Next


For Each FormControl In pfrmIn
If FormControl.Left + FormControl.Width + 200 > MaxX Then _
MaxX = FormControl.Left + FormControl.Width + 200
If Xctrl.Top + FormControl.Height + 500 > MaxY Then _
MaxY = FormControl.Top + FormControl.Height + 500
If FormControl.X1 + 200 > MaxX Then _
MaxX = FormControl.X1 + 200
If FormControl.Y1 + 500 > MaxY Then _
MaxY = FormControl.Y1 + 500
If FormControl.X2 + 200 > MaxX Then _
MaxX = FormControl.X2 + 200
If FormControl.Y2 + 500 > MaxY Then _
MaxY = FormControl.Y2 + 500


Next FormControl
On Error GoTo 0

pfrmIn.Height = MaxY
pfrmIn.Width = MaxX
End If
On Error GoTo 0

End If

For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn

Next FormControl
On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
pfrmIn.Visible = isVisible
Else
If bNew Then
pfrmIn.Height = StartY
pfrmIn.Width = StartX

For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl
End If
End If
On Error GoTo 0

End If
bRunning = False
End If
EventActive = False
End Sub

Public Sub SaveFormPosition(pfrmIn As Object)
Dim i As Long

If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
FormRecord(i).Top = pfrmIn.Top
FormRecord(i).Left = pfrmIn.Left
FormRecord(i).Height = pfrmIn.Height
FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If
Next i
AddForm (pfrmIn)
End If
End Sub

Public Sub RestoreFormPosition(pfrmIn As Object)
Dim i As Long

If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If
Exit Sub
End If
Next i
End If
End Sub

Sudah itu masukan Kode ini Di formnya 

Quote:Call ResizeForm(me)

Read More

Tutorial Membuat WebBrowser Full VB6

TUtorial Membuat WebBrowser Full :D

Klik "Project" pada menu diatas pilih "Components" atau bisa juga dengan menekan CTRL+T Pada keyboard PC kalian :hmm dan pilih :

- Microsoft html object library
- Microsoft internet controls
- Microsoft Windows common Controls 5.0

Object tersebut akan muncul disebelah kiri dari program visual basic kalian
disana ada objek yang bernama "WebBrowser1" Tambahkan ke form ( perogram yang kita buat tersebut) dan tambahkan juga "Progress bar"

Notes : "Progress bar tersebut di gunakan untuk alamat tujuan kita . untuk contoh You are not allowed to view links. Register or Login to view." mengerti bukan ?

Tambahkan "6" Command Button dan isikan nama berikut :

"Back","Forward","Stop","Refresh","Home" and "GO"

Notes : Isikan nama pada "Caption" bukan "Name"

Isi code berikut pada command button " GO " :

Code:

WebBrowser1.Navigate Combo1

Back :

Code:

On Error Resume Next
WebBrowser1.GoBack

Forward :

Code:

On Error Resume Next
WebBrowser1.GoForward

Stop :

Code:

On Error Resume Next
WebBrowser1.Stop

Refresh :

Code:

WebBrowser1.Refresh

Home :

Code:

WebBrowser1.GoHome

SEKARANG ANDA BISA MENCOBA MENGGUNAKAN BROWSER WEB BARU ANDA. TAPI MASIH " SEDERHANA/SIMPLE"

Tambahkan code tersebut dimana saja dikode aplikasi/program anda :

* Ditambahkan di ProgressBarr :

Code:

'Ini bekerja untuk pesan setatus dan gambar reggae-cyber.tk.
    Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    On Error Resume Next
        If Progress = -1 Then ProgressBar1.Value = 100 'the name of the progress bar is "ProgressBar1".
            Label1.Caption = "Done"
            ProgressBar1.Visible = False 'This makes the progress bar disappear after the page is loaded.
            Image1.Visible = True
        If Progress > 0 And ProgressMax > 0 Then
            ProgressBar1.Visible = True
            Image1.Visible = False
            ProgressBar1.Value = Progress * 100 / ProgressMax
            Label1.Caption = Int(Progress * 100 / ProgressMax) & "%"
        End If
        Exit Sub
    End Sub

Tapi di sini Anda perlu menambahkan label yang disebut "Label1" dan juga gambar kecil seperti senyum atau apapun yang Anda inginkan dan nama adalah "image1"

Buka di form baru :

Code:

'Buka form baru " ingat form baru" reggae-cyber.tk
    Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    Dim frm As Form1
    Set frm = New Form1
    Set ppDisp = frm.WebBrowser1.Object
    frm.Show
    End Sub

Ini untuk membuka New Tab dengan browser Anda.

* history dan situs yang dikunjungi saat ini.

Code:

'Hal ini membuat sejarah/History situs dikunjungi dan juga mengubah judul browser sebagai judul halaman. Reggae-cyber.tk
    Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
        On Error Resume Next
        Dim i As Integer
        Dim bFound As Boolean
        Me.Caption = WebBrowser1.LocationName
        For i = 0 To Combo1.ListCount - 1
            If Combo1.List(i) = WebBrowser1.LocationURL Then
                bFound = True
                Exit For
            End If
        Next i
        mbDontNavigateNow = True
        If bFound Then
            Combo1.RemoveItem i
        End If
        Combo1.AddItem WebBrowser1.LocationURL, 0
        Combo1.ListIndex = 0
        mbDontNavigateNow = False
    End Sub

Anda dapat menambahkan tombol apapun asalkan untuk kepentingan program anda :

Code:

'This to tell you if a word is in the page, Here we call the WebPageContains function.
    Private Sub Command7_Click()
        Dim strfindword As String
            strfindword = InputBox("What are you looking for?", "Find", "") ' what word to find?
                If WebPageContains(strfindword) = True Then 'check if the word is in page
                    MsgBox "The webpage contains the text" 'string is in page
                Else
                    MsgBox "The webpage doesn't contains the text" 'string is not in page
                End If
    End Sub
    'This is the finding function.
    Private Function WebPageContains(ByVal s As String) As Boolean
        Dim i As Long, EHTML
        For i = 1 To WebBrowser1.Document.All.length
            Set EHTML = _
            WebBrowser1.Document.All.Item(i)
            If Not (EHTML Is Nothing) Then
                If InStr(1, EHTML.innerHTML, _
                s, vbTextCompare) > 0 Then
                WebPageContains = True
                Exit Function
            End If
        End If
    Next i
    End Function

Code:

WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

* Page properties :

Code:

WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

*Ini akan menjalankan page properties.

Code:

WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT

Save a page :

Code:

WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

*Hapus cookies dari komputer kalian

Code:

'This code is used to empty the cookies from the user's computer / We call function from here.
    Private Declare Function GetUserName _
    Lib "advapi32.dll" Alias "GetUserNameW" ( _
    ByVal lpBuffer As Long, _
    ByRef nSize As Long) As Long
    Private Declare Function SHGetSpecialFolderPath _
    Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" ( _
    ByVal hwnd As Long, _
    ByVal pszPath As String, _
    ByVal csidl As Long, _
    ByVal fCreate As Long) As Long
    Private Const CSIDL_COOKIES As Long = &H21
    'This calls the function that deletes the cookies.
    Public Sub Command1_Click()
    Dim sPath As String
    sPath = Space(260)
    Call SHGetSpecialFolderPath(0, sPath, CSIDL_COOKIES, False)
    sPath = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\*.txt*"
    On Error Resume Next
    Kill sPath
    End Sub

*Membuka HTML webpage :

Code:

Private Sub Form_Load()
    Text1.Text = Form1.browser.Document.documentElement.innerHTML
    End Sub

*Popup Blocker :

Code:

Private Function IsPopupWindow() As Boolean
    On Error Resume Next
    If WebBrowser1.Document.activeElement.tagName = "BODY" Or WebBrowser1.Document.activeElement.tagName = "IFRAME" Then
    IsPopupWindow = True
    Else
    IsPopupWindow = False
    End If
    End Function
    Private Sub webbrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    Dim frm As Form1
    Cancel = IsPopupWindow
    If Cancel = False Then
    Set frm = New Form1
    Set ppDisp = frm.WebBrowser1.object
    frm.Show
    End If
    End Sub

Ini akan memblokir semua pop-up, tapi di saat yang sama akan membuka link new tab seperti biasa.

* JavaScripts handeling

Code:

WebBrowser1.Silent = True

* Ukuran browser dan kode scrollbars :

Code:

Private Sub Form_Resize()
    On Error Resume Next
    WebBrowser1.Width = Me.ScaleWidth
    WebBrowser1.Height = Me.ScaleHeight - 1680
    End Sub

Selesai anda cuma perlu Icon dan gambar , kreasikan sebisa kalian :mohon

NB : Hargailah Postingan Saya Dengan Menekan Tombol REP and kalo mau copy paste sertakan penulisnya cape nih :capek

Read More

Tutorial Buat Progress Bar

Buat Standart exe
buat Form1

BorderStyle = 1 'Fixed Single
Caption = "Waiting..."
StartUpPosition = 2 'CenterScreen
LinkTopic = "Form1"
ClipControls = 'False'

Buat command Button 
Beri nama : Command2
Caption = "?"

Buat Command Button 
Beri nama : Command1
Caption = "Mulai"

Buat Timer 
Interval : 100
Enabled = 'False'

Buat Progress Bar
caranya : Ctrl + T (Component)
cari : Windows Common control 6.0 (sp6.0)
Appearance = 1

Kalau sudah Klik kanan "View Code"

Masukin :

Code:

Private Sub Command2_Click()
MsgBox "Coded by don-po", vbInformation + vbOKOnly, "About..."
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub ProgressBar1_OLECompleteDrag(Effect As Long)
    End
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    i = i + 1
    If i >= ProgressBar1.Max Then
        i = ProgressBar1.Max
    Else
        ProgressBar1.Value = i
    End If
End Sub

'Coded by don-po

 
^^v Enjoy...

Read More