Готовые решения и полезные коды на Visual Basic .NET (Часть-2)

Function GetRSSFeedTable(URL As String) As DataTable
        Dim rssFeed As HttpWebRequest = DirectCast(WebRequest.Create(URL), HttpWebRequest)
        Dim response = rssFeed.GetResponse()
        Dim rssStream = response.GetResponseStream()
 
        Dim rssDoc As New XmlDocument()
        rssDoc.Load(rssStream)
        Dim rssItems As XmlNodeList = rssDoc.SelectNodes("rss/channel/item")
        Dim i As Integer = 0
        Dim dt As DataTable = New DataTable("table")
        dt.Columns.Add("title", Type.GetType("System.String"))
        dt.Columns.Add("link", Type.GetType("System.String"))
 
        While i < rssItems.Count
            Dim node As XmlNode = rssItems.Item(i).SelectSingleNode("title")
            Dim title As String
            Dim link As String
            If node IsNot Nothing Then
                title = node.InnerText
            Else
                title = ""
            End If
 
            node = rssItems.Item(i).SelectSingleNode("link")
            If node IsNot Nothing Then
                link = node.InnerText
            Else
                link = ""
            End If
            Dim dr As DataRow = dt.NewRow()
            dr("title") = title
            dr("link") = link
 
            dt.Rows.Add(dr)
 
            i += 1
        End While
 
        Return dt
    End Function

Imports System.ComponentModel
Imports System.Drawing.Design
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Windows.Forms.Design
 
Public Class ColorEditorEx
    Inherits ColorEditor
 
    Public Overrides Function EditValue(ByVal context As ITypeDescriptorContext, ByVal provider As IServiceProvider, ByVal value As Object) As Object
        If (provider IsNot Nothing) Then
            Dim edSvc As IWindowsFormsEditorService = DirectCast(provider.GetService(GetType(IWindowsFormsEditorService)), IWindowsFormsEditorService)
            If (edSvc IsNot Nothing) Then
                _colorUI = If(_colorUI, New ColorUIWrapper(Me))
                _colorUI.Start(edSvc, value)
                edSvc.DropDownControl(_colorUI.Control)
                _colorUI.SetColor()
                If ((_colorUI.Value <> Nothing) AndAlso (_colorUI.Value <> Color.Empty)) Then
                    value = _colorUI.Value
                End If
                _colorUI.End()
            End If
        End If
        Return value
    End Function
 
    Public Overrides Sub PaintValue(ByVal e As PaintValueEventArgs)
        If TypeOf e.Value Is Color Then
            Dim _color As Color = DirectCast(e.Value, Color)
            If (_color.A < 255) Then
                Dim _Width As Integer = (e.Bounds.Right - e.Bounds.Left) - 2
                Dim _Top As Integer = e.Bounds.Top + 1
                Dim _Bottom As Integer = e.Bounds.Bottom - 1
                Dim _mid As Integer = (_Width \ 3)
                If (_mid * 3) <> _Width Then
                    _mid += 1
                End If
                If _color.IsEmpty Then
                    Using _pen As New Pen(Color.FromArgb(-14145496), 1.0!)
                        e.Graphics.FillRectangle(_pen.Brush, e.Bounds)
                        _pen.Color = Color.Red
                        e.Graphics.DrawLine(_pen, (_mid - 2), _Top, ((_mid * 3) - 1), (_Bottom - 1))
                        e.Graphics.DrawLine(_pen, ((_mid * 3) - 1), _Top, (_mid - 2), (_Bottom - 1))
                    End Using
                Else
                    Using _pen As New Pen(Color.WhiteSmoke, CSng(_mid))
                        e.Graphics.DrawLine(_pen, (_mid - 1), _Top, (_mid - 1), _Bottom)
                        _pen.Color = Color.FromArgb(-14145496) ' Color.FromArgb(255, 40, 40, 40)
                        e.Graphics.DrawLine(_pen, ((_mid * 3) - 1), _Top, ((_mid * 3) - 1), _Bottom)
                        _pen.Color = Color.DarkGray
                        e.Graphics.DrawLine(_pen, ((_mid * 2) - 1), _Top, ((_mid * 2) - 1), _Bottom)
                    End Using
                End If
            End If
            Using _pen As New Pen(_color)
                e.Graphics.FillRectangle(_pen.Brush, e.Bounds)
            End Using
        End If
    End Sub
 
    Private _colorUI As ColorUIWrapper
 
    Private Class ColorUIWrapper
        Inherits Control
 
        Public Sub New(ByVal colorEditor As ColorEditorEx)
            Dim constructor As ConstructorInfo = GetType(ColorEditor).GetNestedType("ColorUI", BindingFlags.NonPublic).GetConstructor({GetType(ColorEditor)})
            _param = New Object() {colorEditor}
            _control = DirectCast(constructor.Invoke(_param), Control)
            Dim _panel As New Panel With {
                .BackColor = SystemColors.Control,
                .Dock = DockStyle.Left,
                .Width = 28
            }
            _control.Controls.Add(_panel)
            _tbAlpha = New TrackBar With {
                .Orientation = Orientation.Vertical,
                .TickStyle = TickStyle.None,
                .Dock = DockStyle.Fill,
                .Maximum = 255,
                .Minimum = 0
            }
            _panel.Controls.Add(_tbAlpha)
            _lblAlpha = New Label With {
                .Text = "0",
                .TextAlign = ContentAlignment.MiddleCenter,
                .Height = 15,
                .Dock = DockStyle.Bottom
            }
            _panel.Controls.Add(_lblAlpha)
 
            _tabCtrl = DirectCast(_control.Controls.Item(0), TabControl)
            _pallet = _tabCtrl.TabPages.Item(0).Controls.Item(0)
            _lbCom = DirectCast(_tabCtrl.TabPages.Item(1).Controls.Item(0), ListBox)
            _lbSys = DirectCast(_tabCtrl.TabPages.Item(2).Controls.Item(0), ListBox)
 
            _pallet.Width += (_panel.Width + 4)
            BHeight = (_pallet.Height - 1)
            'Метод который задаёт или снимает флаг выделения у элемента в ListBox
            _setSelMethodInfo = GetType(ListBox.SelectedObjectCollection).GetMethod("SetSelected", (BindingFlags.NonPublic Or BindingFlags.Instance))
 
            'Методы, поля и свойства от "ColorUI" в System.Drawing.Design.ColorEditor
            _edSvcFieldInfo = _control.GetType.GetField("edSvc", (BindingFlags.NonPublic Or BindingFlags.Instance))
            _SysColorPropertyInfo = _control.GetType.GetProperty("SystemColorValues", (BindingFlags.NonPublic Or BindingFlags.Instance))
            _ComColorPropertyInfo = _control.GetType.GetProperty("ColorValues", (BindingFlags.NonPublic Or BindingFlags.Instance))
 
            'Методы, поля и свойства от "ColorPalette" в System.Drawing.Design.ColorEditor
            _selColorFieldInfo = _pallet.GetType.GetField("selectedColor", (BindingFlags.NonPublic Or BindingFlags.Instance))
            _focusFieldInfo = _pallet.GetType.GetField("focus", (BindingFlags.NonPublic Or BindingFlags.Instance))
            _statColFieldInfo = _pallet.GetType.GetField("staticColors", (BindingFlags.NonPublic Or BindingFlags.Instance))
            _custumColPropertyInfo = _pallet.GetType.GetProperty("CustomColors")
            _selColPropertyInfo = _pallet.GetType.GetProperty("SelectedColor")
 
            AddHandler _pallet.LostFocus, New EventHandler(AddressOf OnPalletLostFocus)
            AddHandler _tbAlpha.ValueChanged, New EventHandler(AddressOf OnTrackBarAlphaValueChanged)
 
            _bufColor = New Color
            _value = _bufColor
            _PreAlpha = -1
        End Sub
 
        Private Sub OnPalletLostFocus(ByVal sender As Object, ByVal e As EventArgs)
            If _tbAlpha.Focused Then
                Dim _focus As Point = DirectCast(_focusFieldInfo.GetValue(_pallet), Point)
                Dim index As Integer = -1
                If (_focus.X <> -1) AndAlso (_focus.Y <> -1) Then
                    index = _focus.X + (8 * _focus.Y)
                End If
                If (index < 48) Then '48 - кол-во элементов в "_statColFieldInfo"
                    _bufColor = DirectCast(_statColFieldInfo.GetValue(_pallet), Color())(index)
                Else
                    _bufColor = DirectCast(_custumColPropertyInfo.GetValue(_pallet, BindingFlags.Default, Nothing, Nothing, Nothing), Color())(((index - 64) + 16))
                End If
                _selColPropertyInfo.SetValue(_pallet, _bufColor, BindingFlags.Default, Nothing, Nothing, Nothing)
            End If
        End Sub
 
        Private Sub OnTrackBarAlphaValueChanged(ByVal sender As Object, ByVal e As EventArgs)
            _lblAlpha.Text = _tbAlpha.Value.ToString
        End Sub
 
        Private Sub FindColor(_Arraycolor As Object(), _list As ListBox, ByRef _end As Boolean, _GRB As Integer)
            Dim int As Integer = 0
            If _value.IsNamedColor Then
                Do While (int < _Arraycolor.Length)
                    If _value = DirectCast(_Arraycolor(int), Color) Then
                        _end = True
                        Exit Do
                    End If
                    int += 1
                Loop
            Else
                Do While (int < _Arraycolor.Length)
                    If _GRB = DirectCast(_Arraycolor(int), Color).ToArgb Then
                        _end = True
                        Exit Do
                    End If
                    int += 1
                Loop
            End If
            If _end Then
                _bufColor = DirectCast(_Arraycolor(int), Color)
                _param = New Object() {int, True}
                'Задаём флаг выделения в ListBox
                _setSelMethodInfo.Invoke(_list.SelectedItems, _param)
                'Выделяем обьект в ListBox
                SendMessage(_list.Handle, LB_SETCURSEL, int, 0)
                'Делаем выбранный элемент видимым в поле списка ListBox
                'SendMessage(_list.Handle, LB_SETTOPINDEX, int, 0)
            End If
        End Sub
 
        Public Sub Start(ByVal service As IWindowsFormsEditorService, ByVal value As Object)
            _edSvcFieldInfo.SetValue(_control, service, BindingFlags.Default, Type.DefaultBinder, Nothing)
            _value = DirectCast(value, Color)
            AdjustColorUIHeight()
            If (value IsNot Nothing) Then
                _PreAlpha = _value.A
                _tbAlpha.Value = _PreAlpha
                _bufColor = Color.FromArgb(255, _value)
 
                Dim SelTabPage As Integer = 0
                Dim colGRB As Integer = _bufColor.ToArgb
                Dim flag As Boolean = False
                Dim index As Integer = 0
 
                'Найти и выделить цвет в ListBox и _pallet
                If (_PreAlpha = 0) Then
                    If colGRB = (-16777216) Then '-16777216 = Color.Black.ToArgb
                        _bufColor = Color.Empty
                    Else
                        _bufColor = Color.Transparent
                        _param = New Object() {0, True}
                        _setSelMethodInfo.Invoke(_lbCom.SelectedItems, _param)
                        SendMessage(_lbCom.Handle, LB_SETCURSEL, 0, 0)
                        SelTabPage = 1
                    End If
                Else
                    _param = DirectCast(_ComColorPropertyInfo.GetValue(_control, BindingFlags.Default, Nothing, Nothing, Nothing), Object())
                    FindColor(_param, _lbCom, flag, colGRB)
                    If flag Then
                        SelTabPage = 1
                    Else
                        _param = DirectCast(_SysColorPropertyInfo.GetValue(_control, BindingFlags.Default, Nothing, Nothing, Nothing), Object())
                        FindColor(_param, _lbSys, flag, colGRB)
                        If flag Then
                            SelTabPage = 2
                        End If
                    End If
                    flag = False
                    Dim _color As Color() = DirectCast(_statColFieldInfo.GetValue(_pallet), Color())
                    Do While (index < 48) '48 - кол-во элементов в "_statColFieldInfo"
                        If _color(index) = _bufColor Then
                            _focusFieldInfo.SetValue(_pallet, New Point((index Mod 8), (index \ 8)), BindingFlags.Default, Type.DefaultBinder, Nothing)
                            flag = True
                            Exit Do
                        End If
                        index += 1
                    Loop
                End If
 
                DirectCast(_custumColPropertyInfo.GetValue(_pallet, BindingFlags.Default, Nothing, Nothing, Nothing), Color())(0) = _bufColor
                _selColorFieldInfo.SetValue(_pallet, _bufColor, BindingFlags.Default, Type.DefaultBinder, Nothing)
                If Not flag Then
                    _focusFieldInfo.SetValue(_pallet, New Point(0, 6), BindingFlags.Default, Type.DefaultBinder, Nothing)
                End If
                'Выбрать вкладку
                If CInt(SendMessage(_tabCtrl.Handle, TCM_GETCURSEL, 0, 0)) <> SelTabPage Then
                    SendMessage(_tabCtrl.Handle, TCM_SETCURSEL, SelTabPage, 0)
                End If
            End If
        End Sub
 
        Private Sub AdjustColorUIHeight()
            If (_pallet.Height <> (BHeight + 3)) Then
                If _pallet.Height > BHeight Then
                    _pallet.Height = BHeight
                Else
                    _pallet.Height = (BHeight + 3)
                End If
            End If
        End Sub
 
        Public Sub [End]()
            _param = Nothing
            _bufColor = New Color
            _value = _bufColor
            _edSvcFieldInfo.SetValue(_control, Nothing, BindingFlags.Default, Type.DefaultBinder, Nothing)
        End Sub
 
        Friend Sub SetColor()
            Dim _Alpha As Integer = _tbAlpha.Value
            Dim selectedItem As Object = Nothing
            Select Case _tabCtrl.SelectedIndex
                Case 0
                    selectedItem = _selColPropertyInfo.GetValue(_pallet, BindingFlags.Default, Nothing, Nothing, Nothing)
                Case 1
                    selectedItem = _lbCom.SelectedItem
                Case 2
                    selectedItem = _lbSys.SelectedItem
            End Select
            Dim TempColor As Color = If(selectedItem Is Nothing, _bufColor, DirectCast(selectedItem, Color))
            'Проверка: изменился ли цвет, или значение альфаканала
            If (_Alpha <> _PreAlpha) OrElse (TempColor <> _bufColor) Then
                If (TempColor = Color.Transparent) AndAlso (TempColor <> _bufColor) Then
                    _Alpha = 0
                End If
                If _Alpha = 0 Then
                    _value = If(_bufColor.IsEmpty OrElse (_bufColor = Color.Transparent), TempColor, Color.Transparent)
                Else
                    _value = If(_Alpha = 255, TempColor, Color.FromArgb(_Alpha, TempColor))
                End If
            End If
            'Снять выделение в ListBox
            If _lbCom.SelectedIndices.Count > 0 Then
                _param = New Object() {_lbCom.SelectedIndices(0), False}
                _setSelMethodInfo.Invoke(_lbCom.SelectedItems, _param)
                SendMessage(_lbCom.Handle, LB_SETCURSEL, -1, 0)
            End If
            If _lbSys.SelectedIndices.Count > 0 Then
                _param = New Object() {_lbSys.SelectedIndices(0), False}
                _setSelMethodInfo.Invoke(_lbSys.SelectedItems, _param)
                SendMessage(_lbSys.Handle, LB_SETCURSEL, -1, 0)
            End If
        End Sub
 
        Public ReadOnly Property Control As Control
            Get
                Return _control
            End Get
        End Property
 
        Public ReadOnly Property Value As Color
            Get
                Return _value
            End Get
        End Property
 
        <DllImport("user32.dll", CharSet:=CharSet.Auto)>
        Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
        End Function
 
        ' Fields
        Private Const LB_GETTOPINDEX As Integer = &H18E
        Private Const LB_SETTOPINDEX As Integer = &H197
        Private Const TCM_GETCURSEL As Integer = &H130B
        Private Const TCM_SETCURSEL As Integer = &H130C
        Private Const LB_SETCURSEL As Integer = &H186
        Private ReadOnly BHeight As Integer
        Private _pallet As Control
        Private _lbCom As ListBox
        Private _lbSys As ListBox
        Private _control As Control
        Private _tabCtrl As TabControl
        Private _tbAlpha As TrackBar
        Private _lblAlpha As Label
        Private _setSelMethodInfo As MethodInfo
        Private _selColorFieldInfo As FieldInfo
        Private _edSvcFieldInfo As FieldInfo
        Private _focusFieldInfo As FieldInfo
        Private _statColFieldInfo As FieldInfo
        Private _SysColorPropertyInfo As PropertyInfo
        Private _ComColorPropertyInfo As PropertyInfo
        Private _selColPropertyInfo As PropertyInfo
        Private _custumColPropertyInfo As PropertyInfo
        Private _PreAlpha As Integer
        Private _param As Object()
        Private _bufColor As Color
        Private _value As Color
    End Class
