Extra Time


Private Sub Command1_Click()

mDate1 = CDate(“01-06-2002 7:38 am”)

‘ Add Hour To Add TimeOut
mDate2 = DateAdd(“h”, 9, mDate1)
mDate2 = DateAdd(“s”, 1800, mDate2)

‘ Add Over Time Amount!
mDate2 = DateAdd(“h”, 3, mDate2)
mDate2 = DateAdd(“s”, 1800, mDate2) ‘ & If There Time as 3:30 Or 5:30 then for 30 Use This Line

‘ Calculate Exact Time
mHour = DateDiff(“h”, mDate1, mDate2)
mDMint = DateDiff(“n”, mDate1, mDate2)
mhMint = Round(mHour – Int((mDMint / 60)), 0)
NetHr = (mHour – mhMint)

‘ Now Add Minits In Time
mMinits = Abs((NetHr * 60) – mDMint)
NetTime = NetHr + IIf((mMinits / 100) >= 0.3, 0.5, (mMinits / 100))

OverTimeAmount = (NetTime – 9.5)

End Sub

Save and Lost Text Files


Sub LoadText(Lst As TextBox, file As String)
‘Call LoadText (Text1,”C:\Windows\System\Saved.txt”)
On Error GoTo error
Dim mystr As String
Open file For Input As #1
Do While Not EOF(1)
Line Input #1, a$
texto$ = texto$ + a$ + Chr$(13) + Chr$(10)
Loop
Lst = texto$
Close #1
Exit Sub
error:
X = MsgBox(“File Not Found”, vbOKOnly, “Error”)
End Sub

Sub SaveText(Lst As TextBox, file As String)
‘Call SaveText (Text1,”C:\Windows\System\Saved.txt”)
On Error GoTo error
Dim mystr As String
Open file For Output As #1
Print #1, Lst
Close 1
Exit Sub
error:
X = MsgBox(“There has been a error!”, vbOKOnly, “Error”)
End Sub

‘From:PulseWave

Limit Mouse


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

Re-Join File


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

cd tray open


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

3D Text


‘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