“Nhấn và xem” với VB6
Trong công việc cũng như trong học tập, chắc không ít lần bạn phải tiếp xúc
với tài liệu nước ngoài và tự điển trên máy tính là trợ thủ đắc lực không thể
thiếu. Khả năng 'nhấn và xem' (hay 'click and see') - tra nghĩa từ ngay trong
tài liệu là tính năng rất cần thiết. Bài viết này sẽ hướng dẫn bạn xây dựng
một chương trình dạng 'nhấn và xem' với VB6.
Nguyên tắc hoạt động
Chương trình được đặt tên là CnS. Để có thể tra từ trong các ứng dụng khác (MS
Word, Arobat Reader, IE,...), chúng ta phải 'bắt' - câu móc hệ thống - để phát hiện khi
người dùng nhấn chuột (dĩ nhiên chương trình của chúng ta phải chạy nền), sau đó sao
chụp từ vị trí con trỏ chuột vào bộ nhớ và gửi về cho CnS xử lý. CnS sẽ so sánh từ này
với CSDL từ điển có sẵn và hiển thị form thông tin ngay vị trí từ muốn tra. CnS chạy
nền, đặt biểu tượng ở khay hệ thống.
Khởi tạo chương trình
Để bắt đầu, bạn tạo Standard Project mới, form1 mặc định được tạo. Vào menu
Project/Add Form để thêm form2, Project/Add module để thêm module mới. Đặt tên
form1=frmMain (Visible=false, Caption= 'Click and See'), form2=frmPopup (form hiển thị
thông tin, BoderStyle=0), module1=mHook. Vào Project/Properties chọn Startup Object
là Sub Main.
Tạo một file CSDL trong Access gồm 1 bảng (WordsTable) và trong bảng này tạo 9
trường: Words, Display, Pronunciation, Noun, Verbs, Adjective, Preposition, Adverb và
Other. Lưu với tên EV.mdb cùng thư mục với CnS.
Phần FRMMAIN
Trong frmMain bạn dùng MenuEditor tạo một menu cha (Caption: tùy ý, name:
mnuCnS,bỏ chọn ô Visible) và 2 menu con: 1(Caption: &Return to Program, name:
mnuR), 2(Caption: &Exit Program, name: mnuE). Nhấn Ctrl+T để vào hộp thoại
Components Control, click chọn và thêm lên form:
1. Microsoft ADO Data Control 6.0(OLEDB) (Name:ADO)
2. Microsoft DataGrid Control 6.0(OLEDB) (Name:DG, Enable=False, DataSource =
ADO)
3. Microsoft SysInfo Control 6.0 (Name: SI)
Đối tượng DG kết hợp với ADO sẽ hiển thị và cho phép bạn hiệu chỉnh trực tiếp lên
CSDL (Edit Mode).
Thêm lên form 5 CommandButton:
1.Caption: &Edit Mode, Name:cmdE
2. Caption: &Add Record, Name: cmdAR, Enable=false
3. Caption: &Delete Record, Name: cmdDR,Enable=false
4. Caption: &Return to Systray, Name: cmdRT
5. Caption: &Exit, Name: cmdExit
Ngoài ra, bạn thêm 2 Image để hiển thị trạng thái 'Enable' (hoạt động) và 'Disable' (tắt)
chương trình ở khay hệ thống.
Sub đảm nhiệm việc tạo icon ở khay hệ thống:
Private Sub AddToSysTray()
TrayI.cbSize = Len(TrayI)
TrayI.hWnd = Me.hWnd 'lấy handle của frmMain
TrayI.uId = 1&
TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayI.ucallbackMessage = WM_LBUTTONDOWN
TrayI.hIcon = imgIcon(1).Picture 'Icon hiển thị trạng thái Enable
TrayI.szTip = 'Click and See® Program-Enable' & Chr$(0) 'Chr$(0)- định dạng lại
tooltiptext
Shell_NotifyIcon NIM_ADD, TrayI 'tạo Icon
Me.Hide 'Ẩn frmMain đi
End Sub
và gỡ bỏ icon khỏi khay hệ thống:
Private Sub RemoveFromSystray()
TrayI.hWnd = Me.hWnd
TrayI.uId = 1&
TrayI.cbSize = Len(TrayI)
Shell_NotifyIcon NIM_DELETE, TrayI 'hủy bỏ icon
UnhookWindowsHookEx hHook 'không câu móc hệ thống
End Sub
Thủ tục form_load:
Private Sub Form_Load()
AddToSysTray 'xuống khay hệ thống
bState = 1 'trạng thái của chương trình là Enable
Edit_Mode = 0 'không cho phép hiệu chỉnh DataGrid
'thực hiện câu móc chuột hệ thống:
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc,
App.hInstance, 0)
ConnectStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' & App.Path &
'\EV.mdb;Persist
Security Info=False' 'chuỗi ConnectString của ADO
ADO.ConnectionString = ConnectStr
ADO.RecordSource = RecordSourceStr
ADO.Refresh
ADO.Recordset.Sort = 'Words' 'sắp xếp theo trường Words
End Sub
Sự kiện xử lý nhấn chuột lên form (thực ra là nhấn lên Icon ở khay
hệ thống):
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Msg = X / Screen.TwipsPerPixelX 'lấy tọa độ tương ứng với từng thông báo
Select Case Msg
Case WM_RBUTTONUP 'sau khi nhấn chuột phải
Me.PopupMenu mnuCnS 'hiển thị menu Popup
Case WM_LBUTTONDOWN 'nhấn chuột trái
bState = (bState = 0)
Select Case Abs(bState)
Case 0 'Disable chương trình
TrayI.hIcon = imgIcon(0).Picture
TrayI.szTip = 'Click and See Pro gram-Disable' & Chr$(0)
'không câu móc
UnhookWindowsHookEx hHook
Case 1 'Enable chương trình
TrayI.szTip = 'Click and See Pro gram®-Enable' & Chr$(0)
TrayI.hIcon = imgIcon(1).Picture
'câu móc lại
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc,
App.hInstance, 0)
End Select
Shell_NotifyIcon NIM_MODIFY, TrayI 'biến đổi thông tin Icon
End Select
End Sub
Khi tìm từ, nếu có DG sẽ trích duy nhất từ đó trong CSDL và hiển thị ở dòng đầu tiên.
Để biết từ cần tìm có trong CSDL hay không ta dựa vào thuộc tính Text của cột đầu
tiên:
Public Function FindWord(ByVal sWord As String) As Boolean
On Error GoTo errTrap
'câu truy vấn, không có khoảng cách trắng giữa dấu nháy đơn và dấu nháy kép
ADO.RecordSource = RecordSourceStr & ' where [Words]= ' ' & sWord & ' ' '
ADO.Refresh
FindWord = IIf(DG.Columns(0).Text vbNullString, True, False)
Exit Function
errTrap:
Select Case Err.Number
Case 6160 'lỗi không tìm thấy
FindWord = False 'không tìm thấy
End Select
End Function
Phần FRMPOPUP
Chọn BorderStyle cho form=0-None, Backcolor=Tooltip, Width=2000, Height=3075.
Thêm một Shape Control (mặc định là hình chữ nhật, Top=0, Left=0, Width=2000,
Height=3075) làm đường biên cho form, một CommandButton (Name:cmdClose) để
tạm thời giấu cửa sổ frmPopup, và một vbalRichEditControl (Name:rtfMain,
BackColor:vbWhite, Border=True).
Chú ý, trước khi sử dụng OCX vbalRichEditControl (có cung cấp kèm theo mã nguồn
hoặc có thể dùng RichTextBox), bạn phải chép nó vào thư mục Windows/System32,
nhấn -Run-cmd, từ dấu nhắc DOS di chuyển đến thư mục System32, gõ
'regsvr32 RichEditControl.ocx' nhấn Enter. Đồng thời cũng đăng kí thêm thư viện
SSubtmr6.dll (có cung cấp kèm theo mã nguồn). vbalRichEditControl là một
RichTextBox cấp cao, tôi đã tích hợp thêm TOM (Text Object Model) và các tính năng
khác nên rất hữu ích. Vào hộp thoại Add Components (Ctrl+T) chọn và thêm lên form
Microsoft Direct Text-to-Speech (file xvoice.dll, Name=TTS ) để thêm chức năng phát
âm cho chương trình. Thêm một Command Button (Name:cmdSpk) để khi nhấn vào đó
sẽ phát âm.
Private Sub cmdSpeak_Click()
TTS.Speak str4Speak 'str4Speak là một biến kiểu chuỗi toàn cục khai báo trong
module để lưu giữ chuỗi cần phát âm
End sub
Có những từ khác nhau nhưng nghĩa giống nhau, ta có thể tham khảo chéo bằng cách
nhấn đúp vào từ đó trong rtfMain.
Private Sub rtfMain_MouseUp(X As Single, Y As Single, Shift As Integer)
If rtfMain.SelectedText vbNullString Then'tìm từ được chọn và hiển thị nghĩa
mHook.FindWord rtfMain.SelectedText 'sub FindWord trong module mHook
End If
End Sub
Câu móc chương trình
Để câu móc vào các sự kiện của hệ thống, bạn phải sử dụng 3 API CallNextHookEx,
SetWindowsHookEx,UnhookWindowsHookEx (cẩn thận khi làm việc với hook, mã
nguồn của bạn phải chính xác, nếu không lúc debug chỉ cần một lỗi nhỏ là VB đóng lại
ngay).
Phần quan trọng nhất của chương trình, hàm 'bắt' chuột:
Public Function MouseProc(ByVal nCode As Integer, ByVal wParam As Long, ByVal
lParam As Long) As Long
On Error Goto errTrap
If nCode < 0 Then
MouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
Else
If (GetKeyState(VK_CONTROL) And &HF000000) And wParam =
WM_LBUTTONDOWN Then
SendKeys '^c'
SetPos frmPopup
strDisplay = Trim(Clipboard.GetText)
FindWord strDisplay
End If
MouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End If
Exit Function
errTrap:
Select Case Err.Number
Case 521 'lỗi Can't open clipboard
DoEvents 'chờ 1 chút
End Select
Nếu giá trị nCodefrm.Width, pnt.X * 15)
frm.Show
BringWindowToTop frm.hWnd 'cho ở trên các cửa sổ khác
End Sub
Biến strDisplay sẽ lấy nội dung từ đã được đưa vào bộ nhớ và kiểm tra xem từ có trong
CSDL hay không, nếu có thì đưa vào rtfMain của frmPopup bằng Sub AddWord:
Private Sub AddWord(ByRef rtfText As vbalRichEdit, ByVal sDisplay As String, _
ByVal sPro As String, ByVal sN As String, ByVal sV As String, _
ByVal sAdj As String, ByVal sPrep As String, ByVal sAdv As String, _
ByVal sOther As String)
'các đối số sDisplay, sPro, sV,... để chỉ nội dung các trường
Dim cStrW As String
Static nCount As Long
a = Array('{danh từ}', '{động từ}', '{tính từ}', '{giới từ}', '{trạng từ}', '{thể loại khác}') 'tên
tiếng Việt khi thêm vào rtfText ứng với 6 trường cuối
sA = Array(sN, sV, sAdj, sPrep, sAdv, sOther)
ResetRTF rtfText 'sub ResetRTF thiết lập các thuộc tính mặc định cho rtfText
rtfText.SelText = sDisplay & ' ' & sPro & Chr(13) 'Hiển thị từ và cách phát âm
'sub HighLight để tô màu cho các từ
HighLight rtfText, sDisplay, vbBlue, True 'từ tô màu xanh và đậm
HighLight rtfText, sPro, RGB(125, 0, 0) 'cách phát âm tô màu nâu
'vòng lặp để kiểm tra trường
For i = 0 To 5
If Len(sA(i)) 0 Then
'nếu trường khác rỗng
rtfText.SelText = a(i) & Chr(13) 'thêm tên trường tương ứng tiếng Việt và kí tự xuống
dòng
ExtractWord rtfText, sA(i) 'trích nghĩa của từ trong trường
HighLight rtfText, a(i),vbRed
'tô màu đỏ cho tên tiếng Việt của trường
End If
Next
rtfText.SelStart = 0 'đưa con trỏ về đầu
rtfText.ReadOnly = True 'không cho phép hiệu chỉnh rtfMain
End Sub
Cách hiển thị từ và nghĩa tôi dựa vào tự điển của English Study 4. Tôi xin nói qua về
cách tổ chức từ điển chứa từ. CSDL gồm 9 trường, trong đó có 3 trường cần có đầy đủ
thông tin là Words, Display, Pronunciation; 6 trường còn lại có thể có hoặc không.
Trong mỗi trường, nếu từ có nhiều nghĩa thì các nghĩa cách nhau bởi dấu '/', trước câu
ví dụ phải có dấu '*'. Chương trình ở đây không đủ thông minh để nhận ra từ loại nên
phải dùng vòng lặp kiểm tra trong 6 trường cuối, nếu trường rỗng thì bỏ qua, ngược lại
thì thêm tên của trường (theo tiếng Việt tương ứng) và trích nội dung của trường vào
rtfMain. Ví dụ như chữ a, chỉ có trường Noun= 'Chữ cái đầu tiên/ một, chỉ một/nốt thứ
sáu trong gam đô trưởng, nốt la*A sharp: la thăng*A flat:la giáng' thì khi gọi AddWord
sẽ thêm vào rtfMain:
A [ei]
{danh từ}
1.Chữ cái đầu tiên
2.một, chỉ một
3.nốt thứ sáu trong gam đô trưởng, nốt la
vd:
A sharp:la thăng
A flat: la giáng
Sub sau sẽ đảm nhiệm việc trích từ:
Private Sub ExtractWord(ByRef rtfText As vbalRichEdit, ByVal sStr As String)
Dim hOneMean As Boolean
Dim SymbolDivPos As Long
Dim SymbolStarPos As Long
Dim n As Long, m As Long, i As Integer
Dim sArray(0 To 100) As String
Dim sField As String, sChar As String, sExample As String
hOneMean = IIf(InStr(sStr, '/') = 0, True, False) 'từ có một nghĩa?
sField = IIf(Right(sStr, 1) '/', sStr & '/', sStr) 'chuỗi trong mỗi trường, thêm '/' vào cuối
chuỗi
'để CnS không bỏ qua nghĩa cuối
While (InStr(sField, '/') 0)
n=n+1
'tăng số hiển thị trước mỗi nghĩa
m = -1
SymbolDivPos = InStr(sField, '/') 'vị trí của '/' trong sFiled
sChar = Left(sField, SymbolDivPos - 1) ' mỗi nghĩa trong sFiled
If InStr(sChar, '*') 0 Then 'nghĩa này có ví dụ?
sExample = Mid(sChar, InStr(sChar, '*') + 1) & '*' 'chuỗi ví dụ
While (InStr(sExample, '*') 0)
SymbolStarPos = InStr(sExample, '*') 'vị trí của '*'
m = m + 1 'số ví dụ
sArray(m) = Left(sExample, SymbolStarPos - 1) 'trích mỗi ví dụ vào mảng
sExample = Mid(sExample, SymbolStarPos + 1) ' cắt bỏ ví dụ đã trích
Wend
sChar = Left(sChar, InStr(sChar, '*') - 1) 'cắt bỏ chuỗi ví dụ
End If
rtfText.SelText = Space(2) & IIf(hOneMean, vbNullString, n & '.') _
& sChar & Chr(13) 'ghi mỗi nghĩa vào rtfText
HighLight rtfText, sChar, RGB(0, 125, 0) 'và tô màu
If m -1 Then 'mỗi nghĩa có ví dụ?
rtfText.SelText = Space(5) & 'Ví dụ:' & Chr(13)
HighLight rtfText, 'Ví dụ:', RGB(217, 0, 217) 'tô màu hồng
For i = 0 To m
rtfText.SelText = Space(7) & sArray(i) & Chr(13) 'ghi ví dụ vào rtfText
HighLight rtfText, sArray(i), RGB(125, 0, 0) 'và tô màu nâu
Next
End If
sField = Mid(sField, SymbolDivPos + 1) 'không để vòng lặp vô tận
Wend
End Sub
Đầu tiên, ta kiểm tra từ có một nghĩa hay nhiều nghĩa. Gán biến cField=sStr(nội dung
của trường) và thêm vào bên phải kí tự '/' nếu chưa có. Sau đó sử dụng 2 vòng lặp
While để trích từng nghĩa và câu ví dụ.
Private Sub HighLight(ByRef rtfText As vbalRichEdit, ByVal sStr As String, _
ByVal oColor As Long, Optional bBold As Boolean = False)
rtfText.FindText sStr, , , , lStart, lEnd
rtfText.TextDocument.Range(lStart, lEnd).Font.ForeColor = oColor
rtfText.TextDocument.Range(lStart, lEnd).Font.Bold = bBold
End Sub
Xin nói thêm về cách dùng vbalRichEditControl và TOM, OCX này lấy từ trang
vbaccelerator.com (đúng như tên của nó, bạn sẽ tìm được những thứ rất hữu ích về VB
trên trang web này). Phương thức FindText của rtfMain tìm chuỗi sStr và lưu vị trí bắt
đầu của chuỗi vào biến lStart, vị trí kết thúc vào biến lEnd. Thuộc tính TextDocument
chỉ TOM, Range(lStart,lEnd) chỉ vùng được chọn từ vị trí lStart đến lEnd, Font xác lập
các giá trị của Font cho vùng được chọn như Shadow, Emboss, Animation...
Trở lại với hàm 'bắt' chuột của ta, nếu từ không tìm thấy thì hiển thị thông báo trong
rtfMain của frmPopup:
Private Sub DisplayNoSug(rtfText As vbalRichEdit, ByVal sStr As String)
ResetRTF rtfText
rtfText.SelText = sStr & Chr(13) 'hiển thị từ không có nghĩa này
HighLight rtfText,sStr,vbBlue,True 'tô màu và đậm
rtfText.SelText = ' Không tìm thấy từ này' & Chr(13) & ' trong từ điển' 'câu thông báo
HighLight rtfText, ' Không tìm thấy từ này' & Chr(13) & ' trong tự điển',vbRed 'tô đỏ câu
thông báo
rtfText.ReadOnly = True 'không cho phép hiệu chỉnh rtfMain
str4Speak = '' 'không thể phát âm từ này
End Sub
Và thêm 2 hàm không thể thiếu:
Private Sub ResetRTF(ByRef rtfText As vbalRichEdit)
rtfText.ReadOnly = False
rtfText.Text = ''
rtfText.SelectAll
rtfText.FontBold = False
rtfText.FontColour = vbBlack
End Sub
Public Sub FindWord(ByVal sWordFind As String)
Dim sFind As String
sFind = Trim(sWordFind)
With frmMain
If .FindWord(sFind) Then 'nếu từ có trong cơ sở dữ liệu
AddWord frmPopup.rtfMain, .DG.Columns(1).Text, .DG.Columns(2).Text,
Columns(3).Text, .DG.Columns(4).Text, .DG.Columns(5).Text, .DG.Columns(6).Text,
.DG.Columns(7).Text, .DG.Columns(8).Text
str4Speak = strDisplay 'chuỗi phát âm
Else
DisplayNoSug frmPopup.rtfMain, sFind 'không tìm thấy từ
End If
End With
End Sub
Hàm chính khởi động chương trình:
Sub Main()
If FindWindow(vbNullString, 'Click and See') = 0 Then'nếu chương trình chưa có ở khay
hệ thống
Load frmMain 'thì khởi động frmMain
End If
End Sub
Tới đây chương trình của bạn đã hoàn tất. Việc còn lại hơi nặng nhọc là nhập từ vào
CSDL.
Copyright by webtailieu.net