“Nhấn và xem” với VB6

Chia sẻ: Lang Huyen | Ngày: | Loại File: PDF | Số trang:13

Thêm vào BST

Báo xấu

127
lượt xem 30
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

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...

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: “Nhấn và xem” với VB6

“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ị nCode
frm.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.