Trik Mengunci Desktop dengan Printscreen

Cara agar komputer tidak diganggu oleh orang lain pada saat ditinggal sebentaradalah dengan mengunci Desktop, software2 yang siap pakai untuk keperluan ini juga banyak di internet, dari yang gratis sampai yang pake fulus, seperti: Desktop Locker, Quark, Matrix Screen Locker, dan lain lain. semua dibuat menurut gayanya sendiri2.

Tapi kalau anda seorang hoby's kutak katik VB 60. anda pasti ingin tahu sepertiapa sih syntax code2 nya. atau anda kurang puas karena tampilan software sudah ditentukan seperti itu, dan anda ingin mengubah sesuai selera anda. Untk itu simak baik-baik syntax2 code Trik Mengunci Desktop dengan Printscreen berikut ini :

Tuliskan kode ini pada form

Const RC_PALETTE As Long = &H100
Const SIZEPALETTE As Long = 104
Const RASTERCAPS As Long = 38
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Private Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) As PALETTEENTRY
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As
PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long,
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long,
ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As
PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE)
As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal
hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As
Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC
As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID

'Fill GUID info
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
End With
'Buat sebuah gambar
R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
'kembalikkan ke gambar yang baru
Set CreateBitmapPicture = IPic
End Function
Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc

As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As

Long
Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE

hDCMemory = CreateCompatibleDC(hDCSrc)
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)

RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
'Mengatur versi palet
LogPal.palVersion = &H300
'Jumlah keseluruhan nomor palet
LogPal.palNumEntries = 256
'Ambil entri sistem palet
R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
'buat palete
hPal = CreatePalette(LogPal)
'pilih palete
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
'mewujudkan palete
R = RealizePalette(hDCMemory)
End If

'Salin gambar sumber ke perangkat yang kompatibel
R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc,

vbSrcCopy)

'Mengembalikan gambar lama
hBmp = SelectObject(hDCMemory, hBmpPrev)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
'Pilih palette
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If

'hapus memory
R = DeleteDC(hDCMemory)

Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
End Function

Private Sub Form_DblClick()
Unload Me
End Sub

Private Sub Form_Load()
Me.Visible = False
If Me.Visible = False Then
Set Me.Picture = hDCToPicture(GetDC(0), 0, 0, Screen.Width /

Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
Me.Top = 0
Me.Left = 0
Me.WindowState = 2
Me.Visible = True
End If
End Sub

Pada saat program anda di Run. anda tidak akan tahu bahwa program tersebut sudah jalan / running. karena screen anda tidak berubah, kalau anda masih didalam Visual Basic, maka tampilannya juga seperti jendela Visual Basic, tapi anda tidak dapat meng Klik apapun. walhasil semua terhalang oleh form tersebut, dan untuk menutup program anda yang sedang dites itu, untuk sementara pake dobel klik pada form saja dulu. dan pada kesempatan akan datang, Isnsya Allah akan saya lanjutkan dengan source code tentang Mengetikkan Password pada Form. Mengunci Endtask, Mengunci start Menu. Untuk sekarang, cukup disini dulu

selamat mencoba.