Private Enum RtfSubSuper
rtfSub = 0
rtfSuper
End Enum
Private Function MakeStringSubSuper(ByVal s As String, ByVal Mode As RtfSubSuper) As String
If s Is Nothing Then Throw New ArgumentException("Нефиг", "s")
If Mode <> RtfSubSuper.rtfSub AndAlso Mode <> RtfSubSuper.rtfSuper Then Throw New ArgumentException("Нефиг", "Mode")
Dim p, pp, c As Integer
Dim ctf1 As Char() = {" "c, "\"c}, ctf2 As Char() = {"{"c, "}"c}
Dim rtfs As String() = {"\sub", "\super"}
Do
p = s.IndexOf("\lang", pp)
If p = -1 Then Return s
If s.Chars(p - 1) <> "\"c Then
p = s.IndexOfAny(ctf1, p + Len("\lang"))
If p <> -1 Then
c = 1
pp = p + 1
Do While pp < s.Length()
pp = s.IndexOfAny(ctf2, pp)
If pp = -1 Then Return s
If s.Chars(pp - 1) = "\"c Then
pp += 1
Else
If s.Chars(pp) = "{"c Then c += 1 Else c -= 1
If c = 0 Then
Return s.Substring(0, p) & rtfs(Mode) & s.Substring(p, pp - p) & "\nosupersub" & s.Substring(pp)
End If
End If
Loop
End If
Else
pp = p + Len("\lang")
End If
Loop
End Function
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
RichTextBox1.SelectedRtf = MakeStringSubSuper(RichTextBox1.SelectedRtf, RtfSubSuper.rtfSub)
End Sub
В частности, это не будет работать при попытке задать sub для диапазона, который частично sub, а частично нет.
RtfSubSuper - мой тип, который определил я для себя
Imports System.Runtime.InteropServices
<Security.SuppressUnmanagedCodeSecurity()> _
Private Declare Auto Function SendMessage Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal uMsg As Integer, ByVal wParam As Integer, <Out()> ByRef lParam As IntPtr) As Integer
Private Enum tomBool As Integer
tomFalse = 0
tomTrue = &HFFFFFFFF
tomToggle = &HFF676982
'tomUnknown
End Enum
Private Enum RtfSubSuper
rtfSub = 0
rtfSuper
End Enum
Private Sub MakeSelectionSubSuper(ByVal rtb As RichTextBox, ByVal IndexType As RtfSubSuper, ByVal value As tomBool)
Dim pRichEditOle, pTextDocument As IntPtr
Dim TextDocument, RangeObject, FontObject As Object
Const WM_USER As Integer = &H400
Const EM_GETOLEINTERFACE As Integer = WM_USER + 60
Dim rtfs As String() = {"Subscript", "Superscript"}
If rtb Is Nothing Then Throw New ArgumentNullException("rtb", "Нефиг!")
If rtb.ReadOnly Then Throw New ArgumentException("rtb", "Не, ну а чё, с таким rtb ничего не получится этим способом...")
If IndexType <> RtfSubSuper.rtfSub AndAlso IndexType <> RtfSubSuper.rtfSuper Then Throw New ArgumentException("Нефиг", "IndexType")
If value <> tomBool.tomTrue AndAlso value <> tomBool.tomFalse AndAlso value <> tomBool.tomToggle Then Throw New ArgumentException("Нефиг", "value")
If SendMessage(rtb.Handle, EM_GETOLEINTERFACE, 0, pRichEditOle) = 0 Then Exit Sub 'ну или другое чё...
'Злостно! Но безопасно.
Try
Marshal.QueryInterface(pRichEditOle, New Guid("8CC497C0-A1DF-11CE-8098-00AA0047BE5D"), pTextDocument)
If Not pTextDocument.Equals(IntPtr.Zero) Then
Try
TextDocument = Marshal.GetObjectForIUnknown(pTextDocument)
Try
RangeObject = TextDocument.GetType.InvokeMember("Selection", Reflection.BindingFlags.Instance Or Reflection.BindingFlags.GetProperty Or Reflection.BindingFlags.Public, Nothing, TextDocument, Nothing)
Try
FontObject = RangeObject.GetType.InvokeMember("Font", Reflection.BindingFlags.Instance Or Reflection.BindingFlags.GetProperty Or Reflection.BindingFlags.Public, Nothing, RangeObject, Nothing)
Try
FontObject.GetType.InvokeMember(rtfs(IndexType), Reflection.BindingFlags.Instance Or Reflection.BindingFlags.SetProperty Or Reflection.BindingFlags.Public, Nothing, FontObject, New Object() {value})
Finally
Marshal.ReleaseComObject(FontObject)
End Try
Finally
Marshal.ReleaseComObject(RangeObject)
End Try
Finally
Marshal.ReleaseComObject(TextDocument)
End Try
Finally
Marshal.Release(pTextDocument)
End Try
End If
Finally
Marshal.Release(pRichEditOle)
End Try
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
MakeSelectionSubSuper(RichTextBox1, RtfSubSuper.rtfSub, tomBool.tomToggle)
End Sub
MakeSelectionSubSuper(RichTextBox1, RtfSubSuper.rtfSub, tomBool.tomToggle)
AnarCky писал(а):Т.е. когда мне нужно сделать текст подстрочным я просто пишу строчку:
AnarCky писал(а):Тогда возникает еще пара вопросов:
FontObject.GetType.InvokeMember(rtfs(IndexType), Reflection.BindingFlags.Instance Or Reflection.BindingFlags.SetProperty Or Reflection.BindingFlags.Public, Nothing, FontObject, New Object() {value})
somevar = FontObject.GetType.InvokeMember(rtfs(IndexType), Reflection.BindingFlags.Instance Or Reflection.BindingFlags.GetProperty Or Reflection.BindingFlags.Public, Nothing, FontObject, Nothing)
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 46