Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples5/ch17/textmsgs.frm

Visual Basic Form | 1997-02-16 | 8.1 KB | 235 lines

VERSION 5.00
Begin VB.Form TextMsgs
   Caption         =   "Text Control Messages Demo"
   ClientHeight    =   4020
   ClientLeft      =   1095
   ClientTop       =   1770
   ClientWidth     =   7365
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4020
   ScaleWidth      =   7365
   Begin VB.VScrollBar VScroll1
      Height          =   1935
      LargeChange     =   5
      Left            =   3360
      Max             =   1
      TabIndex        =   4
      Top             =   1500
      Width           =   315
   End
   Begin VB.TextBox Text1
      Height          =   3015
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "TEXTMSGS.frx":0000
      Top             =   600
      Width           =   3015
   End
   Begin VB.Label LabelShowLine
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Height          =   315
      Left            =   3780
      TabIndex        =   3
      Top             =   2340
      Width           =   3495
   End
   Begin VB.Label LabelLinenum
      Appearance      =   0  'Flat
      ForeColor       =   &H80000008&
      Height          =   315
      Left            =   3780
      TabIndex        =   5
      Top             =   1980
      Width           =   1455
   End
   Begin VB.Label LabelResult
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   4380
      TabIndex        =   2
      Top             =   600
      Width           =   2835
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      Caption         =   "Result:"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   3420
      TabIndex        =   1
      Top             =   600
      Width           =   915
   End
   Begin VB.Menu MenuSetup
      Caption         =   "Setup"
      Begin VB.Menu MenuFillText
         Caption         =   "FillText"
      End
   End
   Begin VB.Menu MenuTests
      Caption         =   "Tests"
      Begin VB.Menu MenuLineCount
         Caption         =   "LineCount"
      End
      Begin VB.Menu MenuFirstVisible
         Caption         =   "FirstVisible"
      End
      Begin VB.Menu MenuSelected
         Caption         =   "Selected"
      End
      Begin VB.Menu MenuLinesVisible
         Caption         =   "LinesVisible"
      End
   End
Attribute VB_Name = "TextMsgs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' copyright
 1997 by Desaware Inc. All Rights Reserved
Private Sub Form_Load()
    ' Initialize the display line command
    UpdateDisplayLine
End Sub
' Determines the number of lines actually visible in the
' text control.
Private Function GetVisibleLines%()
    Dim rc As RECT
    #If Win32 Then
    Dim hDC&
    Dim lfont&, oldfont&
    Dim di&
    #Else
    Dim hDC%
    Dim lfont%, oldfont%
    Dim di%
    #End If
    Dim tm As TEXTMETRIC
    Dim lc&
    ' 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
Private 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
Private 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
Private 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.
Private Sub MenuLinesVisible_Click()
    LabelResult.Caption = Str$(GetVisibleLines()) + " lines visible"
End Sub
' Determine the start and end position of the current selection
Private 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
Private Sub Text1_Change()
   Dim lc&
    ' 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.
Private 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
Private 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