|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Text API Routines SendMessage: Text Range Selection via API |
||
Posted: | Sunday September 13, 1998 | |
Updated: | Monday December 26, 2011 | |
Applies to: | VB4-32, VB5, VB6 | |
Developed with: | VB5, Windows 98 | |
OS restrictions: | None | |
Author: | VBnet - Randy Birch | |
Related: |
SendMessage: Determine the Current Line in a Text Box SendMessage: Determine the Number of Lines in a Text Box SendMessage: Find Text Box Document Size via API SendMessage: Text Selection Methods via API |
|
Prerequisites |
None. |
|
Using the API, it is easy to specify a line range in a textbox for copying to another control or a string. |
BAS Module Code |
None. |
|
Form Code |
Create a simple project like the illustration, with a two multiline textboxes (text1, Text2), two combo's (Combo1, Combo2), a check box (Check1) and a command button (Command1). Add two labels (label1, Label2) to show the selected character range. The frame and other labels are optional. Add the following to the form: |
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Const EM_GETSEL As Long = &HB0 Private Const EM_SETSEL As Long = &HB1 Private Const EM_GETLINECOUNT As Long = &HBA Private Const EM_LINEINDEX As Long = &HBB Private Const EM_LINELENGTH As Long = &HC1 Private Const EM_LINEFROMCHAR As Long = &HC9 Private Const EM_SCROLLCARET As Long = &HB7 Private Const WM_SETREDRAW As Long = &HB Private Sub Form_Load() Dim fno As Integer Dim fname As String Dim cnt As Integer Dim lineCount As Long 'obtain the next free file handle 'from the system fno = FreeFile fname = "test.txt" 'load the file into the textbox Open fname For Input As #fno Text1.Text = Input$(LOF(fno), fno) Close #fno 'get the number of lines in the textbox 'and add the lines to the combos lineCount = SendMessage(Text1.hwnd, _ EM_GETLINECOUNT, 0, ByVal 0&) For cnt = 1 To lineCount Combo1.AddItem cnt Combo2.AddItem cnt Next Combo1.ListIndex = 0 Combo2.ListIndex = 1 Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 End Sub Private Sub Combo1_Click() Dim x As Integer Dim y As Integer x = Val(Combo1.ListIndex) y = Val(Combo2.ListIndex) 'should the start be greater than the end, 'set the end combo to the same value. If x > y Then Combo2.ListIndex = x End If End Sub Private Sub Command1_Click() Dim startLine As Long Dim endLine As Long 'set the start and end lines to 'the combo selections startLine = Val(Combo1.List(Combo1.ListIndex)) endLine = Val(Combo2.List(Combo2.ListIndex)) 'assign the result of the function to Text2 Text2.Text = GetBlockText(Text1, startLine, endLine) End Sub Private Function GetBlockText(ctl As TextBox, _ passedLineStart As Long, _ passedLineEnd As Long) As String 'params----- ' ctl: control to act on (ie Text1 or Form3.Text1). ' This allows the routine to deal with any control ' passed, or (with the API declarations) to be moved ' into a BAS module for general use. ' passedLineStart: first line (1-based) to select. ' Passing <=0 defaults to start. ' passedLineEnd: last line (1-based) to select. ' Passing > linecount defaults to all text. '------------ 'returns----- ' string of selected text 'features/options----- ' - "transparent" mode (Check1) - no visible action to user ' - by returning an assignment of passedLineStart = copyStart ' and passedLineEnd = copyEnd, you can return the character ' positions for use in labels etc. (see "Debug" below) '------------- Dim copyStart As Long Dim copyEnd As Long Dim currLine As Long Dim lineCount As Long Dim success As Long Dim currCursorPos As Long ctl.SetFocus '------------------------------- 'optional: used to start transparent action If Check1.Value = 1 Then currCursorPos = ctl.SelStart Call SendMessage(ctl.hwnd, WM_SETREDRAW, False, ByVal 0&) DoEvents End If '-------------------------------- 'get the number of lines in the textbox lineCount = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, ByVal 0&) 'the control lines are 0-based, but we're making it 'more friendly by allowing 1-based numbers to be passed, 'so subtract 1 from the start number. 'Nothing is subtracted from the end number 'because we want the end line + its contents '(IOW, the specified line -1 + Len(specified line) ) 'to be selected. 'The If statement below takes care of specifying 'a line index larger than the actual number of 'lines available. It is required. passedLineStart = passedLineStart - 1 'proceeding only if there are lines to work with If lineCount > 0 Then 'if the startline greater than 0 If passedLineStart > 0 Then 'get the number of chrs up to the 'end of the desired start line copyStart = SendMessage(ctl.hwnd, _ EM_LINEINDEX, _ passedLineStart, ByVal 0&) Else 'start at the beginning 'of the textbox copyStart = 0 End If 'if the lastline greater than 0 and 'less then the number of lines in the 'control.. If passedLineEnd > 0 And _ passedLineEnd <= lineCount Then '..get the number of chrs up to the 'end of the desired last line copyEnd = SendMessage(ctl.hwnd, _ EM_LINEINDEX, _ passedLineEnd, ByVal 0&) Else 'copy the whole thing copyEnd = Len(ctl) End If 'Set the selection for the returned range. 'This will return -1 if unsuccessful success = SendMessage(ctl.hwnd, _ EM_SETSEL, _ copyStart, _ ByVal copyEnd) If success <> -1 Then 'return the selected text GetBlockText = ctl.SelText End If End If '------------------------------- 'optional: used to end transparent action If Check1.Value = 1 Then ctl.SelStart = currCursorPos Call SendMessage(ctl.hwnd, WM_SETREDRAW, True, ByVal 0&) Else 'scroll the selected item into view Call SendMessage(ctl.hwnd, EM_SCROLLCARET, 0, ByVal 0) End If '-------------------------------- 'debug only Label1.Caption = "start: " & copyStart Label2.Caption = "end: " & copyEnd End Function Private Sub Text1_GotFocus() Command2.Enabled = False End Sub Private Sub Text1_LostFocus() Command2.Enabled = True End Sub |
Comments |
The routine loads a text file from disk .. in my example I
just copied a few paragraphs from a KB article and saved to the project folder. Once the file is in place, run the app. The file should load into Text1. Select a line range from the combo boxes and press Select; the selected range is displayed in Text2. Activating the Hide Action check will perform the same function, but the action (selection and scrolling of the textbox) will be transparent to the user. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |