Tác giả : Lê Nguyên Dũng
Lớp 11C
1
trường THPT Đăk Nông (Thị xã Gia Nghĩa - Đ ăk Nông)
Email của mình :
Nick : nguyen_dung_vb
Địa chỉ nhà : Thôn 1, thị trấn Đăk Mâm Huyện Krông Nô Tỉnh Đắk Nông
Tự hào ghê cái Logo của cuốn sách mình thiết kế bằng ... Word và Paint đấy. Nhìn vô cũng chuyên
nghiệp đấy chứ
Lời nói đầu
Sau khi “Xuất bản” cuốn “Chiêu thức lập trình” mình quả thật rất buồn vì chẳng có lấy một lời động
viên từ bất kỳ ai (Ở Đăk Nông này mình có biết ai mà khoe) còn anh em ở việt nam nét thì chẳng
đoái hoài gì cả vì vậy mình đã thật sự nản, để cuối cùng sau một sự cố nghề nghiệp phiên bản
Chiêu thức lập trình phiên bản 2 mình viết gần hoàn thành bỗng tan vào sương khói mình đã tuyệt
vọng. Nhưng mới hồi sáng khi mình “Viếng” www.caulacbovb.com một diễn đàn mình tham gia từ
khá lâu nhưng không mấy quan tâm mình đã thấy cuốn sách này được chia sẽ trên đó, cùng với
đó là lời khen của một nhân vật mình không nhớ tên đã làm mình rất vui, vì mình đã nhận ra mình
cũng được công nhận dù chỉ một chút. Cuốn Chiêu thức lập trình lần này sẽ được nâng cấp lên
với nhiều chiêu thức và hình vẽ minh hoạ để giúp các bạn nâng cao kiến thức.
Lời cầu cứu : Do từ năm lớp 9 đến nay mình chỉ tập trung vào học lập trình (Mà lại toàn tự học)
nên hiện nay đệ đã học sút rất nhiều nguy cơ rớt đại học ngày một đến gần mà ước mơ lớn nhất
của đời đệ là đậu vào khoa Công Nghệ Thông Tin Đại học Bách Khoa Hồ Chí Minh đệ mong rằng
có huynh nào đã từng phải nếm trải cảnh thi đại học thì chia sẻ kinh nghiệm học, học sách gì ...
Còn nếu có sách vở (Cũ cũng được) không cần dùng tới nhưng tốt để ôn thi đại học thì chia sẽ
cho đệ. Nếu có huynh nào có lòng “Hảo tâm” hãy gửi đến địa chỉ : (Đây là địa chỉ cô giáo dạy Tin
của trường đệ vào hết năm học này có thể thay đổi)
Phạm Thị Loan giáo viên trường Trung Học Phổ Thông Đăk Nông, xin ghi rõ là nhở gửi cho em Lê
Nguyên Dũng lớp 11C
1
Cuốn sách này là cuốn sách hoàn toàn miễn phí để chia sẽ trong cộng đồng lập trình nên nếu có ai
múôn sử dụng để in sách thì cũng nên ghi rõ xuất sứ.

Đôc chiêu 26 : Mở từng hộp thoại trong Control Panel
Đôc chiêu 27 : Mã hoá dữ liệu dạng text
Đôc chiêu 1 : “Thả một câu từ trên cao xuống” (Có thể nói như vậy) home
Xuất xứ : www.pscode.com
Binh khí sử dụng : Một Picture và một CommandButton
Đoạn mã :
Option Explicit
Private Sub command1_Click()
Randomize Timer 'Init Rnd
'Declarations
Dim StartTime(100) 'Starttime of a up/down
movement
Dim DownMovement(100) As Boolean 'are we doing a up or down
movement ???
Dim MoveDistance As Double 'distance target has moved
since the start of the movement
Dim YPos(100) As Double 'Holds the y position of a
letter
Dim MovementDone(100) As Boolean 'Is set to true when a up /
down movement is completed
Dim StartHeight(100) As Double 'From which hight will
the letter fall down ?
Dim UpMovementTime(100) As Double 'How long will it the
letter take to move up
Dim PowerLoss(100) As Double 'losing xx% of power
when touching the ground
Dim Message As String 'Message you want to display
Dim Looop As Integer 'Loop var
Dim TextColor(100) As ColorConstants 'Color of one letter


