Visual Basic 6- Chương 7- Dùng Control List - Phần 2

Chia sẻ: Son Cung | Ngày: | Loại File: DOC | Số trang:8

0
286
lượt xem
153
download

Visual Basic 6- Chương 7- Dùng Control List - Phần 2

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

Tham khảo tài liệu 'visual basic 6- chương 7- dùng control list - phần 2', công nghệ thông tin, kỹ thuật lập trình phục vụ nhu cầu học tập, nghiên cứu và làm việc hiệu quả

Chủ đề:
Lưu

Nội dung Text: Visual Basic 6- Chương 7- Dùng Control List - Phần 2

  1. Chương Bảy ­ Dùng List Controls (bài thứ hai) Listbox  Cách dùng MultiSelect  Cho đến giờ User click vào Listbox để chọn chỉ một Item. Khi một Item được chọn thì  hàng ấy trở nên highlighted với background màu xanh đậm. Nếu kế đó ta click một  hàng khác thì hàng cũ được display trở lại bình thường và hàng mới đuợc selected sẽ  trở nên highlighted.  Listbox cho ta có thể select nhiều Items cùng một lúc bằng cách set Property  MultiSelect = Extended Ðối với MultiSelected Listbox, ta chọn một nhóm Items liên tục bằng cách click Item  đầu rồi nhấn nút Shift trong khi click Item cuối. Ta cũng có thể tiếp tục  Select/Deselect thêm bằng cách ấn nút Ctrl trong khi click các Items. Nếu ta click một  Item chưa được selected thì nó sẽ trở nên selected (highlighted màu xanh), nếu ta  click một Item đã được selected rồi thì nó sẽ trở nên deselected (không còn màu xanh  nữa). Thí dụ trong program bạn click "Peter Jones", kế đó ấn nút Shift trong khi click  "Sue Rose", kế đó buông nút Shift ra để ấn nút Ctrl trong khi click "Kevin White", bạn  sẽ có những selected Items như trong hình dưới đây:
  2. Ngoài ra bạn cũng có thể MultiSelect nhiều Items trong một Listbox bằng cách dùng  mouse để drag, tức là bạn click lên Item đầu rồi tiếp tục đè mousebutton trong khi kéo  mousepointer đến Item cuối cùng mới buông mousebutton ra.  Cái Bug ác ôn  Bây giờ giả sử ta muốn delete tất cả những Items vừa được selected (highlighted). Bạn  hãy đặt một CommandButton mới tên CmdDeleteSelectedItems vào Form. Ta sẽ dùng  Event Click của Button nầy để delete những selected Items. Một selected Item của  lstNames sẽ có property Selected của nó bằng True. Tức là nếu Item thứ ba  (ListIndex=2) được selected thì ta có lstNames.Selected(2) = True. Ta có ý định sẽ  iterate through mọi Items của lstNames, để xem Item nào được selected thì mình sẽ  delete nó bằng cách dùng method RemoveItem. Ta sẽ viết code cho Sub  CmdDeleteSelectedItems_Click() như sau: Private Sub CmdDeleteSelectedItems_Click() Dim i For i = 0 To lstNames.ListCount - 1 If lstNames.Selected(i) = True Then lstNames.RemoveItem i End If Next End Sub Bạn hãy chạy chương trình, click Load để populate lstNames với các tên đọc từ text  file, rồi MultiSelect các tên như trong hình phía trên. Kế đó click button  DeleteSelectedItems. Program sẽ té (crash) và có hình như sau:
  3. Nếu bạn click nút Debug, program sẽ ngừng tại dòng code gặp error và highlight nó  với background màu vàng. Ðể mousepointer lên trên chữ i của lstNames.Selected(i),  VB6 sẽ popup message nho nhỏ i = 4.  Bạn để ý thấy trong hình lúc nầy lstNames chỉ còn có 4 Items (Ron, Trevor, John và  Alan), vì các Items kia đã bị removed. Bạn có biết tại sao program crashed không? Ðó là vì program đang refer đến property  Selected của Item thứ năm ( ArrayIndex i = 4) của lstNames trong khi lstNames bây  giờ chỉ còn có 4 Items. Vì vậy program crashed với message "Runtime error '381':  Invalid property array index". Thủ phạm của cái Bug ác ôn nầy là statement For i = 0 To lstNames.ListCount ­ 1.  VB6 chỉ tính value của lstNames.ListCount ­1 một lần lúc khởi sự For..Loop mà thôi  (tức là lstNames.ListCount ­1 = 6), nó không lưu ý là ListCount giảm value mỗi lần một  Item bị Removed. Ngoài ra ta thấy tên "Trevor Kennedy" cũng không bị removed, tức  là nó bị lọt sổ nếu ta dùng For..Loop theo cách nầy. Lý do là sau khi ta Remove "Peter  Jones" (Item thứ hai), "Trevor Kennedy" bị đẩy lên và trở thành Item thứ hai mới. Kế đó  ta increment value của i thành 2 rồi process Item thứ ba, tức là "Sue Rose", nên  "Trevor Kennedy" không hề được processed.
  4. Bạn có thể download program có bug nầy để chạy thử cho biết.  Sub CmdDeleteSelectedItems_Click cần phải được viết lại để dùng While ... Loop,  thay vì For...Loop. Trong While...Loop, lstNames.ListCount ­ 1 được evaluated (tính)  để test ở mỗi iteration. Khi nào ta Remove một Item thì ta không increment i, vì Item  ngay dưới removed Item được đẩy lên. Listing mới như sau:  Private Sub CmdDeleteSelectedItems_Click() Dim i i = 0 ' Initialise value of i to start from first Item ' Note that lstNames.ListCount is evaluated freshly at each iteration Do While i
  5. Dưới đây là listing của Function HexDisplay để convert từ ASCII string ra Hexadecimal  string. Function HexDisplay(InASCII) As String ' Convert an ASCII string to HEX string Dim InLen, i, msg, HexStr InLen = Len(InASCII) ' Get length of input string ' Convert each ASCII character to Hex For i = 1 To InLen HexStr = Hex(Asc(Mid(InASCII, i, 1))) ' If HEX has only one digit then prefix it with 0 If Len(HexStr) = 1 Then HexStr = "0" & HexStr msg = msg + HexStr & " " Next i HexDisplay = msg ' Return result string for Function End Function Trong program nầy, khi Listbox đạt đến 1000 items thì mỗi lần một hàng mới được  thêm vào, hàng cũ nhất sẽ bị removed. Ðể cho hàng mới nhất không bị dấu ta phải  nhớ cho ListIndex của Listbox bằng Listcount­1 để Listbox tự động scrollup và  highlight hàng cuối. Mỗi khi ta thêm một hàng vào Listbox lstHexadecimal, ta cũng đồng thời viết nó vào  một LogFile. Tên của LogFile nầy dựa vào ngày lấy từ Computer System và có dạng  như Hex30Jun01.log. Tức là ta sẽ dùng một LogFile khác cho mỗi ngày. Mỗi khi qua  ngày mới, program tự động dùng một LogFile mới. Nhớ là khi muốn viết vào một text  file theo tên gì đó, nếu file chưa hiện hữu thì ta phải create nó và viết vào, nếu file đã  hiện hữu rồi ta chỉ cần append hàng mới vào cuối file (phải cẩn thận chỗ nầy, vì nếu  không, ta vô ý overwrite cái file và mất hết những gì nó chứa trước đây).  Sub DisplayInHEX(inString) Dim Mess, LogFileName ' Convert ASCII to Hex Mess = HexDisplay(inString) ' Prefix with date and time and add it to the bottom of Listbox lstHexadecimal.AddItem Format(Now, "dd/mm/yyyy hh:nn:ss") & " " & Mess ' Keep only the latest 1000 events If lstHexadecimal.ListCount >= 1000 Then ' Remove the first Item, i.e. the oldest item lstHexadecimal.RemoveItem 0 End If ' Highlight the lattest item in the Listbox
  6. lstHexadecimal.ListIndex = lstHexadecimal.ListCount - 1 ' Use different log file each day. Filename has format like Hex15Jun01.log LogFileName = "Hex" & Format(Now, "ddmmmyy") & ".log" ' Log to file including Date and Time LogEvent LogFileName, Mess, False, 2 End Sub In ra content của Listbox  Dưới đây là một áp dụng của Listbox MutiSelect để in ra cả Listbox hay chỉ những  hàng được selected. Sub PrintList nhận: • Listbox mà ta muốn in  • một Boolean value mà nếu True thì in cả Listbox  • Title của Printout  Sub PrintList(theList As ListBox, PrintAll as Boolean, Title As String) ' Print the whole lot or only selected lines in a listbox ' PrintAll = True means printing the whole content of the listbox Const MaxLinesPerPage = 50 Dim msg, i, j, PageNo, NumLines, HasSome, Margin HasSome = False ' Flag indicating existence of data Margin = Space(10) ' Make a margin of 5 characters Title = vbLf & vbLf & Title + vbCrLf & vbLf NumLines = 0 ' Init number of lines on this page PageNo = 1 ' init Page number msg = Title ' Msg will contain everything starting with Title Printer.FontName = "Courier New" ' Initialise Printer Fontname Printer.FontSize = 10 ' Initialise Printer FontSize Screen.MousePointer = vbHourglass ' Change mousepointer shape to Hourglass. If theList.ListCount > 0 Then ' get here if the listbox is not empty For i = 0 To theList.ListCount - 1 ' Go thru each line of text in the listbox If theList.Selected(i) Or PrintAll Then ' print a line of text if it's selected or PrinAll is true DoEvents ' Let other processes have a chance to run HasSome = True NumLines = NumLines + 1 ' Increment count of lines If Left(theList.List(i), 1) = "'" Then ' if first character is "'" then use this as an indication to force a new page If NumLines > 0 Then ' Add extra blank lines to make up a page before inserting page number For j = NumLines - 1 To MaxLinesPerPage msg = msg & vbCrLf Next j ' Insert Page number at end of page msg = msg & Space$(35) & "Page-" & CStr(PageNo) Printer.Print msg Printer.NewPage ' Send new page.
  7. NumLines = 1 ' reset Number of lines, counting this current line PageNo = PageNo + 1 ' Increment Page number msg = Title ' Reset Msg to contain Title for new page ' Append this current line, ignoring character "'" msg = msg & Margin & Mid(theList.List(i), 2) & vbCrLf Else ' Blank page so far - so just appending this line, ignoring character "'" msg = msg & Margin & Mid(theList.List(i), 2) & vbCrLf End If Else ' Normal line - just keep appending it to Msg msg = msg + Margin & theList.List(i) & vbCrLf End If theList.Selected(i) = False ' Clear highlight of selected line, ie. deselect it If NumLines > MaxLinesPerPage Then ' Start new page if page already full If PageNo > 1 Then ' Insert page number at the bottom, except for first page msg = msg + vbCrLf & Space$(35) & "Page-" & CStr(PageNo) End If Printer.Print msg ' Output all data of this page Printer.NewPage ' Send new page. NumLines = 0 PageNo = PageNo + 1 msg = Title End If End If Next i End If ' Get here after going thru all lines in the listbox If NumLines > 0 Then ' complete the last page by inserting page number For i = NumLines To MaxLinesPerPage msg = msg & vbCrLf Next i If PageNo > 1 Then msg = msg + vbCrLf & Space$(35) & "Page-" & Str$(PageNo) End If Printer.Print msg ' Output all data of this page End If If HasSome Then Printer.EndDoc ' Initiate the actual Print. Else Beep MsgBox "Nothing to print, try selecting a range of lines first" End If Screen.MousePointer = vbDefault ' Change mousepointer shape back to normal End Sub Ta gọi PrintList để in những Items đã được selected trong Listbox lstNames như sau: Private Sub CmdPrint_Click() PrintList lstHexadecimal, True, "*** EVENT LOG IN HEX ***" End Sub Thêm Horizontal Scrollbar vào Listbox 
  8. Có lẽ bạn để ý thấy cả hai Listboxes lstASCII và lstHexadecimal đều có Horizontal  Scrollbar phía dưới. By default, Listbox không có Horizontal Scrollbar. Muốn tạo ra nó  bạn phải thêm hai câu dưới đây vào một Basic module: Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Global Const LB_SETHORIZONTALEXTENT = &H194 Kế đó trong Sub Form_Load gọi Function SendMessage qua Application  Programming Interface (API) để yêu cầu Listbox cho hiện ra Horizontal Scrollbar. Dim VLong As Long ' make a horizontal scrollbar for both Listboxes VLong = SendMessage(lstAscii.hwnd, LB_SETHORIZONTALEXTENT, lstAscii.Width, ByVal 0) VLong = SendMessage(lstHexadecimal.hwnd, LB_SETHORIZONTALEXTENT, lstHexadecimal.Width, ByVal 0) Bạn có thể download source code của program      Eventlog.zip    để có đầy đủ.    nầy Trong bài tới ta sẽ học thêm các áp dụng còn lại của ListBox. 
Đồng bộ tài khoản