Selamat Datang di Catwork Indonesia 2010 @ Agung RR
Buy blog reviews

Home

Selamat Datang di Catwork Indonesia.

Silahkan membaca Artikel, dan mendownload di situs ini. Apabila ada pengalihan situs jangan Khawatir, Cukup tekan Skip Ads pada kanan Atas.

Source Code VB 6.0-Membatasi Gerakan Kursor

- Source code ini adalah Membatasi gerakan kursor mouse hanya seluas tampilan form. Biasanya Anda sering menemukan seperti ini di warnet yang sudah dilengkapi dengan program/aplikasi billing on-line. Ketika Andadisconnect, maka Anda tidak dapat lagi menggerakkan mouse anda  keluar dari batas program billing tersebut.  Untuk membuat seperti tampilan tersebut, Anda tinggal melengkapi dengan menambahkan fungsi mematikan Ctrl-Alt-Del saja.
- Langkah-langkah :
1. Buat 1 Project baru dengan 1 Form, 1 Module, dan 2 Commandbutton.
2. Copy-kan kode berikut ke dalam editor Module/Form

//awal kode modul//
Public Type RECT
  left As Integer
  top As Integer
  right As Integer
  bottom As Integer
End Type
 
Public Type POINT
  x As Long
  y As Long
End Type
 
Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
//akhir kode module//

//awal kode form//
Private Sub Form_Load()
  Command1.Caption = "Limit Cursor Movement"
  Command2.Caption = "Release Limit"
End Sub
 
Private Sub Command1_Click()  'Membatasi gerak kursor mouse Anda...
Dim client As RECT
Dim upperleft As POINT
  GetClientRect Me.hWnd, client
  upperleft.x = client.left
  upperleft.y = client.top
  ClientToScreen Me.hWnd, upperleft
  OffsetRect client, upperleft.x, upperleft.y
  ClipCursor client
End Sub
 
Private Sub Command2_Click() 'Membebaskan gerak kursor kembali...
  ClipCursor ByVal 0&
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
//akhir kode form//

0 komentar:

Posting Komentar

 

Copyright 2010 ™Catwork Indonesia® | Serba Serbi Google | Translate | Design by CATWORK