If DownMovement(Looop) = True Then

MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 *
((Timer - StartTime(Looop)) ^ 2))) 'Calculating falling distance

If YPos(Looop) >= picture1.ScaleHeight - 1 Then
MovementDone(Looop) = True 'The letter reached the bottom border.
The Downmovement is complete

Else
MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 *
(UpMovementTime(Looop) - (Timer - StartTime(Looop))) ^ 2)) 'Calculating
falling distance

If YPos(Looop) <= StartHeight(Looop) + 0.1 Then
MovementDone(Looop) = True 'The letter reached the max. height.
The upmovement is complete

End If

YPos(Looop) = MoveDistance

If YPos(Looop) > picture1.ScaleHeight - 1 Then
'If the letter fell picture1 of our picturebox ;) we fix it
YPos(Looop) = picture1.ScaleHeight - 1
'At the bottom position
End If

picture1.CurrentX = picture1.ScaleWidth / 2 -
Int((Len(Message) / 2)) + Looop

MovementDone(Looop) = False
End If

Next Looop

Loop 'Until StartHeight = picture1.ScaleHeight

End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub
Đôc chiêu 2 : Hiện một câu bằng cách lần lượt hiện từng chữ home
Xuất xứ : www.pscode.com
Binh khí sử dụng : Một Module , ba CommandButton lần lượt có các tên cmdStart, cmdClear,
cmdExit, thêm hai cái đồng hồ tên là Timer1 (Interval =50) và Timer2(Interval =5) cuối cùng là một
label tên là lblText
Đoạn mã :
Module :
Public ASCC(5) As String
Public Letters() As String
Public TXT As String
Public CurLetter As Integer
Public TEXTT As String
Public r As Integer
Form :
Private Sub cmdClear_Click()
lblText.Caption = ""
End Sub
Private Sub cmdExit_Click()
End

TEXTT = lblText
Timer2.Enabled = True
Timer1.Enabled = False
End If

End If

End Sub
Private Sub Timer2_Timer()
CurLetter = CurLetter + 1
If CurLetter > Len(TXT) Then
GoTo HERE:
End If
TEXTT = lblText
Timer1.Enabled = True
Timer2.Enabled = False
HERE:
Timer2.Enabled = False
End Sub
// neu co loi thi de 2 timer = False ->> tui ko phai tac gia
Đôc chiêu 3 : Hiện con trỏ động tại một đối tượng nào đó home
Xuất xứ : www.ttvnol.com
Binh khí sử dụng : Chỉ cần một cái Form
Đoạn mã :
'Hằng được sử dụng
private Const ConTro=(-12)
'Các hàm API được sử dụng
Private Declare Function SetClasslong Lib "user32" Alias
"SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal
wNewWord As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const Flags = SWP_NOMOVE Or SWP_NOSIZE
'Transparency Declarations and Constants
'I copied these from Robert Gainor's Example
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long,
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As
Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal
nCombineMode As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long,
ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long,
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long,
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As
Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As
Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal
X As Long, ByVal Y As Long) As Long
Private Const RGN_AND = 1
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4
Private Const RGN_COPY = 5

