قرار دادن tag بین متن

[امین مستانی]

با عرض سلام
طاعات و عبادات قبول

بنده دارم روی یک برنامه کار میکنم که میخوام با کلیک بر روی یک دکمه متن انتخاب شده در RichTextBox میان tag ها قرار بگیره برای مثال با کلیک بر روی کامند متن "سلام" به این صورت شود "[b/]سلام[b]"

و همین طور برعکس یعنی با کلیک بر روی یک کامند متن سلام را به صورت بولد برای پیش نمایش نشان دهد .

خودم این نمونه سورس را نوشتم که منتها متن را بهم میریزد

Dim StrInput

If Text2.SelLength = 0 Then
MsgBox "ÇÈÊÏÇ ãÊä ãæÑÏäÙÑ ÑÇ ÇäÊÎÇÈ ˜äíÏ", vbInformation, "Ñä"
Else

StrInput = Text2.SelText
Text2.SelText = ""
Text2.SetFocus
SendKeys "<b>" & StrInput & "</b>"
End If


شما نمونه سورسی برای سوالاتم ندارید؟؟

با تشکر

[ramzdar]

دو تا دکمه و دو تا RichTextBox بذار روی فرم و اسم RichTextBox ها رو به ترتیب به Text1 و Text2 تغییر بده و کد زیر رو تو بخش کد قرار بده

Private Sub Command1_Click()
Text1.Text = "<b>" & Text1.Text & "</b>"
End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim StrInput As String
StrInput = Split(Text1.Text, "<b>")(1)
StrInput = Split(StrInput, "</b>")(0)
Text2.Text = StrInput
Text2.SelStart = 0
Text2.SelLength = Len(StrInput)
Text2.SelBold = True
End Sub

[m.4.r.m]

ببین این به کارت میاد ؟
http://uplod.ir/iq4vhen15f4f/TaGG.zip.htm

[امین مستانی]

ممنون از پاسخ هاتون
ولی من میخوام که متن انتخاب شده در RichTextBox دارای تگ شود نه کل متن
مشکل من با متن انتخاب شده است

[m.4.r.m]

بیا داداش برات نوشتم اما تشکر یادت نره ها تو تکست باکس متن داخل Richtextbox رو می نویسی مثلا " Salam " بعد کلیک کن نتیجه رو ببین

http://uplod.ir/mmp3u82p10k0/Richtextbox.zip.htm

[امین مستانی]

ممنون از پاسختون . کارم راه افتاد .

ولی در متن های فارسی حروف جابجا میشوند . راهی برای درست کردن آنها نیست ؟؟

با تشکر

[Mr'Jamshidy]

ممنون از پاسختون . کارم راه افتاد .

ولی در متن های فارسی حروف جابجا میشوند . راهی برای درست کردن آنها نیست ؟؟

با تشکر

نه متاسفانه
چون کامپوننت ها (اکثرا) برای زبان های برای زبان های چپ به راست کانفیگ شده نمیشه کاریش کرد

البته شاید از RightToLeft بتونی جواب بگیری

http://barnamenevis.org/showthread.php?307981-Right-TO-left-%DA%A9%D8%B1%D8%AF%D9%86-%D9%81%D9%88%D8%B1%D9%85&p=1351987&viewfull=1#post1351987

[امین مستانی]

ممنونم
ولی باز هم همانطور به صورت بهم ریخته است

[محسن واژدی]

سلام علیکم

تابع زیر را هم بررسی کنید: Public Sub AddRemoveTag(RTBox As RichTextBox, sStartTag$, sEndTag$)
On Error Resume Next
Dim inpu$
Dim lSS&, lSL&
With RichTextBox1
lSS& = .SelStart
lSL& = .SelLength
If lSL& = 0 Then
MsgBox "ابتدا متن را انتخاب کنيد", vbInformation
Else
If lSS& > Len(sStartTag$) And (lSL& + Len(sEndTag$)) < Len(.Text) Then

If LCase(Mid(.Text, (lSS& - Len(sStartTag$)) + 1, Len(sStartTag$))) = LCase(sStartTag$) Then
If LCase(Mid(.Text, (lSS& + lSL&) + 1, Len(sEndTag$))) = LCase(sEndTag$) Then
.SetFocus
.SelStart = (lSS& - Len(sStartTag$))
.SelLength = lSS& + Len(sEndTag$)

.SelText = Mid(.SelText, Len(sStartTag$) + 1, Len(.SelText) - (Len(sStartTag$) + Len(sEndTag$)))
.SelStart = lSS& - Len(sStartTag$)
.SelLength = lSL& - Len(sEndTag$)
Else
GoTo AddTag
End If
Else
GoTo AddTag
End If
Else
GoTo AddTag
End If


Exit Sub
AddTag:
inpu$ = .SelText
inpu$ = sStartTag$ & inpu$ & sEndTag$
.SelText = inpu$
End If
End With
End Sub


برای مثال: AddRemoveTag RichTextBox1,"", ""
و یا:

AddRemoveTag RichTextBox1,"", ""


البته بایستی اول متن را high-light و سپس تابع را اجرا کنیم، برای کاهش وابستگی تابع به این مورد هم بایستی کمی کدها را اضافه تر کنیم :)

موفق باشید