Eagles Nest BBS 6/Eagles_Nest_Mac_Collection_Disc_6.TOAST/Windows/VisBasAPIex/VBAPIGUIDE.image/TEXTMSGS.FRM

Text File | 1994-01-19 | 7KB | 255 lines

VERSION 2.00
Begin Form TextMsgs
   Caption         =   "Text Control Messages Demo"
   Height          =   4710
   Left            =   1035
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4020
   ScaleWidth      =   7365
   Top             =   1140
   Width           =   7485
   Begin VScrollBar VScroll1
      Height          =   1935
      LargeChange     =   5
      Left            =   3360
      Max             =   1
      TabIndex        =   4
      Top             =   1500
      Width           =   315
   End
   Begin TextBox Text1
      Height          =   3015
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "Text control example"
      Top             =   600
      Width           =   3015
   End
   Begin Label LabelShowLine
      BorderStyle     =   1  'Fixed Single
      Height          =   315
      Left            =   3780
      TabIndex        =   3
      Top             =   2340
      Width           =   3495
   End
   Begin Label LabelLinenum
      Height          =   315
      Left            =   3780
      TabIndex        =   5
      Top             =   1980
      Width           =   1455
   End
   Begin Label LabelResult
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   4380
      TabIndex        =   2
      Top             =   600
      Width           =   2835
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Result:"
      Height          =   255
      Left            =   3420
      TabIndex        =   1
      Top             =   600
      Width           =   915
   End
   Begin Menu MenuSetup
      Caption         =   "Setup"
      Begin Menu MenuFillText
         Caption         =   "FillText"
      End
   End
   Begin Menu MenuTests
      Caption         =   "Tests"
      Begin Menu MenuLineCount
         Caption         =   "LineCount"
      End
      Begin Menu MenuFirstVisible
         Caption         =   "FirstVisible"
      End
      Begin Menu MenuSelected
         Caption         =   "Selected"
      End
      Begin Menu MenuLinesVisible
         Caption         =   "LinesVisible"
      End
   End
End

Sub Form_Load ()
    ' Initialize the display line command
    UpdateDisplayLine
End Sub

'
' Determines the number of lines actually visible in the
' text control.
'
'
Function GetVisibleLines% ()
    Dim rc As Rect
    Dim hdc%
    Dim lfont%, oldfont%
    Dim tm As TEXTMETRIC
    Dim di%

    ' Get the formatting rectangle - this describes the
    ' rectangle in the control in which text is placed.
    lc% = SendMessage(Text1.hWnd, EM_GETRECT, 0, rc)

    ' Get a handle to the logical font used by the control.
    ' The VB font properties are accurately reflected by
    ' this logical font.
    lfont% = SendMessageBynum(Text1.hWnd, WM_GETFONT, 0, 0&)

    ' Get a device context to the text control.
    hdc% = GetDC(Text1.hWnd)

    ' Select in the logical font to obtain the exact font
    ' metrics.
    If lfont% <> 0 Then oldfont% = SelectObject(hdc%, lfont%)

    di% = GetTextMetrics(hdc%, tm)
    ' Select out the logical font
    If lfont% <> 0 Then lfont% = SelectObject(hdc%, oldfont%)

    ' The lines depends on the formatting rectangle and font height
    GetVisibleLines% = (rc.bottom - rc.top) / tm.tmHeight

    ' Release the device context when done.
    di% = ReleaseDC(Text1.hWnd, hdc%)
End Function

' Fill the text control with 20 lines of text
'
Sub MenuFillText_Click ()
    Dim x%
    Dim t$
    For x% = 0 To 19
        t$ = t$ + "This is line" + Str$(x%) + Chr$(13) + Chr$(10)
    Next x%
    Text1.Text = t$

End Sub

'
' Determine the number of the first line visible in the text control
'
Sub MenuFirstVisible_Click ()
    Dim lc%
    lc% = SendMessageBynum(Text1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0&)
    LabelResult.Caption = "Line" + Str$(lc%) + " at top"

End Sub

'
' Determine the number of lines of text in the text control
'
Sub MenuLineCount_Click ()
    Dim lc%
    lc% = SendMessageBynum(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
    LabelResult.Caption = Str$(lc%) + " lines"
End Sub

'
' Determine the number of visibile lines in the text control.
'
Sub MenuLinesVisible_Click ()
    LabelResult.Caption = Str$(GetVisibleLines()) + " lines visible"
End Sub

'
' Determine the start and end position of the current selection
'
Sub MenuSelected_Click ()
    Dim ls&
    ls& = SendMessageBynum&(Text1.hWnd, EM_GETSEL, 0, 0&)

    LabelResult.Caption = "Chars" + Str$(CInt(ls& And &HFFFF&)) + " to" + Str$(CInt(ls& / &H10000))


End Sub

'
' Update the display line information on change
'
Sub Text1_Change ()
    ' Make sure the vertical scroll range matches the number
    ' of lines in the text control
    lc% = SendMessageBynum(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
    VScroll1.Max = lc% - 1
    UpdateDisplayLine

End Sub

' This function updates the line displayed based on the
' current position of the scroll bar.
'
Sub UpdateDisplayLine ()
    Dim linetoshow%, linelength%
    Dim linebuf$
    Dim lc%
    Dim linechar%

    linetoshow% = VScroll1.Value
    ' Show the number of the line being displayed
    LabelLinenum.Caption = "Line" + Str$(linetoshow%)

    ' Find out the character offset to the first character
    ' in the specified line
    linechar% = SendMessageBynum(Text1.hWnd, EM_LINEINDEX, linetoshow%, 0&)

    ' The character offset is used to determine the length of the line
    ' containing that character.
    lc% = SendMessageBynum(Text1.hWnd, EM_LINELENGTH, linechar%, 0&) + 1

    ' Now allocate a string long enough to hold the result
    linebuf$ = String$(lc% + 2, 0)
    Mid$(linebuf$, 1, 1) = Chr$(lc% And &HFF)
    Mid$(linebuf$, 2, 1) = Chr$(lc% \ &H100)

    ' Now get the line
    lc% = SendMessageByString(Text1.hWnd, EM_GETLINE, linetoshow%, linebuf$)
    LabelShowLine.Caption = Left$(linebuf$, lc%)

End Sub

' Whenever the scroll bar changes, display the requested
' line in the LabelShowLine label box
'
Sub VScroll1_Change ()
    Dim lc%
    Dim dl&
    Dim firstvisible%, lastvisible%

    ' Make sure value is in range
    lc% = SendMessageBynum(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
    If VScroll1.Value > lc% - 1 Then
        VScroll1.Value = lc% - 1
        Exit Sub
    End If
    UpdateDisplayLine ' Update the display


    ' Get the number of the first and last visible line
    firstvisible% = SendMessageBynum(Text1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0&)
    lastvisible% = GetVisibleLines%() + firstvisible% - 1

    ' Scroll it into view if necessary
    If (VScroll1.Value < firstvisible%) Then
        dl& = SendMessageBynum(Text1.hWnd, EM_LINESCROLL, 0, CLng(VScroll1.Value - firstvisible%))
    End If
    If (VScroll1.Value > lastvisible%) Then
        dl& = SendMessageBynum(Text1.hWnd, EM_LINESCROLL, 0, CLng(VScroll1.Value - lastvisible%))
    End If


End Sub