For X& = 0& To Width&
RGBColor& = GetPixel(dcMain&, X&, Y&)
If RGBColor& = TransparentColor& Then
rgnPixel& = CreateRectRgn(X&, Y&, X& + 1&, Y& + 1&)
CombineRgn rgnMain&, rgnMain&, rgnPixel&, RGN_XOR
DeleteObject rgnPixel&
End If
Next X&
Next Y&
SelectObject dcMain&, bmpMain&
DeleteDC dcMain&
DeleteObject bmpMain&
If rgnMain& <> 0& Then
SetWindowRgn Frm.hwnd, rgnMain&, True
MakeTransparent = rgnMain&
End If
Frm.ScaleMode = ScaleSize&
End Function
'Form Code
Private Sub Form_Load()
Call FormOnTop(Me)
Call CenterForm(Me)
Call MakeTransparent(Me, CLng(0))
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Call FormMoveXP(Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
End

Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long,
ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As
Long, ByVal bRevert As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private ReadyToClose As Boolean
Private Sub RemoveMenus(frm As Form, _
remove_restore As Boolean, _
remove_move As Boolean, _
remove_size As Boolean, _
remove_minimize As Boolean, _
remove_maximize As Boolean, _
remove_seperator As Boolean, _
remove_close As Boolean)
Dim hMenu As Long
hMenu = GetSystemMenu(hwnd, False)
If remove_close Then DeleteMenu hMenu, 6, MF_BYPOSITION
If remove_seperator Then DeleteMenu hMenu, 5, MF_BYPOSITION
If remove_maximize Then DeleteMenu hMenu, 4, MF_BYPOSITION
If remove_minimize Then DeleteMenu hMenu, 3, MF_BYPOSITION
If remove_size Then DeleteMenu hMenu, 2, MF_BYPOSITION
If remove_move Then DeleteMenu hMenu, 1, MF_BYPOSITION
If remove_restore Then DeleteMenu hMenu, 0, MF_BYPOSITION
End Sub
Private Sub cmdClose_Click()
ReadyToClose = True
Unload Me
End Sub
Private Sub Form_Load()
RemoveMenus Me, False, False, _

Đoạn mã :
Trong Module :
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC
As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal
un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As
Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As
Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As
Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
Function GetPressedKey() As String
For Cnt = 32 To 128
If GetAsyncKeyState(Cnt) <> 0 Then
GetPressedKey = Chr$(Cnt)
Exit For
End If

MsgBox sSave
End Sub
Đôc chiêu 9 : Đóng một ứng dụng bất kỳ home
Xuất xứ : www.echip.com.vn (Báo eChip)
Binh khí sử dụng : Cần một cái đồng hồ(Timer) chú ý thuộc tính Interval (Riêng tôi cho là 1)
Gíơi thiệu : Đoạn mã đóng một cửa sổ bất ỳ nào đó dựa vào tên của nó
Đoạn mã :
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam
As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub tmrkiemtra_Timer()
Do While FindWindow(vbNullString, "Windows Task Manager") <> 0
‘Gia su toi muon “Thu tieu “ hop thoai “Windows Task Manager”
PostMessage FindWindow(vbNullString, "Windows Task Manager"), &H10, 0&,
0&
Loop
End Sub
- Đây là một chiêu thức rất quan trọng của một phần mềm bảo mật nên có thể đang rất cần cho
nhiều bạn. Riêng tôi do quá “Bất mãn” với cái bọn bạn quỷ quái nên đây s ẽ là một trong những
tuyệt chiêu tôi sử dụng để viết Virus (Theo dự tính tiết thực hành thứ 2 tuần tới sẽ có vài cái máy
tính của trường phải “Nhập viện”) he he nhưng tôi không tàn nhẫn tới mức phá hoại đâu tui “Hiền
lắm” chỉ cho bọn bạn gà mờ “Biết ít khoe nhiều trên trường” không “Thực hành” thôi, Chúc các bạn
có những giây phút “Sản khoái” như tôi với độc chiêu này.
Đôc chiêu 10 : Tạo phím nóng cho chương trình : home
Xuất xứ : www.allapi.net
Binh khí sử dụng : Cần một cái Module (Form thì luôn luôn cần rồi)
Đoạn mã : (Bẫy phím Alt+Z)
Trong Module :

'is pressed -> show the window!
'The setting of wParam and lParam has no effect
erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, 0, 0)
End Sub
Đôc chiêu 11 : Thay đổi hình nền cho Desktop home
Xuất xứ : www.caulacbovb.com
Binh khí sử dụng : Một CommandButton
Đoạn mã :
Option Explicit
‘ Các hằng số và hàm phục vụ cho việc thay đổi WallPaper
Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_SENDWININICHANGE = &H2
Private Declare Function SystemParametersInfo Lib "user32" Alias
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal
lpvParam As Any, ByVal fuWinIni As Long) As Long
‘Phục vụ cho việc ghi giá trị vào Registry
Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As
Long

Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
If (r = 0) Then
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End If
WriteStringToRegistry = (r = 0)
Exit Function
ErrorHandler:
WriteStringToRegistry = False
MsgBox "Thay doi gia tri Registry khong thanh cong", , "Loi :"
End Function
Private Sub Command1_Click()
‘ Load file ảnh cần thiết
ChangeWallPaper "C:\Ben Tre.bmp" ‘Kiểu Tile
‘ChangeWallPaper "C:\Ben Tre.bmp", False ‘Kiểu Center
‘ChangeWallPaper "C:\Ben Tre.bmp", False, False ‘Kiểu Stretch
End Sub
Đôc chiêu 12 : Đóng mở khay CD-ROM home
Xuất xứ : www.caulacbovb.com
Lưu ý: Chương trình này chỉ tác dụng tới ổ CD đầu tiên trên hệ thống của bạn (ổ có tên gần với
tên Partition cuối cùng của máy).
Binh khí sử dụng : 2 CommandButton
Đoạn mã :
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
Function vbmciSendString(ByVal Command As String, ByVal hWnd As Long)

Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal
dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource
As Any, ByVal ByteLen As Long)
Public Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge
As Long, ByVal grfFlags As Long) As Boolean
Public Const GWL_USERDATA = (-21&)
Public Const GWL_WNDPROC = (-4&)
Public Const WM_USER = &H400&
Public Const TRAY_CALLBACK = (WM_USER + 101&)
Public Const NIM_ADD = &H0&
Public Const NIM_MODIFY = &H1&
Public Const NIM_DELETE = &H2&
Public Const NIF_MESSAGE = &H1&
Public Const NIF_ICON = &H2&
Public Const NIF_TIP = &H4&
Public Const WM_MOUSEMOVE = &H200&
Public Const WM_LBUTTONDOWN = &H201&
Public Const WM_LBUTTONUP = &H202&
Public Const WM_LBUTTONDBLCLK = &H203&
Public Const WM_RBUTTONDOWN = &H204&
Public Const WM_RBUTTONUP = &H205&
Public Const WM_RBUTTONDBLCLK = &H206&
Public Const BDR_RAISEDOUTER = &H1&
Public Const BDR_RAISEDINNER = &H4&
Public Const BF_LEFT = &H1&
Public Const BF_TOP = &H2&
Public Const BF_RIGHT = &H4&
Public Const BF_BOTTOM = &H8&

CopyMemory SysTray, 0&, 4
End Select
SubWndProc = CallWindowProc(PrevWndProc, hwnd, MSG, wParam, lParam)
'------------------------------------------------------------
End Function
'------------------------------------------------------------
--------- End mSysTray.bas -------------------
Sau khi bạn tạo module trên rồi, bạn tạo tiếp một cSysTray.ctl như sau:
----------------- cSysTray.ctl---------------------
Option Explicit
Private gInTray As Boolean
Private gTrayId As Long
Private gTrayTip As String
Private gTrayHwnd As Long
Private gTrayIcon As StdPicture
Private gAddedToTray As Boolean
Const MAX_SIZE = 510
Private Const defInTray = False
Private Const defTrayTip = "System Tray Control" & vbNullChar
Private Const sInTray = "InTray"
Private Const sTrayIcon = "TrayIcon"
Private Const sTrayTip = "TrayTip"
Public Event MouseMove(Id As Long)
Public Event MouseDown(Button As Integer, Id As Long)
Public Event MouseUp(Button As Integer, Id As Long)
Public Event MouseDblClick(Button As Integer, Id As Long)
'-------------------------------------------------------
Private Sub UserControl_Initialize()
'-------------------------------------------------------