Option Explicit

Private Type RECT
left                 As Integer
top                  As Integer
right                As Integer
bottom               As Integer
End Type

Private Type POINT
x                    As Long
y                    As Long
End Type

Private Declare Sub ClipCursor Lib “user32″ (lpRect As Any)
Private Declare Sub GetClientRect Lib “user32″ (ByVal hWnd As _
Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib “user32″ (ByVal hWnd As _
Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib “user32″ (lpRect As RECT, _
ByVal x As Long, ByVal y As Long)

Public Sub LimitCursorMovement(ctl As Object)

Dim client           As RECT
Dim upperleft        As POINT
Dim lHwnd As Long
On Error Resume Next
lHwnd = ctl.hWnd
If lHwnd = 0 Then Exit Sub
GetClientRect ctl.hWnd, client
upperleft.x = client.left
upperleft.y = client.top
ClientToScreen ctl.hWnd, upperleft
OffsetRect client, upperleft.x, upperleft.y
ClipCursor client
End Sub

Public Sub ReleaseLimit()
‘Releases the cursor limits
‘Be sure to call on unloading the form
ClipCursor ByVal 0&
End Sub

Private Sub cmdNormal_Click()
ReleaseLimit
End Sub

Private Sub cmdSetLimit_Click()
LimitCursorMovement Me
End Sub

Private Sub Form_Load()
ReleaseLimit

End Sub

Private Sub Form_Unload(Cancel As Integer)
ReleaseLimit
End Sub

Option Explicit

Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_ALWAYS = 2
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1

Private Declare Function ReadFile Lib “kernel32″ _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long

Private Declare Function CloseHandle Lib “kernel32″ _
(ByVal hObject As Long) As Long

Private Declare Function WriteFile Lib “kernel32″ _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long

Private Declare Function CreateFile Lib _
“kernel32″ Alias “CreateFileA” _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Private Declare Function FlushFileBuffers Lib “kernel32″ _
(ByVal hFile As Long) As Long

Public Function JoinFiles(ByVal inputFilename As String) As _
Boolean

Dim fReadHandle As Long
Dim fWriteHandle As Long
Dim fSuccess As Long
Dim lBytesWritten As Long
Dim lBytesRead As Long
Dim ReadBuffer() As Byte
Dim TotalCount As Long
Dim Count As Integer
Dim FileName As String
Dim ret As Integer

‘ Kalau file output sudah ada
If Dir(inputFilename) <> “” Then
ret = MsgBox(“File Output (” & inputFilename & _
“) sudah ada.” & vbCrLf & _
“Akan ditindih??”, _
vbYesNo + vbQuestion, “Konfirmasi”)
If ret = vbNo Then

JoinFiles = False
Exit Function
Else
Kill inputFilename
End If
End If

Count = 1
FileName = Dir(inputFilename & “.1″)

‘No files to join
If FileName = “” Then
JoinFiles = False
Exit Function
End If

Do While FileName <> “”
Count = Count + 1
FileName = Dir(inputFilename & “.” & Count)
Loop
TotalCount = Count – 1

‘ Buka file handle untuk file yang hendak ditulisi
fWriteHandle = CreateFile(inputFilename, _
GENERIC_WRITE Or GENERIC_READ, 0, 0, _
OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

‘ Jika sukses lanjutkan
If fWriteHandle <> INVALID_HANDLE_VALUE Then

For Count = 1 To TotalCount
‘ Buka file yang dibaca
ReDim ReadBuffer(0 To FileLen(inputFilename & “.” & Count))
fReadHandle = CreateFile(inputFilename & “.” & Count, _
GENERIC_WRITE Or GENERIC_READ, 0, 0, _
OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

‘ Jika pembacaan sukses, lanjutkan
If fReadHandle <> INVALID_HANDLE_VALUE Then
‘ Baca blok pertama
fSuccess = ReadFile(fReadHandle, ReadBuffer(0), _
UBound(ReadBuffer), lBytesRead, 0)

‘ Tulis blok ke file
fSuccess = WriteFile(fWriteHandle, ReadBuffer(0), _
UBound(ReadBuffer), lBytesWritten, 0)

If fSuccess <> 0 Then
‘ Harus di-flush
fSuccess = FlushFileBuffers(fWriteHandle)
Else
‘ Jika ada error, keluar
JoinFiles = False
Exit Function
End If

fSuccess = CloseHandle(fReadHandle)

Else
‘ Jika ada error, keluar
JoinFiles = False
Exit Function
End If

Next Count
Else
‘ Jika ada error, keluar
JoinFiles = False
Exit Function
End If

‘ Tutup file setelah ditulis
fSuccess = CloseHandle(fWriteHandle)
JoinFiles = True

End Function

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdSplit_Click()
If JoinFiles(txtFileName.Text) Then
MsgBox “File telah berhasil di-gabung!”
Else
MsgBox “File gagal di-gabung!”
End If
End Sub

Set oWMP = CreateObject(“WMPlayer.OCX.7″)
Set colCDROMs = oWMP.cdromCollection

If colCDROMs.Count >= 1 Then

For i = 0 To colCDROMs.Count – 1
colCDROMs.Item(i).Eject
Next

End If

‘
‘The next code opens only the CD-rw:
Set oWMP = CreateObject(“WMPlayer.OCX.7″)
Set colCDROMs = oWMP.cdromCollection

If colCDROMs.Count >= 1 Then

For i = 0 To colCDROMs.Count – 1
colCDROMs.Item(1).Eject
Next

End If

‘
‘And this one ONLY the DVD-rw:
Set oWMP = CreateObject(“WMPlayer.OCX.7″)
Set colCDROMs = oWMP.cdromCollection

If colCDROMs.Count >= 1 Then

For i = 0 To colCDROMs.Count – 1
colCDROMs.Item(2).Eject
Next

End If

‘Code

Static Sub FormLabelCaptionEmbossed(L1 As Label, L2 As Label, L3 As Label, _
label_text As String, label_effect As Integer, label_forecolor As Long, _
label_depth As Integer)
Dim lt As String
Dim savesm As Integer
Dim f As Form
Set f = L1.Parent
L1.Visible = False
L2.Visible = False
L3.Visible = False
savesm = f.ScaleMode
f.ScaleMode = 3
If label_text = “” Then
lt = L1
Else
lt = label_text
End If
L1 = lt
L2 = lt
L3 = lt
L1.BackStyle = 0
L1.ForeColor = label_forecolor
L2.Width = L1.Width
L2.Height = L1.Height
L2.BackStyle = L1.BackStyle
L2.ForeColor = BOX_DARKGRAY&
L3.Width = L1.Width
L3.Height = L1.Height
L3.BackStyle = L1.BackStyle
L3.ForeColor = BOX_WHITE&
Select Case label_effect
Case GFM_SUNKEN
L2.Left = L1.Left – label_depth
L2.Top = L1.Top – label_depth
L3.Left = L1.Left + label_depth
L3.Top = L1.Top + label_depth
Case GFM_RAISED
L2.Left = L1.Left + label_depth
L2.Top = L1.Top + label_depth
L3.Left = L1.Left – label_depth
L3.Top = L1.Top – label_depth
End Select
f.ScaleMode = savesm
L1.Visible = True
L2.Visible = True
L3.Visible = True
L1.ZOrder
End Sub

Private Sub Form_Load()
FormLabelCaptionEmbossed Label1, Label2, Label3, “DIMENSI”, 2, vbBlue, 1
End Sub

‘Modules

Global Const GFM_STANDARD = 0
Global Const GFM_RAISED = 1
Global Const GFM_SUNKEN = 2
Global Const GFM_BACKSHADOW = 1
Global Const GFM_DROPSHADOW = 2
Global Const BOX_WHITE& = &HFFFFFF
Global Const BOX_LIGHTGRAY& = &HC0C0C0
Global Const BOX_DARKGRAY& = &H808080
Global Const BOX_BLACK& = &H0

Download Here

Bandwidth Monitor

Sedang Dalam Perbaikan dan Update Document

Private Sub CommandButton1_Click()
With Assistant
    .Visible = True
    .Animation = msoAnimationGreeting
End With
End Sub

Private Sub CommandButton2_Click()
With Assistant
    .Visible = False
    .Animation = msoAnimationGreeting
End With

End Sub

Private Sub CommandButton3_Click()
With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = “Tips for Saving Information.”
    .Labels(1).Text = “Save your work often.”
    .Labels(2).Text = “Install a surge protector.”
    .Labels(3).Text = “Exit your application properly.”
    .Show
End With

End Sub

‘2 texts, 2 labels and 2 commands
Private Sub cmdConvert_Click()
txtResult = NumToText(Val(txtNumber))
txtNumber.SelStart = 0
txtNumber.SelLength = Len(txtNumber)
txtNumber.SetFocus
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Function NumToText(dblVal As Double) As String
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim strVal As String, strBuff As String, strTemp As String
Dim nCol As Integer, nChar As Integer

‘Only handles positive values
Debug.Assert dblVal >= 0

If bInit = False Then
‘Initialize array
bInit = True
Ones(0) = “zero”
Ones(1) = “one”
Ones(2) = “two”
Ones(3) = “three”
Ones(4) = “four”
Ones(5) = “five”
Ones(6) = “six”
Ones(7) = “seven”
Ones(8) = “eight”
Ones(9) = “nine”
Teens(0) = “ten”
Teens(1) = “eleven”
Teens(2) = “twelve”
Teens(3) = “thirteen”
Teens(4) = “fourteen”
Teens(5) = “fifteen”
Teens(6) = “sixteen”
Teens(7) = “seventeen”
Teens(8) = “eighteen”
Teens(9) = “nineteen”
Tens(0) = “”
Tens(1) = “ten”
Tens(2) = “twenty”
Tens(3) = “thirty”
Tens(4) = “forty”
Tens(5) = “fifty”
Tens(6) = “sixty”
Tens(7) = “seventy”
Tens(8) = “eighty”
Tens(9) = “ninety”
Thousands(0) = “”
Thousands(1) = “thousand”   ‘US numbering
Thousands(2) = “million”
Thousands(3) = “billion”
Thousands(4) = “trillion”
End If
‘Trap errors
On Error GoTo NumToTextError
‘Get fractional part
strBuff = “and ” & Format((dblVal – Int(dblVal)) * 100, “00″) & “/100″
‘Convert rest to string and process each digit
strVal = CStr(Int(dblVal))
‘Non-zero digit not yet encountered
bAllZeros = True
‘Iterate through string
For i = Len(strVal) To 1 Step -1
‘Get value of this digit
nChar = Val(Mid$(strVal, i, 1))
‘Get column position
nCol = (Len(strVal) – i) + 1
‘Action depends on 1’s, 10’s or 100’s column
Select Case (nCol Mod 3)
Case 1  ‘1’s position
bShowThousands = True
If i = 1 Then
‘First digit in number (last in loop)
strTemp = Ones(nChar) & ” “
ElseIf Mid$(strVal, i – 1, 1) = “1″ Then
‘This digit is part of “teen” number
strTemp = Teens(nChar) & ” “
i = i – 1   ‘Skip tens position
ElseIf nChar > 0 Then
‘Any non-zero digit
strTemp = Ones(nChar) & ” “
Else
‘This digit is zero. If digit in tens and hundreds column
‘are also zero, don’t show “thousands”
bShowThousands = False
‘Test for non-zero digit in this grouping
If Mid$(strVal, i – 1, 1) <> “0″ Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(strVal, i – 2, 1) <> “0″ Then
bShowThousands = True
End If
End If
strTemp = “”
End If
‘Show “thousands” if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
strTemp = strTemp & Thousands(nCol \ 3)
If bAllZeros Then
strTemp = strTemp & ” “
Else
strTemp = strTemp & “, “
End If
End If
‘Indicate non-zero digit encountered
bAllZeros = False
End If
strBuff = strTemp & strBuff
Case 2  ’10’s position
If nChar > 0 Then
If Mid$(strVal, i + 1, 1) <> “0″ Then
strBuff = Tens(nChar) & “-” & strBuff
Else
strBuff = Tens(nChar) & ” ” & strBuff
End If
End If
Case 0  ‘100’s position
If nChar > 0 Then
strBuff = Ones(nChar) & ” hundred ” & strBuff
End If
End Select
Next i
‘Convert first letter to upper case
strBuff = UCase$(Left$(strBuff, 1)) & Mid$(strBuff, 2)
EndNumToText:
‘Return result
NumToText = strBuff
Exit Function
NumToTextError:
strBuff = “#Error#”
Resume EndNumToText
End Function

Private Sub Form_Load()

End Sub

Dim flag As Boolean
Public Sub Engine(char As String, length As Byte)

ReDim ary(length)
Dim depth As Byte
Dim result As String

depth = 1

While Not (flag)
k = DoEvents()
ary(depth) = ary(depth) + 1

If depth = length Then
result = Left(result, length – 1) + Mid(char, ary(depth), 1)
Else
result = result + Mid(char, ary(depth), 1)
End If

If ary(depth) <> Len(char) + 1 Then
If depth <> length Then
depth = depth + 1
Else
List1.AddItem result
If ChSave.Value = 1 Then Print #1, result
End If
Else
If depth = 1 Then
flag = True
Else
ary(depth) = 0
depth = depth – 1
result = Left(result, depth – 1)
End If
End If
Wend
End Sub

Private Sub InitValue(start As Boolean)
flag = start

ChSave.Enabled = start
txtChar.Enabled = start
txtLength.Enabled = start
If start Then
cmdGen.Caption = “Generate”
Else
cmdGen.Caption = “Stop”
End If
End Sub

Private Sub cmdGen_Click()
If Val(txtLength.Text) > Len(txtChar.Text) Then
MsgBox “Jumlah Kombinasi Salah”
Exit Sub
End If

If Len(txtChar.Text) = 0 Or (Val(txtLength.Text) = 0) Then
Exit Sub
End If

If cmdGen.Caption = “Generate” Then
InitValue False
If ChSave.Value = 1 Then
MsgBox “Disimpan pada hasil.txt”
Open App.Path + “\hasil.txt” For Output As #1
End If
Call Engine(txtChar.Text, txtLength.Text)
If ChSave.Value = 1 Then Close #1
InitValue True
Else
InitValue True
End If
End Sub

Private Sub CmdClear_Click()
List1.Clear
End Sub

Private Sub Form_Load()
List1.Clear
End Sub

Code:

Dim th As Double

Dim scal As Integer

Dim op1 As Integer

Dim op2 As Integer

Dim num1 As Double

Dim num2 As Double

Dim x As Double

Dim y As Double

Dim step As Double

Private Sub drawgraph()

GraphCls

For th = -3.2 To 3.2 Step step

Select Case op1

Case 0

x = Sin(num1 * th)

Case 1

x = Cos(num1 * th)

Case 2

x = Tan(num1 * th)

End Select

Select Case op2

Case 0

y = Sin(num2 * th)

Case 1

y = Cos(num2 * th)

Case 2

y = Tan(num2 * th)

End Select

SetPixel graph.hdc, 200 + scal * x, 200 – scal * y, RGB(0, 0, 0)

Next th

graph.Refresh

End Sub

Private Sub cmdnum1d_Click()

If num1 > 1 Then txtnum1 = txtnum1 – 1

End Sub

Private Sub cmdnum1p_Click()

If num1 < 50 Then txtnum1 = txtnum1 + 1

End Sub

Private Sub cmdnum2d_Click()

If num2 > 1 Then txtnum2 = txtnum2 – 1

End Sub

Private Sub cmdnum2p_Click()

If num2 < 20 Then txtnum2 = txtnum2 + 1

End Sub

Private Sub cmdchange_Click()

Form1.Hide

Form2.Top = Form1.Top

Form2.Left = Form1.Left

Form2.Show

End Sub

Private Sub form_load()

GraphCls

step = 0.001

scal = 100

End Sub

Private Sub GraphCls()

graph.Cls

graph.Line (200, 0)-(200, 400), RGB(255, 0, 0)

graph.Line (0, 200)-(400, 200), RGB(255, 0, 0)

End Sub

Private Sub Form_Unload(Cancel As Integer)

End

End Sub

Private Sub menuabout2_Click()

frmAbout.Show

End Sub

Private Sub menuchange_Click()

cmdchange_Click

End Sub

Private Sub menuexit_Click()

End

End Sub

Private Sub optopt1_Click(Index As Integer)

op1 = Index

drawgraph

End Sub

Private Sub optopt2_Click(Index As Integer)

op2 = Index

drawgraph

End Sub

Private Sub sldnum1_Scroll()

txtnum1.Text = sldnum1.Value

End Sub

Private Sub sldnum2_Scroll()

txtnum2.Text = sldnum2.Value

End Sub

Private Sub pull()

num1 = txtnum1.Text

num2 = txtnum2.Text

sldnum1.Value = num1

sldnum2.Value = num2

drawgraph

End Sub

Private Sub sldscale_Scroll()

scal = sldscale.Value * 50

drawgraph

End Sub

Private Sub Timerstart_Timer()

pull

drawgraph

Timerstart.Enabled = False

End Sub

Private Sub txtnum1_Change()

pull

End Sub

Private Sub txtnum2_Change()

pull

End Sub

Module:

Public Declare Function SetPixel Lib “gdi32″ (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal Color As Long) As Long

Upload Document Here

‘add 9 labels and 1 text and 1 timer

Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Form_Load()
Top = Screen.Height / 2 – Height / 2
Left = Screen.Width / 2 – Width / 2
StayOnTop Me
ErrorRsenD “•·• Lean Buster ¹·º •·•”
ErrorRsenD “•·• Now Loading •·•”

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Form_Paint()
Etched3D Me
FormShade_BlueGreen Me
End Sub

Private Sub Form_Resize()
StayOnTop Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
ErrorRsenD “•·• Lean Buster ¹·º •·•”
ErrorRsenD “•·• Now UnLoading •·•”
Unload Me
End
End Sub

Private Sub Label2_Click()
Label1.Caption = “0″
Label9.Caption = “0″
Timer1.Enabled = True
End Sub

Private Sub Label3_Click()
Timer1.Enabled = False
Timer2.Enabled = False
End Sub

Private Sub Label5_Click()
Unload Me
End
End Sub

Private Sub Label6_Click()
Form1.WindowState = 1
End Sub

Private Sub Label7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Text1_Change()

End Sub

Private Sub Timer1_Timer()
Dim topbust
If FindRoom Then Window_Close FindRoom
Label1.Caption = “0″
stopbust = False
Do: DoEvents
Call PrivateRoom(Text1)
Label1.Caption = Val(Label1.Caption) + 1
waitforok
If Timer1.Enabled = False Then Exit Sub
Loop Until FindRoom <> 0 Or Timer1.Enabled = False
If FindRoom <> 0 Then
Timeout 0.5
ErrorRsenD “•·• Lean Buster ¹·º •·•”
Timeout 0.2
ErrorRsenD “•·• Busted: ” & Label1.Caption & ” trys •·•”
End If
Timer1.Enabled = False
If Timer1.Enabled = False Then Exit Sub
End Sub

Private Sub Timer2_Timer()
Dim nofreeze
nofreeze = DoEvents
If Timer1.Enabled = False Then Timer2.Enabled = False
If Timer2.Enabled – False Then Exit Sub
Label9.Caption = Val(Label9.Caption) + 1
End Sub