Ebook Visual basic 6

r where this program's EXE file resides FileName = App.Path ' Make sure FileName ends with a backslash If Right(FileName, 1) "\" Then FileName = FileName & "\" FileName = FileName & "MyList.txt" ' name output text file MyList.txt ' Obtain an available filenumber from the operating system FileNumber = FreeFile ' Open the FileName as an output file , using FileNumber as FileHandle Open FileName For Output As FileNumber ' Now iterate through each item of lstNames For i = 0 To lstNames.ListCount - 1 ' Write the List item to file. Make sure you use symbol # in front of FileNumber Print #FileNumber, lstNames.List(i) Next Close FileNumber ' Close the output file End Sub 88 App là một Object ñặc biệt ñại diện cho chính cái program ñang chạy. Ở ñây ta dùng Property Path ñể biết lúc program ñang chạy thì execute module EXE của nó nằm ở ñâu. Lý do là thường thường ta ñể các files liên hệ cần thiết cho program lẩn quẩn hoặc ngay trong folder của program hay trong một subfolder, chẳng hạn như data, logs, .v.v.. App còn có một số Properties khác cũng rất hữu dụng như PrevInstance, Title, Revision ..v.v. Nếu mới started một program mà thấy App.PrevInstance = True thì lúc bấy giờ cũng có một copy khác của program ñang chạy. Nếu cần ta End program nầy ñể tránh chạy 2 copies của program cùng một lúc. App.Title và App.Revision cho ta tin tức về Title và Revision của program ñang chạy. Ðể viết ra một Text file ta cần phải Open nó trong mode Output và tuyên bố từ rày trở ñi sẽ dùng một con số (FileNumber) ñể ñại diện cái File thay vì dùng chính FileName. Ðể tránh dùng một FileNumber ñã hiện hữu, tốt nhất ta hỏi xin Operating System cung cấp cho mình một con số chưa ai dùng bằng cách gọi Function FreeFile. Con số FileNumber nầy còn ñuợc gọi là FileHandle (Handle là tay cầm). Sau khi ta Close FileNumber con số nầy trở nên FREE và Operating System sẽ có thể dùng nó lại. Do ñó bạn phải tránh gọi FreeFile liên tiếp hai lần, vì OS sẽ cho bạn cùng một con số. Tức là, sau khi gọi FreeFile phải dùng nó ngay bằng cách Open một File rồi mới gọi FreeFile lần kế ñể có một con số khác. Ðể ý cách dùng chữ Input, Output cho files là relative (tương ñối) với vị trí của program (nó nằm trong memory của computer). Do ñó từ trong memory viết ra hard disk thì nói là Output. Ngược lại ñọc từ một Text file nằm trên hard disk vào memory cho program ta thì gọi là Input. Load một Text file vào Listbox Trong bài nầy, thay vì ñánh các Items của Listbox vào Property List của lstNames ta có thể populate (làm ñầy) lstNames bằng cách ñọc các Items từ một Text file. Ta thử thêm một CommandButton tên CmdLoad. Ta sẽ viết code ñể khi User click nút CmdLoad program sẽ mở một Input text file và ñọc từng hàng ñể bỏ vào lstNames: Private Sub CmdLoad_Click() Dim i, FileName, FileNumber, anItem ' Obtain Folder where this program's EXE file resides FileName = App.Path ' Make sure FileName ends with a backslash If Right(FileName, 1) "\" Then FileName = FileName & "\" FileName = FileName & "MyList.txt" ' Obtain an available filenumber from the operating system FileNumber = FreeFile ' Open the FileName as an input file , using FileNumber as FileHandle Open FileName For Input As FileNumber lstNames.Clear ' Clear the Listbox first ' Now read each line until reaching End-Of-File, i.e. no more data Do While NOT EOF(FileNumber) Line Input #FileNumber, anItem ' Read a line from the Text file into variable anItem lstNames.AddItem anItem ' Add this item to the bottom of lstNames Loop Close FileNumber ' Close the input file End Sub 89 Ðể ñọc từ một Text file ta cần phải Open nó trong mode Input. Trước khi populate lstNames ta cần phải delete tất cả mọi items có sẵn bên trong. Ðể thực hiện việc ñó ta dùng method Clear của Listbox. Sau ñó ta dùng method AddItem ñể cho thêm từng hàng vào trong Listbox. By default, nếu ta không nói nhét vào ở chỗ hàng nào thì AddItem nhét Item mới vào dưới chót của Listbox. Nếu muốn nhét hàng mới vào ngay trước item thứ 5 (ListIndex = 4), ta viết: lstNames.AddItem newItemString, 4 ' newItemString contains "Ross Close", for example ' To insert a new Item at the beginning of the Listbox, write: lstNames.AddItem newItemString, 0 Nhớ là mỗi lần bạn Add một Item vào Listbox thì ListCount của Listbox increment by 1. Muốn delete một item từ Listbox ta dùng method RemoveItem, thí dụ như muốn delete item thứ ba (ListIndex=2) của lstNames, ta viết: lstNames.RemoveItem 2 Mỗi lần bạn RemoveItem từ Listbox the ListCount của Listbox decrement by 1. Do ñó nếu bạn dùng cái Test dựa vào ListCount của một ListBox ñể nhảy ra khỏi một Loop thì phải coi chừng tránh làm cho value ListCount thay ñổi trong Loop vì AddItem hay RemoveItem. Ta ñọc từng hàng của một Text file bằng cách dùng Line Input #FileNumber. Khi ñọc ñến cuối File, system dẽ cho ta value EOF(FileNumber) = True. Ta dùng value ấy ñể cho program nhảy ra khỏi While.. Loop. Câu Do While NOT EOF(FileNumber) có nghĩa Trong khi chưa ñến End-Of-File của Text File ñại diện bởi FileNumber thì ñọc từ hàng và bỏ vào Listbox. Giống như "Trong khi chưa trả hết nợ nhà vợ thì phải tiếp tục ở rể". Drag-Drop Ta ñã học qua Click Event của Listbox. Bây giờ ñể dùng Drag-Drop cho Listbox bạn hãy ñặt 2 Labels mới lên Form. Cái thứ nhất tên gì cũng ñược nhưng có Caption là Room A. Hãy gọi Label thứ hai là lblRoom và cho Property BorderStyle của nó bằng Fixed Single. Kế ñến select cả hai Labels (Click a Label then hold down key Ctrl while clicking the second Label) rồi click copy và paste lên Form. VB6 sẽ cho bạn Array của hai lblRoom labels. Ðể cho lstNames một DragIcon, bạn click lstNames, click Property DragIcon ñể pop-up một dialog cho bạn chọn một dragdrop icon từ folder C:\Program Files\Microsoft Visual Studio\Common\Graphics\Icons\Dragdrop, chẳng hạn như DRAG2PG.ICO: Ta sẽ dùng Event MouseDown của lstNames ñể pop-up DragIcon hình 2 trang giấy cho User Drag nó qua bên phải rồi bỏ xuống lên một trong hai lblRoom. Khi DragIcon rơi lên lblRoom, lblRoom sẽ generate Event DragDrop. Ta sẽ dùng Event DragDrop nầy ñể assign property Text của Source (tức là lstNames, cái control từ nó phát xuất Drag action) vào Property Caption của lblRoom. Lưu ý vì ở 90 ñây ta dùng cùng một tên cho cả hai lblRoom nên chỉ cần viết code ở một chỗ ñể handle Event DragDrop. Private Sub lstNames_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Start Pop-up DragIcon and start Drag action lstNames.Drag End Sub Private Sub lblRoom_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single) ' Assign Property Text of Source (i.e. lstNames) to Label's Caption lblRoom(Index).Caption = Source.Text End Sub Kết quả sau khi Drag hai tên từ Listbox qua Labels là như sau: Dùng Property Sorted Trong thí dụ trên ta có thể quyết ñịnh vị trí của một Item mới khi ta nhét nó vào Listbox. Ðôi khi ta muốn các Items của Listbox ñược tự ñộng sắp theo thứ tự Alphabet. Bạn có thể set Property Sorted = True ñể thực hiện chuyện nầy. Có một giới hạn là bạn phải cho Property Sorted một value (True hay False) trong lúc design, chớ trong khi chạy program bạn không thể làm cho Property Sorted của Listbox thay ñổi. Giả dụ ta muốn sort các Items của một Listbox khi cần. Vậy thì ta làm sao? Giải pháp rất ñơn giản. Bạn tạo một Listbox tên lstTemp chẳng hạn. Cho nó Property Visible= False (ñể không ai thấy nó) và Property Sorted=True. Khi cần sort lstNames chẳng hạn, ta copy content của lstNames bỏ vào lstTemp, ñoạn Clear lstNames rồi copy content (ñã ñược sorted) của lstTemp trở lại lstNames. Lưu ý là ta có thể AddItem vào một Listbox với Property Sorted=True, nhưng không thể xác ñịnh nhét Item vào trước hàng nào, vì vị trí của các Items do Listbox quyết ñịnh khi nó sort các Items. Ta hãy cho thêm vào Form một CommandButton mới tên CmdSort và viết code cho Event Click của nó như sau: Private Sub CmdSort_Click() Dim i lstTemp.Clear ' Clear temporary Listbox ' Iterate though every item of lstNames For i = 0 To lstNames.ListCount - 1 91 ' Add the lstNames item to lstTemp lstTemp.AddItem lstNames.List(i) Next lstNames.Clear ' Clear lstNames ' Iterate though every item of lstTemp For i = 0 To lstTemp.ListCount - 1 ' Add the lstTemp item to lstNames lstNames.AddItem lstTemp.List(i) Next lstTemp.Clear ' Tidy up - clear temporary Listbox End Sub Nhân tiện, ta muốn có option ñể sort các tên theo FirstName hay Surname. Việc nầy hơi rắc rối hơn một chút, nhưng nguyên tắc vẫn là dùng cái sorted Listbox vô hình tên lstTemp. Bạn hãy ñặt lên phía trên lstName hai cál Labels mới tên lblFirstName và lblSurName và cho chúng Caption "FirstName" và "SurName". Từ ñây ta Load file "MyList.txt" vào lstNames bằng cách Click button CmdLoad chớ không Edit Property List của lstNames ñể enter Items lúc design nữa. Ngoài ra ta dùng dấu phẩy (,) ñể tách FirstName khỏi SurName trong mỗi tên chứa trong file MyList.txt. Content của file MyList.txt bây giờ trở thành như sau: Peter,Jones Kevin,White Sue,Rose John,Smith Trevor,Kennedy Alan,Wright Ron,Bruno Ta sẽ sửa code trong Sub CmdLoad_Click lại ñể khi nhét tên vào lstNames, FirstName và SurName mỗi thứ chiếm 10 characters. Ðể các chữ trong Items của lstNames sắp hàng ngay ngắn ta ñổi Font của lstNames ra Courier New. Courier New là một loại Font mà chiều ngang của chữ m bằng chữ i, trong khi hầu hết các Fonts khác như Arial, Times Roman ..v.v. là Proportional Spacing, có nghĩa là chữ m rộng hơn chữ i. Listing mới của Sub CmdLoad_Click trở thành như sau: Private Sub CmdLoad_Click() Dim i, Pos Dim FileName, FileNumber, anItem Dim sFirstName As String * 10 ' fixed length string of 10 characters Dim sSurName As String * 10 ' fixed length string of 10 characters ' Obtain Folder where this program's EXE file resides FileName = App.Path ' Make sure FileName ends with a backslash If Right(FileName, 1) "\" Then FileName = FileName & "\" FileName = FileName & "MyList.txt" ' Obtain an available filenumber from the operating system 92 FileNumber = FreeFile ' Open the FileName as an input file , using FileNumber as FileHandle Open FileName For Input As FileNumber lstNames.Clear ' Clear the Listbox first ' Now read each line until reaching End-Of-File, i.e. no more data Do While Not EOF(FileNumber) Line Input #FileNumber, anItem ' Read a line from the Text file ' Now separate FirstName from SurName Pos = InStr(anItem, ",") ' Locate the comma "," ' The part before "," is FirstName sFirstName = Left(anItem, Pos - 1) sFirstName = Trim(sFirstName) ' Trim off any unwanted blank spaces ' The part after "," is SurName sSurName = Mid(anItem, Pos + 1) sSurName = Trim(sSurName) ' Trim off any unwanted blank spaces lstNames.AddItem sFirstName & sSurName ' Add this item to the bottom of lstNames Loop Close FileNumber ' Close the input file End Sub Vì FirstName nằm ở bên trái của mỗi Item nên sort theo FirstName cũng giống như sort cả Item. Việc ấy ta ñã làm bằng Sub CmdSort_Click rồi, do ñó khi User click Label lblFirstName ta chỉ cần gọi CmdSort_Click như sau: Private Sub lblFirstName_Click() CmdSort_Click End Sub Ðể sort theo SurName ta cần phải tạm thời ñể SurName qua bên trái của Item trước khi bỏ vào lstTemp. Ta thực hiện chuyện nầy bằng cách hoán chuyển vị trí của FirstName và SurName trong Item trước khi bỏ vào lstTemp. Sau ñó, khi copy các Items từ lstTemp ñể bỏ vô lại lstNames ta lại nhớ hoán chuyển FirstName và SurName ñể chúng nằm ñúng lại vị trí. Tức là, cái mánh của ta là muốn biết Item nào phải nằm ở ñâu trong lstNames, chớ dĩ nhiên khi display mỗi Item ñều có FisrtName bên trái. Code ñể sort tên theo SurName cũng giống như CmdSort_Add nhưng thêm thắt chút ít như sau: Private Sub lblSurName_Click() Dim i, anItem Dim sFirstName As String * 10 ' fixed length string of 10 characters Dim sSurName As String * 10 ' fixed length string of 10 characters lstTemp.Clear ' Clear temporary Listbox ' Iterate though every item of lstNames For i = 0 To lstNames.ListCount - 1 anItem = lstNames.List(i) ' Identify FistName and SurName sFirstName = Left(anItem, 10) 93 sSurName = Mid(anItem, 11) ' Swap FirstName/SurName positions before adding to lstTemp lstTemp.AddItem sSurName & sFirstName Next lstNames.Clear ' Clear lstNames ' Iterate though every item of lstTemp For i = 0 To lstTemp.ListCount - 1 anItem = lstTemp.List(i) ' Identify FistName and SurName sSurName = Left(anItem, 10) ' SurName now is on the left sFirstName = Mid(anItem, 11) ' Add FirstName/SurName in correct positions to lstNames lstNames.AddItem sFirstName & sSurName Next lstTemp.Clear ' Tidy up - clear temporary Listbox End Sub Các Items trong lstNames sorted theo SurName hiện ra như sau: Nhân tiện ñây ta sửa cái Sub CmdSave_Click lại một chút ñể Save Items theo sorted order mới nếu cần: Private Sub CmdSave_Click() Dim i, FileName, FileNumber, anItem ' Obtain Folder where this program's EXE file resides FileName = App.Path ' Make sure FileName ends with a backslash If Right(FileName, 1) "\" Then FileName = FileName & "\" ' Call Output filename "MyList.txt" FileName = FileName & "MyList.txt" ' Obtain an available filenumber from the operating system FileNumber = FreeFile ' Open the FileName as an output file , using FileNumber as FileHandle 94 Open FileName For Output As FileNumber ' Now iterate through each item of lstNames For i = 0 To lstNames.ListCount - 1 anItem = lstNames.List(i) anItem = Trim(Left(anItem, 10)) & "," & Trim(Mid(anItem, 11)) ' Write the List item to file. Make sure you use symbol # in front of FileNumber Print #FileNumber, anItem Next Close FileNumber ' Close the output file End Sub Trong bài tới ta sẽ học thêm các áp dụng khác của ListBox. 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: 95 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: 96 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. 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 <= (lstNames.ListCount - 1) If lstNames.Selected(i) = True Then lstNames.RemoveItem i ' No need to increment i here because the item below is pushed up Else i = i + 1 ' increment i to process the next item End If Loop End Sub 97 Dùng Listbox ñể display Event Log Trong thí dụ sau ñây ta muốn display input từ một serial COM port (Ðể ñọc data thật qua serial COM port ta phải dùng control MsCOMM có hình telephone màu vàng trong ToolBox). Nhưng ñể tiện việc biểu diển, thay vì ñọc một message từ một serial COM port, ta sẽ emulate nó bằng cách dùng một ComboBox. Khi user select một hàng từ ComboBox cboInput thì ta xem cboInput.text như data ñọc từ serial COM port. Lập tức lúc ấy ta sẽ display input message trong hai dạng: ASCII và HEX. Mỗi hàng input message ñược prefix với ngày và giờ trước khi ñược cho vào hai Listboxes lstASCII và lstHexadecimal. Hình dưới ñây cho thấy Form ñang display trong ASCII mode. Nếu bạn click button Display in HEX thì caption của button ñổi thành Display in ASCII, lstASCII trở nên vô hình và lstHexadecimal sẽ hiện ra như sau: 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 98 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 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 99 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. 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 100 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