Article ID: 140886
Article Last Modified on 7/1/2004
("API") and ("text") and ("box") and ("manipulate")
Control Property Setting -------------------------------------------------------- Text box TabIndex 0 (zero, or first in tab order) Text box MultiLine True Label AutoSize True Label Name aGetLineCount
' Enter the following Declare statement on one, single line:
#If Win32 Then
Private Declare Function SendMessageAsLong Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageAsString Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
Dim Buffer As String
Dim resizing As Integer
Const EM_GETLINE = 196
Const EM_GETLINECOUNT = 186
#Else
Private Declare Function SendMessage% Lib "user" _
(ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam As Any)
Dim Buffer As String
Dim resizing As Integer
Const EM_GETLINE = &H400 + 20
Const EM_GETLINECOUNT = &H400 + 10
#End If
Const MAX_CHAR_PER_LINE = 80 ' Scale this to size of text box.
Private Sub Form_Load ()
' Size form relative to screen dimensions.
' Could define all in move command but recursive definition causes
' extra paints.
form1.width = screen.width * .8
form1.height = screen.height * .6
form1.Move screen.width\2-form1.width\2, _
screen.height\2-form1.height\2
End Sub
Private Sub Form_Resize ()
resizing = -1 ' Global flag for fGetLineCount function call.
' Dynamically scale and position the controls in the form.
' This code also is executed on first show of form.
Text1.Move 0, 0, form1.width, form1.height \ 2
Text1.SelStart = Text1.SelStart
command1.Move form1.width\2-command1.width\2, _
form1.height-form1.height\4
aGetLineCount.Move form1.width \ 2 - command1.width \ 2, _
Text1.height
X% = fGetLineCount() ' Update to reflect change in text-box size.
resizing = 0
End Sub
Private Sub Command1_Click ()
'* Pop up an inputbox$ to allow user to specify which line
'* in the text box to print or print all lines.
'* Also check bounds so that a valid line number is printed.
OK = 0 ' Zero the Do Loop flag.
NL$ = Chr$(13) + Chr$(10)
prompt$ = "Which line would you like to print?"
prompt1$ = prompt$ + NL$ + "Enter -1 for all"
prompt2$ = "Too many lines" + NL$ + "Try again!" + NL$ + prompt1$
prompt$ = prompt1$
Do
response$ = InputBox$(prompt$, "Printing", "-1")
If response$ = "" Then Exit Sub ' If user hits cancel,
' then exit.
If Val(response$) > fGetLineCount&() Then
prompt$ = prompt2$
Else
OK = -1 ' Line chosen is in valid range, so exit DO.
End If
Loop Until OK
If Val(response$) = -1 Then ' Print all lines...
ndx& = fGetLineCount&()
For N& = 1 To ndx&
Buffer = fGetLine(N& - 1)
printer.Print Buffer ' ...or print to the screen.
Next N&
Else ' Print a line...
Buffer = fGetLine(Val(response$) - 1)
printer.Print Buffer ' ...or print to the screen.
End If
printer.enddoc
End Sub
Private Function fGetLine$(LineNumber As Long)
' This function fills the buffer with a line of text
' specified by LineNumber from the text-box control.
' The first line starts at zero.
byteLo% = MAX_CHAR_PER_LINE And (255) '[changed 5/15/92]
byteHi% = Int(MAX_CHAR_PER_LINE / 256) '[changed 5/15/92]
Buffer$ = Chr$(byteLo%) + Chr$(byteHi%) + Space$( _
MAX_CHAR_PER_LINE - 2)
#If Win32 Then
x = SendMessageAsString(Text1.hWnd, EM_GETLINE, LineNumber, Buffer$)
#Else
x = SendMessage(Text1.hWnd, EM_GETLINE, LineNumber, Buffer$)
#End If
fGetLine$ = Left$(Buffer$, x)
End Function
Private Function fGetLineCount&()
' This function will return the number of lines
' currently in the text-box control.
' Setfocus method illegal while in resize event,
' so use global flag to see if called from there
' (or use setfocus before this function call in general case).
#If Win32 Then
lcount = SendMessageAsLong(Text1.hWnd, EM_GETLINECOUNT, 0, 0)
#Else
lcount = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0&, 0&)
#End If
aGetLineCount.Caption = "GetLineCount = " + Str$(lcount)
fGetLineCount& = lcount
End Function
Private Sub Text1_Change ()
X% = fGetLineCount() '* Update label to reflect current line
End Sub
Additional query words: textbox
Keywords: kbhowto kbwndw KB140886