End Class

Imports System.ComponentModel
Imports System.Globalization
''' <summary>
''' <see cref="TextBox"/>, который умеет вычислять арифметические выражения при вводе знака "="
''' </summary>
Public Class ComputableTextbox
    Inherits TextBox
 
#Region " Поля и свойства "
    ''' <summary>
    ''' Таблица <see cref="DataTable"/>, которая делает всю магию вычислений.
    ''' </summary>
    Private Shared ReadOnly dt As New DataTable()
    Private _LastEquation As String
    Private _LastResult As Double
    Private _format As String
    ''' <summary>
    ''' Формат вывода ответа. Как для обычных чисел
    ''' </summary>
    Public Property Format() As String
        Get
            Return _format
        End Get
        Set(ByVal value As String)
            _format = value
            If Not String.IsNullOrEmpty(LastEquation) Then
                SetResult()
            End If
        End Set
    End Property
    ''' <summary>
    ''' Последнее вычисленное выражение
    ''' </summary>
    <Browsable(False)>
    Public ReadOnly Property LastEquation() As String
        Get
            Return _LastEquation
        End Get
    End Property
 
    ''' <summary>
    ''' Последний вычисленный результат
    ''' </summary>
    <Browsable(False)>
    Public ReadOnly Property LastResult As Double
        Get
            Return _LastResult
        End Get
    End Property
    ''' <summary>
    ''' Полное выражение с ответом
    ''' </summary>
    <Browsable(False)>
    Public ReadOnly Property FullEquation As String
        Get
            Dim sep = IIf(_LastEquation.Contains(","), ",", ".")
            Dim ci = New CultureInfo(CultureInfo.CurrentUICulture.LCID)
            ci.NumberFormat.NumberDecimalSeparator = sep
            ci.NumberFormat.CurrencyDecimalSeparator = sep
            If Not String.IsNullOrEmpty(Format) Then
                Return LastEquation & "=" & LastResult.ToString(Format, ci)
            End If
            Return LastEquation & "=" & LastResult.ToString(ci)
        End Get
    End Property
