Kumpulan Source Code Visual Basic 6.0(VB)

anton

OPEN CD

Option Explicit

Private Declare Function mciSendString Lib “winmm.dll” Alias “mciSendStringA” (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub Command1_Click()

mciSendString “Set CDAudio Door Open Wait”, _

0&, 0&, 0&

End Sub

MENAMPILKAN START MENU

Option Explicit

Private Declare Function MapVirtualKey Lib “user32” Alias “MapVirtualKeyA” (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Declare Sub keybd_event Lib “user32” (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Private Sub Command1_Click()

Const MENU_KEYCODE = 91

‘ Press the button.

keybd_event MENU_KEYCODE, 0, 0, 0

DoEvents

‘ Release the button.

keybd_event MENU_KEYCODE, 0, KEYEVENTF_KEYUP, 0

DoEvents

End Sub

MENAMPILKAN INFO MEMORI

Option Explicit

Private Type MEMORYSTATUS

dwLength As Long        ‘ Size of MEMORYSTATUS

dwMemoryLoad As Long    ‘ % of memory in use

dwTotalPhys As Long     ‘ Total bytes of physical memory

dwAvailPhys As Long     ‘ Bytes of free physical memory

dwTotalPageFile As Long ‘ Bytes in paging file

dwAvailPageFile As Long ‘ Free bytes in paging file

dwTotalVirtual As Long  ‘ User bytes of address space

dwAvailVirtual As Long  ‘ Free user bytes

End Type

Private Declare Sub GlobalMemoryStatus Lib “kernel32” (lpBuffer As MEMORYSTATUS)

Private Sub Form_Load()

Dim mem As MEMORYSTATUS

Dim txt As String

GlobalMemoryStatus mem

With mem

txt = txt & “% used:                ” & Format$(.dwMemoryLoad, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Total physical memory: ” & Format$(.dwTotalPhys, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Physical memory free:  ” & Format$(.dwAvailPhys, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Total page file size:  ” & Format$(.dwTotalPageFile, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Free page file size:   ” & Format$(.dwAvailPageFile, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Total virtual memory:  ” & Format$(.dwTotalVirtual, “@@@@@@@@@@@”) & vbCrLf

txt = txt & “Free virtual memory:   ” & Format$(.dwAvailVirtual, “@@@@@@@@@@@”) & vbCrLf

End With

Label1.Caption = txt

End Sub

Private Sub Label1_Click()

End Sub

MENAMPILKAN STATUS MOUSE

Option Explicit

Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long

Private Type POINTAPI

x As Long

y As Long

End Type

‘ Get the mouse’s current position and see if it

‘ has moved since last time.

Private Sub tmrCheckMouse_Timer()

Static done_before As Boolean

Static last_point As POINTAPI

Dim cur_point As POINTAPI

‘ If we have done this before, compare the

‘ current mouse position to the previous one.

If done_before Then

GetCursorPos cur_point

If (cur_point.x <> last_point.x) Or _

(cur_point.y <> last_point.y) _

Then

lblMoving.Caption = “Moving”

Else

lblMoving.Caption = “Stationary”

End If

‘ Record the cursor position.

last_point = cur_point

Else

done_before = True

‘ Just record the cursor position.

GetCursorPos last_point

End If

End Sub

WINRUN

Option Explicit

Private Declare Function GetTickCount Lib “kernel32″ () As Long

Private Sub tmrCheckTime_Timer()

Const MS_PER_SEC As Long = 1000

Const MS_PER_MIN = MS_PER_SEC * 60

Const MS_PER_HR = MS_PER_MIN * 60

Const MS_PER_DAY = MS_PER_HR * 24

Dim ms As Long

Dim secs As Long

Dim mins As Long

Dim hrs As Long

Dim days As Long

ms = GetTickCount()

days = ms \ MS_PER_DAY

ms = ms – days * MS_PER_DAY

hrs = ms \ MS_PER_HR

ms = ms – hrs * MS_PER_HR

mins = ms \ MS_PER_MIN

ms = ms – mins * MS_PER_MIN

secs = ms \ MS_PER_SEC

ms = ms – secs * MS_PER_SEC

lblDays.Caption = Format$(days) & ” days”

lblHrs.Caption = Format$(hrs) & ” hours”

lblMins.Caption = Format$(mins) & ” minutes”

lblSecs.Caption = Format$(secs) & ” seconds”

End Sub

Satu Tanggapan

  1. ZZZZZ…

Tinggalkan komentar