منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

نسخة كاملة : طلب بعض الاكواد فى انشاء محرر RichTextBox
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
السلام عليكم ورحمة الله وبركاتة
اريد ان اكواد الازرار المحددة فى الصورة

[ATTACH=CONFIG]2999[/ATTACH]
مع ملاحظه لو اخترت Bold وكان الخط مائل اريده ان يصبح مائل وعريض
واذا كان Bold وضغط على Bold يصبح عادى
وهكذا لكل الازرار
وجزاكم الله خير
الحمد لله قدرت اوصل لكود زر التكبير والتصغير

إقتباس :Me.RichTextBox_rtf.SelectionFont = New Font(Me.RichTextBox_rtf.SelectionFont.FontFamily, Me.RichTextBox_rtf.SelectionFont.Size + 1)

إقتباس : Me.RichTextBox_rtf.SelectionFont = New Font(Me.RichTextBox_rtf.SelectionFont.FontFamily, Me.RichTextBox_rtf.SelectionFont.Size - 1)
الكود النهائى لتكبير وتصغير الخط مع المحافظه على نوع واستايل الخط المستخدم

تكبير

كود :
[/b] Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click
        Me.RichTextBox_rtf.SelectionFont = New Font(Me.RichTextBox_rtf.SelectionFont.FontFamily, Me.RichTextBox_rtf.SelectionFont.Size + 1, Me.RichTextBox_rtf.SelectionFont.Style)
    End Sub[b]

تصغير

كود :
[/b] Private Sub Button17_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button17.Click
        Me.RichTextBox_rtf.SelectionFont = New Font(Me.RichTextBox_rtf.SelectionFont.FontFamily, Me.RichTextBox_rtf.SelectionFont.Size - 1, Me.RichTextBox_rtf.SelectionFont.Style)
    End Sub[b]

وجارى عمل باقى الاكواد
تفضل أخي

كود :
Private Sub SetBold(ByVal Rbox As RichTextBox)
        If Rbox.SelectedText IsNot Nothing Then
            Dim CurrFont As Font = Rbox.SelectionFont
            Dim BoldStyle As FontStyle
            If Rbox.SelectionFont.Bold = True Then
                BoldStyle = FontStyle.Regular
            Else
                BoldStyle = FontStyle.Bold
            End If
            BoldStyle += CurrFont.Style
            Rbox.SelectionFont = New Font(CurrFont.FontFamily, CurrFont.Size, BoldStyle)
        End If
    End Sub


    Private Sub SetItalic(ByVal Rbox As RichTextBox)
        If Rbox.SelectedText IsNot Nothing Then
            Dim CurrFont As Font = Rbox.SelectionFont
            Dim ItalicStyle As FontStyle
            If Rbox.SelectionFont.Italic = True Then
                ItalicStyle = FontStyle.Regular
            Else
                ItalicStyle = FontStyle.Italic
            End If
            ItalicStyle += CurrFont.Style
            Rbox.SelectionFont = New Font(CurrFont.FontFamily, CurrFont.Size, ItalicStyle)
        End If
    End Sub


    Private Sub SetUnderline(ByVal Rbox As RichTextBox)
        If Rbox.SelectedText IsNot Nothing Then
            Dim CurrFont As Font = Rbox.SelectionFont
            Dim UnderlineStyle As FontStyle
            If Rbox.SelectionFont.Underline = True Then
                UnderlineStyle = FontStyle.Regular
            Else
                UnderlineStyle = FontStyle.Underline
            End If
            UnderlineStyle += CurrFont.Style
            Rbox.SelectionFont = New Font(CurrFont.FontFamily, CurrFont.Size, UnderlineStyle)
        End If
    End Sub


    ' كيفية الاستخدام


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        SetBold(Me.RichTextBox1)
    End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        SetItalic(Me.RichTextBox1)
    End Sub


    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        SetUnderline(Me.RichTextBox1)
    End Sub


****
***
**
*
اخ kslawy
الاخ يريد عندما يكون الخط عريض ويضغط على bold فانه يصبح عادي
فمثال ذالك
فيجب ان يستخدم اداة checkbox
السلام عليكم ورحمة الله وبركاته
الحمد لله عرفت اعملها
كود :
Private Sub RichTextBox_rtf_Font_Style(ByVal My_Style As Integer)
        '
        Dim Font_Style As New FontStyle
        Dim Txt_Font As Font = Me.RichTextBox_rtf.SelectionFont
        '
        If Me.RichTextBox_rtf.SelectionFont.Bold And My_Style <> 1 Then Font_Style += FontStyle.Bold
        If Me.RichTextBox_rtf.SelectionFont.Italic And My_Style <> 2 Then Font_Style += FontStyle.Italic
        If Me.RichTextBox_rtf.SelectionFont.Strikeout And My_Style <> 3 Then Font_Style += FontStyle.Strikeout
        If Me.RichTextBox_rtf.SelectionFont.Underline And My_Style <> 4 Then Font_Style += FontStyle.Underline
        '
        Select Case My_Style
            Case 1
                If Not Txt_Font.Bold Then Font_Style += FontStyle.Bold
            Case 2
                If Not Txt_Font.Italic Then Font_Style += FontStyle.Italic
            Case 3
                If Not Txt_Font.Strikeout Then Font_Style += FontStyle.Strikeout
            Case 4
                If Not Txt_Font.Underline Then Font_Style += FontStyle.Underline
        End Select
        '
        Me.RichTextBox_rtf.SelectionFont = New Font(Txt_Font.FontFamily, Txt_Font.Size, Font_Style)
        '
    End Sub

هذا هو الصب
واكواد الازرار

سميك بولد
كود :
RichTextBox_rtf_Font_Style(1)

مائل
كود :
RichTextBox_rtf_Font_Style(2)

تحته خط
كود :
RichTextBox_rtf_Font_Style(4)

وسطه خط
كود :
RichTextBox_rtf_Font_Style(3)

هل يوجد حالات اخرى
اخى kslawy فعلا ممتاز والله بس جاء متاخر ههههه جزاك الله خير
طيب فى كود مش عارف اعمله
وهو كود الحذف وايضا كود وضع رابط على النص
انظر الصورة

[ATTACH=CONFIG]3005[/ATTACH]
السلام عليكم
هذا كود حذف المحدد من النص
RichTextBox1.SelectedText = String.Empty ' or ""
اما اضافة رابط فساجربها
جزاك الله خيرا فى انتظارك او اى احد من الاخوة جزاكم الله خير