#End Region
 
    Public Sub New()
        MyBase.New()
        Multiline = False
    End Sub
 
#Region " Переопределённые методы и свойства "
 
    Public Overrides Property Multiline As Boolean
        Get
            Return False
        End Get
        Set(value As Boolean)
            MyBase.Multiline = False
        End Set
    End Property
 
Protected Overrides Sub OnKeyUp(e As KeyEventArgs)
    MyBase.OnKeyUp(e)
    If e.KeyCode = Keys.Oemplus AndAlso Not e.Shift Then
        ComputeExpression()
    End If
End Sub
#End Region
    ''' <summary>
    ''' Метод, выполнящий вычисления и обновляющий значения свойств
    ''' </summary>
    Private Sub ComputeExpression()
        Dim exp = Text.Substring(0, Text.Length - 1)
        Dim val As Object
        Dim dotExpr As String
        Try
            dotExpr = exp.Replace(","c, ".")
            val = dt.Compute(dotExpr, String.Empty)
        Catch ex As Exception
            Throw ex
        End Try
        _LastEquation = IIf(exp = dotExpr, dotExpr, exp)
        _LastResult = Convert.ToDouble(val)
        SetResult()
        SelectionStart = Text.Length
    End Sub
 
    Private Sub SetResult()
        Text = FullEquation
    End Sub
End Class

Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Drawing.Printing
 
'класс RichTextBoxE (использование msftedit.dll + печать выборочных страниц)
Public Class RichTextBoxE
    
    'наследование класса RichTextBox
    Inherits RichTextBox
 
    'использование msftedit.dll вместо riched20.dll
    Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" ( dllName As String) As IntPtr
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim baseParams As CreateParams = MyBase.CreateParams
            'загрузить библиотеку из системной папки
            If LoadLibrary(System.IO.Path.Combine(Environment.SystemDirectory, "msftedit.dll")) <> System.IntPtr.Zero Then baseParams.ClassName = "RICHEDIT50W"
            Return baseParams
        End Get
    End Property
 
    'печать через RichTextBox
    ' Convert the unit that is used by the .NET framework (1/100 inch) 
    ' and the unit that is used by Win32 API calls (twips 1/1440 inch)
    Private Const AnInch As Single = 14.4
    <StructLayout(LayoutKind.Sequential)>
    Private Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure
   
    <StructLayout(LayoutKind.Sequential)>
    Private Structure CHARRANGE
        Public cpMin As Integer          ' First character of range (0 for start of doc)
        Public cpMax As Integer          ' Last character of range (-1 for end of doc)
    End Structure
 
    <StructLayout(LayoutKind.Sequential)>
    Private Structure FORMATRANGE
        Public hdc As IntPtr             ' Actual DC to draw on
        Public hdcTarget As IntPtr       ' Target DC for determining text formatting
        Public rc As RECT                ' Region of the DC to draw to (in twips)
        Public rcPage As RECT            ' Region of the whole DC (page size) (in twips)
        Public chrg As CHARRANGE         ' Range of text to draw (see above declaration)
    End Structure
 
    Private Const WM_USER As Integer = &H400
    Private Const EM_FORMATRANGE As Integer = WM_USER + 57
    Private Declare Function SendMessageIntPtr Lib "USER32" Alias "SendMessageA" ( hWnd As IntPtr,  Msg As Integer,  wParam As IntPtr,  lParam As IntPtr) As IntPtr
    Public Function Print( charFrom As Integer,  charTo As Integer,  e As PrintPageEventArgs, Optional  PageToPrintMode As Integer = 1) As Integer
 
        ' Mark starting and ending character 
        Dim cRange As CHARRANGE
        cRange.cpMin = charFrom
        cRange.cpMax = charTo
 
        ' Calculate the area to render and print
        Dim rectToPrint As RECT
        rectToPrint.Top = CInt(e.MarginBounds.Top * AnInch)
        rectToPrint.Bottom = CInt(e.MarginBounds.Bottom * AnInch)
        rectToPrint.Left = CInt(e.MarginBounds.Left * AnInch)
        rectToPrint.Right = CInt(e.MarginBounds.Right * AnInch)
 
        ' Calculate the size of the page
        Dim rectPage As RECT
        rectPage.Top = CInt(e.PageBounds.Top * AnInch)
        rectPage.Bottom = CInt(e.PageBounds.Bottom * AnInch)
        rectPage.Left = CInt(e.PageBounds.Left * AnInch)
        rectPage.Right = CInt(e.PageBounds.Right * AnInch)
 
        Dim hdc As IntPtr = e.Graphics.GetHdc()
        Dim fmtRange As FORMATRANGE
        fmtRange.chrg = cRange                 ' Indicate character from to character to 
        fmtRange.hdc = hdc                     ' Use the same DC for measuring and rendering
        fmtRange.hdcTarget = hdc              ' Point at printer hDC
        fmtRange.rc = rectToPrint              ' Indicate the area on page to print
        fmtRange.rcPage = rectPage             ' Indicate whole size of page
 
        'Dim res As IntPtr = IntPtr.Zero
 
        'PageToPrintMode 'Режим печати текущей страницы: 0 - измерить и не печатать; 1 - измерить и печатать;
        Dim wParam As New IntPtr(PageToPrintMode)
 
        ' Move the pointer to the FORMATRANGE structure in memory
        Dim lParam As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(fmtRange))
        Marshal.StructureToPtr(fmtRange, lParam, False)
 
        ' Send the rendered data for printing
        Dim res As IntPtr = SendMessageIntPtr(Handle, EM_FORMATRANGE, wParam, lParam)
 
        ' Free the block of memory allocated
        Marshal.FreeCoTaskMem(lParam)
 
        ' Release the device context handle obtained by a previous call
        e.Graphics.ReleaseHdc(hdc)
 
        ' Return last + 1 character printer
        Return res.ToInt32()
 
    End Function
 
End Class

Friend TempRichTextBoxResult As New RichTextBoxE 'создаем новый экземпляр RichTextBoxE
 
    'рассчитать массив начальных позиций печатаемого текста каждой страницы
    Public PageMarginBoundsCInch As Rectangle 'область печати страницы с учетом полей в 0.01 дюйма
    Public CharToPrintCurPosPages() As Integer 'массив начальных позиций печатаемого текста каждой страницы
    Friend Sub CalcCharToPrintCurPosPages() 'рассчитать массив начальных позиций печатаемого текста каждой страницы
 
        'обработка исключения - если ошибка обращения к принтеру - пропустить печать
        Try
            'по умолчанию всегда есть одна страница
            ReDim CharToPrintCurPosPages(0 To 1) 'массив начальных позиций печатаемого текста каждой страницы
            CharToPrintCurPosPages(0) = 1 'номер текущей страницы (на которой расположен курсор)
            CharToPrintCurPosPages(1) = 0 'начальная позиция печатаемого текста первой страницы
 
            If TempRichTextBoxResult.TextLength = 0 Then Exit Sub 'если текста нет - выходим
 
            'получить поверхность устройства печати
            Dim g As Graphics 'поверхность устройства печати
            'если есть установленные принтеры и текущий принтер действительный
            If InstalledPrintersCount > 0 Then
                g = PrintDocumentMain.DefaultPageSettings.PrinterSettings.CreateMeasurementGraphics(PrintDocumentMain.DefaultPageSettings)
            Else 'если нет установленных принтеров или текущий принтер недействительный
                g = Me.CreateGraphics()
            End If
 
            'данные для события печати страницы
            Dim e As New PrintPageEventArgs(g, PageMarginBoundsCInch, PrintDocumentMain.DefaultPageSettings.Bounds, PrintDocumentMain.DefaultPageSettings)
 
            Dim PageToPrintCurNumber As Integer = 0 'номер печатаемой страницы
            Dim CharToPrintCurPos As Integer = 0 'начальная позиция печатаемого текста
 
            CharToPrintCurPosPages(0) = -1 'номер текущей страницы (на которой расположен курсор)
 
            'рассчитать массив начальных позиций печатаемого текста каждой страницы
            Do
                PageToPrintCurNumber += 1 'номер печатаемой страницы - первая
                ReDim Preserve CharToPrintCurPosPages(0 To PageToPrintCurNumber) 'массив начальных позиций печатаемого текста каждой страницы
                CharToPrintCurPosPages(PageToPrintCurNumber) = CharToPrintCurPos 'начальная позиция печатаемого текста текущей страницы
                CharToPrintCurPos = TempRichTextBoxResult.Print(CharToPrintCurPos, TempRichTextBoxResult.TextLength, e, 0) 'первый символ следующей страницы
                'определить номер текущей страницы (на которой расположен курсор)
                If CharToPrintCurPosPages(0) = -1 Then If TempRichTextBoxResult.SelectionStart < CharToPrintCurPos Then CharToPrintCurPosPages(0) = PageToPrintCurNumber 'номер текущей страницы
                'System.Windows.Forms.Application.DoEvents() 'пауза для обработки других задач
            Loop While CharToPrintCurPos < TempRichTextBoxResult.TextLength 'пока не превышена длина текста
 
            'особые случаи для номера текущей страницы (на которой расположен курсор)
            If TempRichTextBoxResult.SelectionStart = 0 Then CharToPrintCurPosPages(0) = 1 'номер текущей страницы 
            If TempRichTextBoxResult.SelectionStart = TempRichTextBoxResult.TextLength Then CharToPrintCurPosPages(0) = CharToPrintCurPosPages.Length - 1 'номер текущей страницы 
            If CharToPrintCurPosPages(0) = -1 Then CharToPrintCurPosPages(0) = 1 'все другие случаи для номера текущей страницы (на которой расположен курсор)
 
            g.Dispose() 'освободить ресурсы
 
        Catch ex As Exception
        End Try
 
    End Sub
 
    'печатать результаты расчета на принтер по умолчанию
    'AddHandler() PrintDocumentMain.PrintPage - 'печатать результаты расчета на принтер по умолчанию
    Private Sub PrintDocumentMain_PrintPage_Default(sender As Object, e As Printing.PrintPageEventArgs) 'Handles PrintDocumentMain.PrintPage
 
       TempRichTextBoxResult.Print(CharToPrintCurPosPages(PageToPrintCurNumber), TempRichTextBoxResult.TextLength, e, 1) 'печать содержимого одной страницы
        PageToPrintCurNumber += 1
        e.HasMorePages = (PageToPrintCurNumber <> CharToPrintCurPosPages.Length)
    End Sub
 
    'печатать диапазон страниц
    'AddHandler() PrintDocumentMain.PrintPage - 'печатать диапазон страниц
    Private Sub PrintDocumentMain_PrintPage_SomePages(sender As Object, e As Printing.PrintPageEventArgs) 'Handles PrintDocumentMain.PrintPage
 
        If PrintDocumentMain.PrinterSettings.PrintRange <> PrintRange.Selection Then HeaderFooterPrint(e) 'печать колонтитулов
 
        TempRichTextBoxResult.Print(CharToPrintCurPosPages(PageToPrintCurNumber), TempRichTextBoxResult.TextLength, e, 1) 'печать содержимого одной страницы
        e.HasMorePages = (PageToPrintCurNumber <> FormPrint.ToPages(SamePagesToPrintCurIndex))
        PageToPrintCurNumber += FormPrint.StepPages(SamePagesToPrintCurIndex) 'перейти на следующую страницу
 
        'если выбрано условие - разбирать по копиям
        If FormPrint.CheckBoxPrintCopiesCollate.Checked = True Then
 
            'если текущая страница - последняя
            If e.HasMorePages = False Then
                'если индекс печатаемого диапазона страниц не равен индексу последнего диапазона
                If SamePagesToPrintCurIndex <> FormPrint.ToPages.Length - 1 Then
                    'если распечатана последняя выбранная страница
                    SamePagesToPrintCurIndex += 1 'индекс печатаемого диапазона страниц
                    PageToPrintCurNumber = FormPrint.FromPages(SamePagesToPrintCurIndex) 'вернуться на первую страницу диапазона
                    e.HasMorePages = True 'есть нераспечатанные страницы новой копии документа
                End If
            End If
 
            'если текущая страница - последняя
            If e.HasMorePages = False Then
                'если необходимое количество копий документа - не распечатано 
                If DocumentToPrintCopiesNumber < FormPrint.PrintCopies Then
                    SamePagesToPrintCurIndex = 0 'индекс печатаемого диапазона страниц
                    PageToPrintCurNumber = FormPrint.FromPages(SamePagesToPrintCurIndex) 'вернуться на первую страницу диапазона
                    DocumentToPrintCopiesNumber += 1 'распечатана еще 1 копия документа
                    e.HasMorePages = True
                End If
            End If
 
        Else 'если выбрано условие - не разбирать по копиям
 
            'если необходимое количество копий документа - не распечатано 
            If DocumentToPrintCopiesNumber < FormPrint.PrintCopies Then
 
                PageToPrintCurNumber -= FormPrint.StepPages(SamePagesToPrintCurIndex) 'вернуться на предыдущую страницу
                DocumentToPrintCopiesNumber += 1 'распечатана еще 1 копия документа
                e.HasMorePages = True 'есть нераспечатанные страницы новой копии документа
 
            Else 'если необходимое количество копий документа - распечатано 
 
               DocumentToPrintCopiesNumber = 1 'номер печатаемой копии документа
                'если текущая страница - последняя
                If e.HasMorePages = False Then
                    'если индекс печатаемого диапазона страниц не равен индексу последнего диапазона
                    If SamePagesToPrintCurIndex <> FormPrint.ToPages.Length - 1 Then
                        SamePagesToPrintCurIndex += 1 'индекс печатаемого диапазона страниц
                        PageToPrintCurNumber = FormPrint.FromPages(SamePagesToPrintCurIndex) 'вернуться на первую страницу диапазона
                        e.HasMorePages = True 'есть нераспечатанные страницы новой копии документа
                    End If
                End If
            End If
        End If
    End Sub

'просмотр выбранной страницы для печати
    Private Sub PrintPreviewPage( PageNumber As Integer) 'просмотр выбранной страницы для печати
        '---------------------------------------------------------------------
        FlagUserClick = False 'флаг нажатия пользователем кнопки
        '---------------------------------------------------------------------
        'проверить и установить номер выбранной страницы для просмотра
        If PageNumber < 1 Then PageNumber = 1 'нижний предел
        If PageNumber > FormMain.CharToPrintCurPosPages.Length - 1 Then PageNumber = FormMain.CharToPrintCurPosPages.Length - 1 'верхний предел
        FormMain.PageToPrintCurNumber = PageNumber 'номер страницы для просмотра
        '---------------------------------------------------------------------
        'установить контролер печати - для просмотра
        Dim OldPrintController As PrintController = FormMain.PrintDocumentMain.PrintController 'запомнить старый контроллер печати
        Dim NewPreviewPrintController As New PreviewPrintController() 'новый контроллер печати - для просмотра
        FormMain.PrintDocumentMain.PrintController = NewPreviewPrintController 'присвоить новый контроллер печати - для просмотра
        '---------------------------------------------------------------------
        'получить изображение выбранной страницы
        '---------------------------------------------------------------------
        Try
            FormMain.PrintDocumentMain.Print() 'печать выбранной страницы
            Dim PagesPreviewPageInfo As PreviewPageInfo() = NewPreviewPrintController.GetPreviewPageInfo() 'получить коллекцию изображений страниц для печати
            PanelPage.BackgroundImage = PagesPreviewPageInfo(0).Image 'вывести изображение страницы для печати
        Catch ex As Exception
            'показываем окно сообщения об ошибке
            FormMessage.ShowMessage("Не удается получить параметры принтера " & Chr(34) & FormMain.PrintDocumentMain.PrinterSettings.PrinterName & Chr(34) & "." & vbCrLf & "Описание ошибки: " & ex.Message, My.Application.Info.Title, MessageBoxButtons.OK, MessageBoxIcon.Error,,,,, Me)
        End Try
        '---------------------------------------------------------------------
        'If PagesPreviewPageInfo.Length > 0 Then
        ComboBoxPageNumber.Text = PageNumber.ToString 'номер страницы, выбранной для просмотра - этот вариант быстрее других
        'ComboBoxPageNumber.SelectedItem = PageNumber.ToString 'номер страницы, выбранной для просмотра
        'ComboBoxPageNumber.SelectedIndex = PageNumber - 1 'номер страницы, выбранной для просмотра
        GroupBoxPrintPreview.Text = "Страница " & PageNumber & " из " & FormMain.CharToPrintCurPosPages.Length - 1
        'End If
        '---------------------------------------------------------------------
        'вернуть старый контроллер печати
        FormMain.PrintDocumentMain.PrintController = OldPrintController 'вернуть старый контроллер печати
        '---------------------------------------------------------------------
        FlagUserClick = True 'флаг нажатия пользователем кнопки
        '---------------------------------------------------------------------
    End Sub

'создание курсора - стрелка направо
        Dim TempBitmap As Bitmap = CType(FormSettings.PictureBoxCursorLeftHand.Image, Bitmap)
        LabelPageLeft.Cursor = New Cursor(TempBitmap.GetHicon)
        LabelLeft.Cursor = LabelPageLeft.Cursor
                'установка системных размеров для полос прокрутки
        VSResult.Width = SystemInformation.VerticalScrollBarWidth
        HSResult.Height = SystemInformation.HorizontalScrollBarHeight
        'количество строк, прокручиваемых при вращении колесика мыши
        MouseWheelSLines = SystemInformation.MouseWheelScrollLines

'получить и установить позицию VScrollBar и HScrollBar 
    Private Const WM_USER As Integer = &H400
    Private Const EM_GETSCROLLPOS As Integer = WM_USER + 221 'получить позицию VScrollBar и HScrollBar 
    Private Const EM_SETSCROLLPOS As Integer = WM_USER + 222 'установить позицию VScrollBar и HScrollBar
    Private Declare Function SendMessagePointB Lib "user32.dll" Alias "SendMessageA" (hWnd As IntPtr, msg As Integer, wParam As Integer, ByRef lParam As Point) As Boolean
 
    'AddHandler RichTextBoxResult.VScroll
    Private Sub RichTextBoxResult_VScroll(sender As Object, e As EventArgs)
        SetVSPosition() 'установить позицию полосы прокрутки
    End Sub
 
    Private Sub SetVSPosition() 'установить позицию полосы прокрутки
        If VSResult.Enabled = False Then Exit Sub 'если полоса прокрутки не доступна - выходим
        Dim VSValue As Integer = VSResult.Value 'текущая позиция прокрутки
        'определить текущую позицию полосы прокрутки
        Dim SPos As Point
        If SendMessagePointB(RichTextBoxResult.Handle, EM_GETSCROLLPOS, 0, SPos) = True Then VSValue = SPos.Y
        FitValueToIntervalInteger(VSValue, 0, VSResult.Maximum - VSResult.LargeChange) 'подогнать число Integer в заданный интервал значений
        VSResult.Value = VSValue 'текущая позиция прокрутки
    End Sub
 
    'текстовое окно РР - вертикальная прокрутка колесиком мыши
    'AddHandler RichTextBoxResult.MouseWheel
    Private Sub RichTextBoxResult_MouseWheel(sender As Object, e As MouseEventArgs)
        'для всех режимов представления текстового окна
        If My.Computer.Keyboard.CtrlKeyDown = True Then Exit Sub 'если нажата клавиша Ctrl - выходим
        If My.Computer.Keyboard.ShiftKeyDown = True Then Exit Sub 'если нажата клавиша Shift - выходим
        If VSResult.Enabled = False Then Exit Sub 'если полоса прокрутки не доступна - выходим
        Dim NewValue As Integer = VSResult.Value - Math.Sign(e.Delta) * MouseWheelSLines * VSResult.SmallChange
        FitValueToIntervalInteger(NewValue, 0, VSResult.Maximum - VSResult.LargeChange) 'подогнать число Integer в заданный интервал значений
        RTBVScroll(NewValue) 'прокрутить текстовое окно
    End Sub
 
    'текстовое окно РР - горизонтальная прокрутка
    'получить позицию курсора
    Private Declare Function GetCaretPos Lib "user32.dll" Alias "GetCaretPos" (ByRef lpPoint As Point) As Boolean
    Private Function GetCursorPos() As Point 'получить позицию курсора
        'получить позицию курсора
        Dim CPos As Point
        If GetCaretPos(CPos) = True Then GetCursorPos = CPos Else GetCursorPos = Point.Empty
    End Function
 
    'горизонтальный скроллинг панели результатов
    'AddHandler RichTextBoxResult.SelectionChanged
    Private Sub RichTextBoxResult_SelectionChanged(sender As Object, e As EventArgs)
        SetEnabledEditOperation() 'определить доступ к операциям правки 
        PanelResult_HScroll() 'горизонтальный скроллинг панели результатов
    End Sub
 
    Private Sub PanelResult_HScroll() 'горизонтальный скроллинг панели результатов
        If My.Settings.ResultMode <> 0 Then Exit Sub 'если режим переноса текста окна РР - не 0 в пределах страницы - выходим
        If My.Settings.ResultTextScaleMode = 1 Then Exit Sub 'если режим масштаба окна РР - 1 по ширине страницы - выходим 
        If HSResult.Enabled = False Then Exit Sub 'если полоса прокрутки не доступна - выходим
        'определить позицию курсора по которой выполнять горизонтальную прокрутку
        Dim CurPosX As Integer = GetCursorPos().X
        'установить положение левой границы панели страницы
        Dim PanelPageResultLeft As Integer = PanelPageResult.Left
        Select Case CurPosX
                'выравнивание по правой границе текста
            Case Is > PanelResult.Width - VSResult.Width - PanelPageResultLeft - RichTextBoxResult.Left - RichTextBoxResult.Top * 2
                PanelPageResultLeft = PanelResult.Width - VSResult.Width - RichTextBoxResult.Left - CurPosX - MouseWheelSLines * HSResult.SmallChange
                If CurPosX >= PanelPageResult.Width + PanelPageResultGap - HSResult.LargeChange Then PanelPageResultLeft = PanelResult.Width - VSResult.Width - PanelPageResult.Width - PanelPageResultGap
                'выравнивание по левой границе текста
            Case Is < -PanelPageResultLeft - RichTextBoxResult.Left
                PanelPageResultLeft = -RichTextBoxResult.Left - CurPosX + MouseWheelSLines * HSResult.SmallChange
                If CurPosX <= HSResult.LargeChange Then PanelPageResultLeft = RichTextBoxResult.Top * 2 - CInt(My.Settings.ResultTextScale / 100 * ResultPageMarginLeftPixel)
        End Select
        PanelPageResult.Left = PanelPageResultLeft
        LabelLeft.Width = PanelPageResultLeft
        SetHSPosition() 'установить позицию полосы прокрутки
    End Sub
 
    'текстовое окно РР - горизонтальная прокрутка
    'AddHandler RichTextBoxResult.HScroll
    Private Sub RichTextBoxResult_HScroll(sender As Object, e As EventArgs)
        SetHSPosition() 'установить позицию полосы прокрутки
    End Sub
 
    Private Sub SetHSPosition() 'установить позицию полосы прокрутки
        If HSResult.Enabled = False Then Exit Sub 'если полоса прокрутки не доступна - выходим
        Dim HSValue As Integer = HSResult.Value 'текущая позиция прокрутки
        'режим представления текстового окна
        Select Case My.Settings.ResultMode
            Case 0 'перенос слов в пределах страницы
                HSValue = PanelPageResultGap - PanelPageResult.Left
            'Case 1 'перенос слов в пределах окна
            Case 2 'без переноса слов
                'определить текущую позицию полосы прокрутки
                Dim SPos As Point
                If SendMessagePointB(RichTextBoxResult.Handle, EM_GETSCROLLPOS, 0, SPos) = True Then HSValue = SPos.X
        End Select
        FitValueToIntervalInteger(HSValue, 0, HSResult.Maximum - HSResult.LargeChange) 'подогнать число Integer в заданный интервал значений
        HSResult.Value = HSValue 'текущая позиция прокрутки
    End Sub
 
    'текстовое окно РР - изменение размеров содержащегося текста
    Dim VSMax As Integer 'максимальное значение вертикальной полосы прокрутки
    Dim HSMax As Integer 'максимальное значение горизонтальной полосы прокрутки
    'Изменение масштаба текстового окна РР
    'AddHandler RichTextBoxResult.ContentsResized
    Private Sub RichTextBoxResult_ContentsResized(sender As Object, e As ContentsResizedEventArgs)
        'если нажата клавиша Ctrl
        If My.Computer.Keyboard.CtrlKeyDown = True Then
            'если масштаб текстового окна изменился
            Dim TextScale As Integer = CInt(Me.RichTextBoxResult.ZoomFactor * 100)
            Select Case TextScale
                Case Is > My.Settings.ResultTextScale
                    SetScaleResultUp() 'увеличить на +10%
                Case Is < My.Settings.ResultTextScale
                    SetScaleResultDown() 'уменьшить на -10%
            End Select
        End If
        'вертикальная полоса прокрутки
        'обновить максимальное значение полосы прокрутки
        VSMax = e.NewRectangle.Height
        If VSMax < 0 Then VSMax = 0
 
        'горизонтальная полоса прокрутки
        'если режим переноса текста в окне РР - без переноса
        If My.Settings.ResultMode = 2 Then
            'обновить максимальное значение полосы прокрутки
            HSMax = e.NewRectangle.Width
            If HSMax < 0 Then HSMax = 0
        End If
        UpdateRTBResult() 'обновить параметры текстового окна
    End Sub
 
    'вертикальная полоса прокрутки - прокрутка
    Private Sub VSResult_Scroll(sender As Object, e As ScrollEventArgs) Handles VSResult.Scroll
        RTBVScroll(e.NewValue) 'прокрутить текстовое окно
    End Sub
 
    Private Sub RTBVScroll(NewValue As Long) 'прокрутить текстовое окно
        'определить текущую позицию полосы прокрутки
        Dim SPos As Point = Point.Empty
        SendMessagePointB(RichTextBoxResult.Handle, EM_GETSCROLLPOS, 0, SPos)
        'установить новую позицию полосы прокрутки
        SPos.Y = CInt(NewValue)
        SendMessagePointB(RichTextBoxResult.Handle, EM_SETSCROLLPOS, 0, SPos)
    End Sub
 
    'горизонтальная полоса прокрутки - прокрутка
    Private Sub HSResult_Scroll(sender As Object, e As ScrollEventArgs) Handles HSResult.Scroll
        RTBHScroll(e.NewValue) 'прокрутить текстовое окно
    End Sub
    Private Sub RTBHScroll(NewValue As Long) 'прокрутить текстовое окно
        'режим представления текстового окна
        Select Case My.Settings.ResultMode
            Case 0 'перенос слов в пределах страницы
                'проверить крайнее горизонтальное положение панели страницы
                Dim PanelPageResultLeft As Integer = CInt(PanelPageResultGap - NewValue)
                Dim PanelPageResultLeftMax As Integer = PanelResult.Width - VSResult.Width - PanelPageResult.Width - PanelPageResultGap
                If PanelPageResultLeft < PanelPageResultLeftMax Then PanelPageResultLeft = PanelPageResultLeftMax
                PanelPageResult.Left = PanelPageResultLeft
                LabelLeft.Width = PanelPageResult.Left
                SetHSPosition() 'установить позицию полосы прокрутки - кажется лишним - требует проверки
            'Case 1 'перенос слов в пределах окна
            Case 2 'без переноса слов
                'определить текущую позицию полосы прокрутки
                Dim SPos As Point = Point.Empty
                SendMessagePointB(RichTextBoxResult.Handle, EM_GETSCROLLPOS, 0, SPos)
                'установить новую позицию полосы прокрутки
                SPos.X = CInt(NewValue)
                SendMessagePointB(RichTextBoxResult.Handle, EM_SETSCROLLPOS, 0, SPos)
        End Select
    End Sub

 'координаты границ окна для захвата мыши
    Dim CaptureX1 As Integer
    Dim CaptureY1 As Integer
    Dim CaptureX2 As Integer
    Dim CaptureY2 As Integer
 
    'Мышь над элементом - панель РР
    'PanelResult.MouseEnter
    'LabelLeft.MouseEnter
    'LabelPageLeft.MouseEnter
    'LabelPageTop.MouseEnter
    Private Sub PanelRresult_MouseEnter(sender As Object, e As EventArgs) Handles PanelResult.MouseEnter, LabelLeft.MouseEnter, LabelPageLeft.MouseEnter, LabelPageTop.MouseEnter
        StatusStripInfo.Text = "Редактирование результатов расчета"
        RichTextBoxResult.Capture = True 'захват мыши текстовым окном РР за пределами окна
 
        Select Case True
            Case sender Is PanelResult
                'координаты области захвата мыши
                CaptureX1 = RichTextBoxResult.Width
                CaptureY1 = -RichTextBoxResult.Top
                CaptureX2 = CaptureX1 + PanelResult.Width - PanelPageResult.Right - VSResult.Width
                CaptureY2 = RichTextBoxResult.Height
            Case sender Is LabelLeft, sender Is LabelPageLeft
                'координаты области захвата мыши
                CaptureX1 = -PanelPageResult.Left - RichTextBoxResult.Left
                CaptureY1 = -RichTextBoxResult.Top
                CaptureX2 = 0
                CaptureY2 = RichTextBoxResult.Height
            Case sender Is LabelPageTop
                'координаты области захвата мыши
                CaptureX1 = 0
                CaptureY1 = -RichTextBoxResult.Top
                CaptureX2 = RichTextBoxResult.Width
                CaptureY2 = 0
        End Select
    End Sub
 
    'Мышь над элементом - текстовое окно РР
    'AddHandler RichTextBoxResult.MouseMove
    Private Sub RichTextBoxResult_MouseMove(sender As Object, e As MouseEventArgs)
        StatusStripInfo.Text = "Редактирование результатов расчета"
        'снятие захвата мыши текстовым окном РР за пределами окна
        If RichTextBoxResult.Capture = False Then Exit Sub
        If e.X < CaptureX1 Or e.X > CaptureX2 Or e.Y < CaptureY1 Or e.Y > CaptureY2 Then RichTextBoxResult.Capture = False 'захват мыши текстовым окном РР за пределами окна
    End Sub

 'изменить режим представления текстового окна РР
    Private Sub SetRTBResultMode(Optional FlagVisible As Boolean = False) 'изменить режим представления текстового окна РР
        'скрыть элементы перед изменением режима
        If FlagVisible = True Then
            LabelLeft.Visible = False
            PanelPageResult.Visible = False
        End If
        Dim TextScale As Integer = My.Settings.ResultTextScale
        Select Case My.Settings.ResultMode
            Case 0 'перенос слов в пределах страницы
                PanelResult.BackColor = FormSettings.PictureBox0_01.BackColor 'фон текстового окна результатов расчета
                RichTextBoxResult.RightMargin = ResultPageWidthPixel - ResultPageMarginLeftPixel - ResultPageMarginRightPixel 'ширина страницы без полей
                If RichTextBoxResult.WordWrap = False Then RichTextBoxResult.WordWrap = True
                PanelPageResult.Dock = DockStyle.None
                FormSettings.RadioButtonResultModeWordwrapPage.Checked = True
                MenuStripViewWordwrapPage.Checked = True
                MenuStripViewWordwrapWindow.Checked = False
                MenuStripViewWordwrapNone.Checked = False
            Case 1 'перенос слов в пределах окна
                PanelResult.BackColor = SystemColors.Window 'фон текстового окна результатов расчета
                LabelLeft.Width = 0
                HSResult.Enabled = False 'полоса прокрутки не доступна
                RichTextBoxResult.Left = RichTextBoxResult.Top * 2
                LabelPageLeft.Width = RichTextBoxResult.Left
                RichTextBoxResult.RightMargin = 0
                If RichTextBoxResult.WordWrap = False Then RichTextBoxResult.WordWrap = True
                PanelPageResult.Dock = DockStyle.Fill
                FormSettings.RadioButtonResultModeWordwrapWindow.Checked = True
                MenuStripViewWordwrapPage.Checked = False
                MenuStripViewWordwrapWindow.Checked = True
                MenuStripViewWordwrapNone.Checked = False
            Case 2 'без переноса слов
                PanelResult.BackColor = SystemColors.Window 'фон текстового окна результатов расчета
                LabelLeft.Width = 0
                RichTextBoxResult.Left = RichTextBoxResult.Top * 2
                LabelPageLeft.Width = RichTextBoxResult.Left
                RichTextBoxResult.RightMargin = 0
                If RichTextBoxResult.WordWrap = True Then RichTextBoxResult.WordWrap = False
                PanelPageResult.Dock = DockStyle.Fill
                FormSettings.RadioButtonResultModeWordwrapNone.Checked = True
                MenuStripViewWordwrapPage.Checked = False
                MenuStripViewWordwrapWindow.Checked = False
                MenuStripViewWordwrapNone.Checked = True
        End Select
        SetResultTextScale(TextScale) 'установить масштаб текстового окна РР
        UpdateRTBResult() 'обновить параметры текстового окна
        PanelResult_HScroll() 'горизонтальный скроллинг панели результатов
        'SetRTBResultLeftPosition() 'выровнять левую границу текстового окна
        'показать элементы после изменения режима
        If FlagVisible = True Then
            LabelLeft.Visible = True
            PanelPageResult.Visible = True
        End If
    End Sub
 
    'определить количество физических строк - учитывает WordWrap=True
    Private Function GetRTBLinesCount() As Integer 'определить количество физических строк - учитывает WordWrap=True
        GetRTBLinesCount = RichTextBoxResult.GetLineFromCharIndex(RichTextBoxResult.TextLength) + 1
    End Function
 
    'определить ширину шрифта с учетом масштаба 
    Private Function GetRTBFontSizeZoom() As Integer 'определить ширину шрифта с учетом масштаба 
        GetRTBFontSizeZoom = CInt(RichTextBoxResult.Font.Size * RichTextBoxResult.ZoomFactor)
    End Function
 
 'изменить масштаб текстового окна РР - при нажатии "Ctrl+" и "Ctrl-"
    'AddHandler RichTextBoxResult.KeyDown
    Private Sub RichTextBoxResult_KeyDown(sender As Object, e As KeyEventArgs)
        If e.Control = True And e.Shift = False Then 'нажата клавиша Ctrl
            Select Case e.KeyCode
                Case Keys.Add ', Keys.Oemplus 'нажата клавиша "+"
                    SetScaleResultUp() 'увеличить на +10%
                Case Keys.Subtract ', Keys.OemMinus 'нажата клавиша "-"
                    SetScaleResultDown() 'уменьшить на -10%
            End Select
        End If
    End Sub
 
    'масштаб - увеличить на +10%
    Private Sub SetScaleResultUp() 'увеличить на +10%
        My.Settings.ResultTextScaleMode = 0 'режим масштаба текстового окна - 0 произвольный масштаб
        Dim TextScale As Integer = CInt(Math.Floor((My.Settings.ResultTextScale + 10) / 10) * 10)
        FitValueToIntervalInteger(TextScale, 10, 500) 'подогнать число Integer в заданный интервал значений
        SetResultTextScale(TextScale)
        UpdateRTBResult() 'обновить параметры текстового окна
    End Sub
 
    'масштаб - уменьшить на -10%
    Private Sub SetScaleResultDown() 'уменьшить на -10%
        My.Settings.ResultTextScaleMode = 0 'режим масштаба текстового окна - 0 произвольный масштаб
        Dim TextScale As Integer = CInt(Math.Ceiling((My.Settings.ResultTextScale - 10) / 10) * 10)
        FitValueToIntervalInteger(TextScale, 10, 500) 'подогнать число Integer в заданный интервал значений
        SetResultTextScale(TextScale)
        UpdateRTBResult() 'обновить параметры текстового окна
    End Sub
 
    'панель результатов - вращение колесика мыши - изменение масштаба текстового окна РР
    Private Sub PanelResult_MouseWheel(sender As Object, e As MouseEventArgs) Handles PanelResult.MouseWheel
        If My.Computer.Keyboard.CtrlKeyDown = False Then
            RichTextBoxResult_MouseWheel(sender, e) 'текстовое окно РР - вертикальная прокрутка колесиком мыши
            Exit Sub 'если не нажата клавиша Ctrl - выходим
        End If
        Select Case Math.Sign(e.Delta)
            Case Is > 0
                SetScaleResultUp() 'увеличить на +10%
            Case Is < 0
                SetScaleResultDown() 'уменьшить на -10%
        End Select
    End Sub

Private Sub TextBox1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox1.KeyPress
        KeyPressOnlyDoubleValue(sender, e)
End Sub
 
Private Sub KeyPressOnlyDoubleValue(sender As Object, e As KeyPressEventArgs)
 
'системный десятичный разделитель 
Dim CurrentDecimalSeparator As Char = System.Globalization.CultureInfo.CurrentCulture.NumberFormat.CurrencyDecimalSeparator(0)
 
'элемент, в котором происходит событие
Dim TempTextBox As TextBox = CType(sender, TextBox)
 
'если в тексте был выделен фрагмент - запоминаем текст, в котором удален выделенный фрагмент, чтобы проверить его
Dim TempString As String = TempTextBox.Text.Remove(TempTextBox.SelectionStart, TempTextBox.SelectionLength)
 
        'проверяем вводимый символ
        Select Case Asc(e.KeyChar)
 
            Case 8 'Backspace - ввод разрешен
 
            'Для целых числе запрет ввода 0 с первой позиции
            'Case 48 'цифра "0" - ввод разрешен
            '    'если знак вводится начиная с первой позиции - блокировка ввода
            '    If TempTextBox.SelectionStart = 0 Then e.Handled = True
 
            Case 48 To 57 'все цифры "0123456789" - ввод разрешен
 
            'Разрешить ввод символа Плюс "+"
            'Case 43 'Плюс "+"
            '    'если знак вводится начиная со второй позиции - блокировка ввода
            '    If TempTextBox.SelectionStart <> 0 Then e.Handled = True
            '    'если знак уже вводился - блокировка ввода
            '    If Strings.InStr(TempString, "+") <> 0 Then e.Handled = True
 
            Case 44 'Запятая ","
                'заменяем "," на текущий десятичный разделитель
                e.KeyChar = CurrentDecimalSeparator
                'если знак уже вводился - блокировка ввода
                If Strings.InStr(TempString, CurrentDecimalSeparator) <> 0 Then e.Handled = True
 
            Case 45 'Минус "-"
                'если знак вводится начиная со второй позиции - блокировка ввода
                If TempTextBox.SelectionStart <> 0 Then e.Handled = True
                'если знак уже вводился - блокировка ввода
                If Strings.InStr(TempString, "-") <> 0 Then e.Handled = True
 
            Case 46 'Точка "."
                'заменяем "." на текущий десятичный разделитель
                e.KeyChar = CurrentDecimalSeparator
                'если знак уже вводился - блокировка ввода
                If Strings.InStr(TempString, CurrentDecimalSeparator) <> 0 Then e.Handled = True
 
            Case Else 'в остальных случаях - блокировка ввода
                e.Handled = True
 
        End Select
    End Sub

Private Function CheckTextBoxMinMaxDoubleValue(ByRef TempTextBox As TextBox, MinValue As Double, MaxValue As Double, OldValue As Double, NewIndexLabelMenuChecked As Integer, MessageString As String, Optional TabControlCalcSelectedIndex As Integer = -1, Optional FlagOver As Boolean = False) As Boolean
        '----------------------------------------------------
        Dim TempValue As Double
        'если строку можно преобразовать в Double
        If Double.TryParse(TempTextBox.Text, TempValue) = True Then
 
            Select Case FlagOver 'вариант условия (включать границы интервала или нет)
 
                Case True 'без учета границ
                    'если число задано в пределах допустимого диапазона
                    If TempValue > MinValue And TempValue < MaxValue Then
                        CheckTextBoxMinMaxDoubleValue = True
                        'принять новое значение
                        TempTextBox.Text = TempValue.ToString
                        Exit Function 'выходим
                    End If
 
                Case False 'с учетом границ
 
                    'если число задано в пределах допустимого диапазона
                    If TempValue >= MinValue And TempValue <= MaxValue Then
                        CheckTextBoxMinMaxDoubleValue = True
                        'принять новое значение
                        TempTextBox.Text = TempValue.ToString
                        Exit Function 'выходим
                    End If
 
            End Select
 
        End If
 
        'во всех других случаях - отказ
        CheckTextBoxMinMaxDoubleValue = False
 
        'показываем окно предупреждения
        MessageBox.Show(MessageString, My.Application.Info.Title, MessageBoxButtons.OK, MessageBoxIcon.Warning)
 
        'установить текущее (старое) значение
        TempTextBox.Text = OldValue.ToString
        TempTextBox.Select() 'установить курсор на элемент
 
End Function

Private Sub TextBoxGotFocus(sender As Object, e As EventArgs) 
       'элемент, в котором происходит событие
        Dim TempTextBox As TextBox = CType(sender, TextBox)
        'установить курсор в крайнее правое положение
        TempTextBox.SelectionStart = TempTextBox.TextLength
End Sub

Imports System
Imports System.Drawing
Imports System.ComponentModel
'прорисовка элементов списка и отслеживание расположения мыши над конкретным элементом
Private Sub ComboBox1_DrawItem(sender As Object, e As DrawItemEventArgs) Handles ComboBox1.SelectedIndexChanged
        'если выводится какой-либо элемент списка
        If e.Index <> -1 Then
 
            'текст элемента списка
            Dim TempString As String = ComboBox1.GetItemText(ComboBox1.Items(e.Index))
 
            'если указатель мыши над элементом списка
            If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
                'если список открыт
                If ComboBox1.DroppedDown = True Then
                        'показываем подсказку в заданных координатах относительно списка
                        ToolTip1.Show(TempString, ComboBox1, 0, -ComboBox1.Height)
                End If
            End If
 
            e.DrawBackground() 'прорисовка фона элемента
            'прорисовка текста
            e.Graphics.DrawString(TempString, e.Font, New SolidBrush(e.ForeColor), e.Bounds)
            e.DrawFocusRectangle() 'если элемент находится в фокусе - прорисовка пунктирной рамки
        End If
End Sub
'мышь над элементом - установить всплывающую подсказку для списка
Private Sub ComboBox1_MouseHover(sender As Object, e As EventArgs) Handles ComboBox1.MouseHover
         'если выбран какой-либо элемент списка            
        If ComboBox1.SelectedIndex <> -1 Then
            ToolTip1.SetToolTip(ComboBox1, ComboBox1.GetItemText(ComboBox1.SelectedItem))
        Else 
            ToolTip1.SetToolTip(ComboBox1, "Выбрать элемент списка")
        End If
End Sub 
'скрыть всплывающую подсказку
Private Sub ComboBox1_MouseLeave_DropDownClosed(sender As Object, e As EventArgs) Handles ComboBox1.MouseLeave, ComboBox1.DropDownClosed
        ToolTip1.Hide(ComboBox1) 'скрыть подсказку
End Sub

Imports System
Imports System.Drawing
Imports System.ComponentModel
 
'изменение индекса элемента списка цветовой схемы
    Private Sub ComboBoxColorScheme_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBoxColorScheme.SelectedIndexChanged
        'установить цвет на образце цветовой схемы
        LabelSampleColorScheme.BackColor = GetColor(ComboBoxColorScheme.SelectedIndex)
    End Sub
 
 'текущий цвет
    Private Function GetColor(ColorIndex As Integer) As System.Drawing.Color 'установить цвет
        Dim TempColor As System.Drawing.Color = Color.RoyalBlue 'по умолчанию
        Select Case ColorIndex
            Case 0
                TempColor = Color.Black
            Case 1
                TempColor = Color.DarkSlateGray
            Case 2
                TempColor = Color.Brown
            Case 3
                TempColor = Color.SaddleBrown
            Case 4
                TempColor = Color.OrangeRed
            Case 5
                TempColor = Color.ForestGreen
            Case 6
                TempColor = Color.SeaGreen
            Case 7
                TempColor = Color.RoyalBlue
        End Select
        GetColor = TempColor
    End Function
 
'прорисовка элементов списка и отслеживание расположения мыши над конкретным элементом
    Private Sub ComboBoxColorScheme_DrawItem(sender As Object, e As DrawItemEventArgs) Handles ComboBoxColorScheme.DrawItem
        'если выводится какой-либо элемент списка
        If e.Index <> -1 Then
            'цвет элемента списка по-умолчанию
            Dim TempColor As Color '= e.ForeColor
 
            'если указатель мыши над элементом списка
            If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
                'цвет выделенного элемента списка
                TempColor = SystemColors.HighlightText
            Else 'если указатель не над элементом списка
                'задаем цвет элемента списка соответственно его названию
                TempColor = FormMain.GetColor(e.Index)
            End If
 
            e.DrawBackground() 'прорисовка текста на заднем фоне Background элемента
            'текст списка
            e.Graphics.DrawString(ComboBoxColorScheme.GetItemText(ComboBoxColorScheme.Items(e.Index)), e.Font, New SolidBrush(TempColor), e.Bounds)
            e.DrawFocusRectangle() 'если элемент находится в фокусе - прорисовка пунктирной рамки
 
            'изменение цветовой схемы в зависимости от расположения указателя мыши над элементом списка
            LabelSampleColorScheme.BackColor = FormMain.GetColor(e.Index)
 
        End If
    End Sub

Private Sub ComboBoxColorScheme_KeyUp(sender As Object, e As KeyEventArgs) Handles ComboBox1.KeyUp, ComboBoxColorScheme.KeyUp
        Dim TempComboBox As ComboBox = CType(sender, ComboBox) 'элемент, в котором происходит событие
        If e.KeyCode = Keys.Space Then TempComboBox.DroppedDown = Not TempComboBox.DroppedDown 'при отпускании клавиши Space
    End Sub

Dim Color1 As System.Drawing.Color = Color.RoyalBlue 'исходный цвет метки
Dim Color2 As System.Drawing.Color = ColorTranslator.FromHtml("#6787E7") 'цвет метки при наведении указателя мыши
Dim Color3 As System.Drawing.Color = ColorTranslator.FromHtml("#D0DAF7") 'цвет метки при нажатии кнопки мыши

Label1.FlatStyle = FlatStyle.Standard
Label1.BorderStyle = BorderStyle.None
Label1.BackColor = Color1
Label1.ForeColor = SystemColors.Window
Label2.FlatStyle = FlatStyle.Standard
Label2.BorderStyle = BorderStyle.None
Label2.BackColor = Color1
Label2.ForeColor = SystemColors.Window

Imports System
Imports System.Drawing
Imports System.ComponentModel
 
'мышь над элементом
Private Sub Label1_MouseMove(sender As Object, e As MouseEventArgs) Handles Label1.MouseMove, Label2.MouseMove
        SetControlBackColorAnyMouseMove(sender, e) 'установить цвет фона метки при событии MouseMove
End Sub
 
'установить цвет фона метки при событии MouseMove
Private Sub SetControlBackColorAnyMouseMove(sender As Object, e As MouseEventArgs)
        Dim TempControl As Control = CType(sender, Control) 'элемент
        TempControl.BackColor = Color2 'цвет метки при наведении указателя мыши
        If e.Button = MouseButtons.Left Then 'если нажата левая кнопка мыши
            If CheckCursorPositionInSideBoundsControl(sender, e) = True Then 'если указатель мыши в пределах элемента
                TempControl.BackColor = Color3 'цвет метки при нажатии кнопки мыши
            End If
        End If
End Sub
 
'определить - находится ли указатель мыши в пределах элемента
Private Function CheckCursorPositionInSideBoundsControl(sender As Object, e As MouseEventArgs) As Boolean
        CheckCursorPositionInSideBoundsControl = False 'указатель мыши за пределами метки
        Dim TempControl As Control = CType(sender, Control)
        If e.X >= 0 Then
            If e.X <= TempControl.Width Then
                If e.Y >= 0 Then
                    If e.Y <= TempControl.Height Then
                        CheckCursorPositionInSideBoundsControl = True 'указатель мыши в пределах метки
                    End If
                End If
            End If
        End If
End Function
 
'нажать кнопку мыши
Private Sub Label1_MouseDown(sender As Object, e As MouseEventArgs) Handles Label1.MouseDown, Label2.MouseDown
        SetControlBackColorAnyMouseDown(sender, e) 'установить цвет фона метки при событии MouseDown
End Sub
 
'установить цвет фона метки при событии MouseDown
Private Sub SetControlBackColorAnyMouseDown(sender As Object, e As MouseEventArgs)
        If e.Button = MouseButtons.Left Then 'если нажата левая кнопка мыши
            Dim TempControl As Control = CType(sender, Control) 'элемент
            TempControl.BackColor = Color3 'цвет метки при нажатии кнопки мыши
        End If
End Sub
 
'отжать кнопку мыши - выполнение команд для каждой метки
Private Sub Label1_MouseUp(sender As Object, e As MouseEventArgs) Handles Label1.MouseUp, Label2.MouseUp
        If e.Button <> MouseButtons.Left Then Exit Sub 'если не нажата левая кнопка мыши - выходим
        SetControlBackColorAnyMouseUp(sender, e) 'установить цвет фона метки при событии MouseUp
        If CheckCursorPositionInSideBoundsControl(sender, e) = False Then Exit Sub 'если координаты мыши за пределами элемента - выходим
 
'код команд для каждой метки
        Select Case True
            Case sender Is Label1
            'вставьте код команды для метки 1
              
            Case sender Is Label2
            'вставьте код команды для метки 2
 
        End Select
End Sub
 
'установить цвет фона метки при событии MouseUp
Private Sub SetControlBackColorAnyMouseUp(sender As Object, e As MouseEventArgs)
        If e.Button = MouseButtons.Left Then 'если нажата левая кнопка мыши
            Dim TempControl As Control = CType(sender, Control) 'элемент
            TempControl.BackColor = Color1 'исходный цвет метки
        End If
End Sub
 
'покидание указателя мыши зоны метки
Private Sub Label1_MouseLeave(sender As Object, e As EventArgs) Handles Label1.MouseLeave, Label2.MouseLeave
        SetControlBackColorAnyMouseLeave(sender) 'установить цвет фона метки при событии MouseLeave
End Sub
 
'установить цвет фона метки при событии MouseLeave
Private Sub SetControlBackColorAnyMouseLeave(sender As Object)
        Dim TempControl As Control = CType(sender, Control) 'элемент
        TempControl.BackColor = Color1 'исходный цвет метки
End Sub

Dim RichTextBoxResult As New RichTextBoxE 'основное окно редактора - видимое
Dim TempRichTextBoxResult As New RichTextBoxE 'временное вспомогательное окно - невидимое

 'представить текст без кода в формате RTF
    Private Sub TXTtoRTF()
        TempRichTextBoxResult.Rtf = RichTextBoxResult.Rtf 'запомнить исходный текст
        Try
            RichTextBoxResult.Rtf = RichTextBoxResult.Text
        Catch ex As Exception 
            RichTextBoxResult.Rtf = TempRichTextBoxResult.Rtf 'в случае неудачи - вернуть исходный текст
        End Try
    End Sub
    'представить текст с кодом в формате RTF
    Private Sub RTFtoTXT() 
        RichTextBoxResult.Text = RichTextBoxResult.Rtf
    End Sub

'Результаты расчета - создание Раздела исходных данных в формате RTF
Private Function GetRTFResultInputData() As String 'Результаты расчета - создание Раздела исходных данных в формате RTF
        Dim TempRTFStringBuilder As New System.Text.StringBuilder 'Строка РР в формате RTF
        'Результаты расчета - Заголовок
        TempRTFStringBuilder.Append("Приложение " & Chr(34) & My.Application.Info.Title & Chr(34) & " версия " & My.Application.Info.Version.ToString & "\par" & vbCrLf)
        TempRTFStringBuilder.Append(Strings.Format(System.DateTime.Now, "dd.MM.yy HH:mm:ss") & " Начало расчета\par\par" & vbCrLf)
        'Результаты расчета - исходные данные
        TempRTFStringBuilder.Append("1 Исходные данные\par\par" & vbCrLf)
        'Параметры расчета
        TempRTFStringBuilder.Append("Таблица 1.1 – Параметры расчета\par" & vbCrLf)
        TempRTFStringBuilder.Append("\trowd\trgaph108\trleft5\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx2750\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx9350\pard\intbl\qc Параметр\cell Значение\cell\row" & vbCrLf)
        'формирование строки описания
        Dim TempString As String = "Текст описания"
        TempRTFStringBuilder.Append("\trowd\trgaph108\trleft5\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx2750\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx9350\pard\intbl Описание\cell " & TempString & "\cell\row" & vbCrLf)
        TempRTFStringBuilder.Append("\pard\par" & vbCrLf)
 
        'заголовок Таблицы 1.2 – Структура ПКМ
        TempRTFStringBuilder.Append("Таблица 1.2 – Структура ПКМ\par" & vbCrLf)
        'заголовок таблицы
        'заголовок таблицы - первый уровень
        TempRTFStringBuilder.Append("\trowd\trgaph108\trleft5\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmgf\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs \cellx800" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmgf\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs \cellx3900" & vbCrLf)
        TempRTFStringBuilder.Append("\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx5900" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmgf\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs \cellx6850" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmgf\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs \cellx8300" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmgf\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs \cellx9350" & vbCrLf)
        TempRTFStringBuilder.Append("\pard\intbl\qc №\par слоя\cell Материал\cell Угол армир., °\cell Кол. мон.\cell Толщина, мм\cell Доля, %\cell\row" & vbCrLf)
        'заголовок таблицы - второй уровень
        TempRTFStringBuilder.Append("\trowd\trgaph108\trleft5\trbrdrl\brdrs\brdrw10 \trbrdrt\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trpaddl108\trpaddr108\trpaddfl3\trpaddfr3" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmrg\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx800" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmrg\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx3900" & vbCrLf)
        TempRTFStringBuilder.Append("\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx4900" & vbCrLf)
        TempRTFStringBuilder.Append("\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrt\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx5900" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmrg\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx6850" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmrg\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx8300" & vbCrLf)
        TempRTFStringBuilder.Append("\clvmrg\clvertalc\clbrdrl\brdrw10\brdrs\clbrdrr\brdrw10\brdrs\clbrdrb\brdrw10\brdrs \cellx9350" & vbCrLf)
        TempRTFStringBuilder.Append("\pard\intbl\qc\cell\cell по 0°\cell по X\cell\cell\cell\cell\cell\row" & vbCrLf)
 
        'вывод строк таблицы - в данном примере пропущено
        'Окончание таблицы - в данном примере пропущено
        'Примечание - в данном примере пропущено
 
        TempRTFStringBuilder.Append("\pard\par" & vbCrLf)
 
        'создать раздел исходных данных в формате RTF
        GetRTFResultInputData = TempRTFStringBuilder.ToString 'возврат функции созданной строки в формате RTF
        TempRTFStringBuilder.Clear() 'очистить строку
 
End Function