ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Наследие стилей быстро: только через ртф?
6 сообщений из 6, страница 1 из 1
Наследие стилей быстро: только через ртф?
    #34685830
Фотография @TM@ROZчег
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
@TM@ROZчег
Участник
вопрос такой:
у меня программа, которая пишет буквы как символы, например:
привет -> |"||*|/||3[-"|"
в ней возможно форматирование отдельных учатсков текста в первом текстбоксе (ввода фразы ( в нашем случае - привет)). в результате нужно сохранить форматирование (жирно,курсивно). я сделал так:
Dim ty As Long
Dim tf As Long
For i = 1 To Len(s)
DoEvents

If perevodi = True Then
sb.SimpleText = "Настройка стиля для " & i &" символа из " & Len(s)
Text1.SelStart = i - 1
Text1.SelLength = 1

If Text1.SelBold = True Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelBold = True
End If

If Text1.SelItalic = True Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelItalic = True
End If

If Text1.SelUnderline = True Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelUnderline = True
End If

If Text1.SelStrikeThru = True Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelStrikeThru = True
End If

If Text1.SelColor <> 0 Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelColor = Text1.SelColor
End If

If Text1.SelAlignment <> 0 Then
ty = 0
For tf = 1 To i - 1
ty = ty + Val(Mid(num, tf, 1))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i, 1)
Text2.SelAlignment = Text1.SelAlignment
End If

Else
Exit Sub
sb.SimpleText = "Готов"
End If

где num - это строка, в которой каждый символ соответствует количеству знаков переводу введённого символа

можно ли это сделать быстрее (тобишь работать с переменной, а не с текстовым полем)?
у меня есть только одна идея - только через ртф. но "оРТФичеваниющую" функцию я не знаю и вообще весь процесс через ртф плохо себе представляю.

С уважением, Павел

P.S. text1 и text2 - это RichTextBox
...
Рейтинг: 0 / 0
26.07.2007, 13:58
| Ответить | Цитировать | Написать  
Наследие стилей быстро: только через ртф?
    #34685943
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
big-duke
Участник
тэг [src vba] облегчает понимание вашего кода.
...
Рейтинг: 0 / 0
26.07.2007, 14:21
| Ответить | Цитировать | Написать  
Наследие стилей быстро: только через ртф?
    #34687336
Фотография @TM@ROZчег
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
@TM@ROZчег
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
If perevodi = True Then
sb.SimpleText = "Настройка стиля для " & i &" символа из " & Len(s)
Text1.SelStart = i -  1 
Text1.SelLength =  1 

If Text1.SelBold = True Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelBold = True
End If

If Text1.SelItalic = True Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelItalic = True
End If

If Text1.SelUnderline = True Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelUnderline = True
End If

If Text1.SelStrikeThru = True Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelStrikeThru = True
End If

If Text1.SelColor <>  0  Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelColor = Text1.SelColor
End If

If Text1.SelAlignment <>  0  Then
ty =  0 
For tf =  1  To i -  1 
ty = ty + Val(Mid(num, tf,  1 ))
Next
Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelAlignment = Text1.SelAlignment
End If

Else
Exit Sub
sb.SimpleText = "Готов"
End If
...
Рейтинг: 0 / 0
26.07.2007, 19:58
| Ответить | Цитировать | Написать  
Наследие стилей быстро: только через ртф?
    #34690337
Фотография @TM@ROZчег
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
@TM@ROZчег
Участник
вообще-то я немного код изменил...
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
Dim ty As Long
Dim tf As Long
tf =  1 
For i =  1  To Len(s)
DoEvents
ty = ty + Val(Mid(num, tf,  1 ))
tf = tf +  1 
If perevodi = True Then
Text1.SelStart = i -  1 
Text1.SelLength =  1 

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelBold = Text1.SelBold

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelItalic = Text1.SelItalic

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelUnderline = Text1.SelUnderline

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelStrikeThru = Text1.SelStrikeThru

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelColor = Text1.SelColor

Text2.SelStart = ty
Text2.SelLength = Mid(num, i,  1 )
Text2.SelAlignment = Text1.SelAlignment

Else
Exit Sub
sb.SimpleText = frmready
End If

Next


Text2.SelLength =  0 
Text1.SelLength =  0 
Text2.SetFocus
Text2.SelStart =  0
...
Рейтинг: 0 / 0
27.07.2007, 21:15
| Ответить | Цитировать | Написать  
Наследие стилей быстро: только через ртф?
    #34690561
Фотография @TM@ROZчег
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
@TM@ROZчег
Участник
ап
...
Рейтинг: 0 / 0
28.07.2007, 10:14
| Ответить | Цитировать | Написать  
Наследие стилей быстро: только через ртф?
    #34721522
Фотография @TM@ROZчег
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
@TM@ROZчег
Участник
куку, несмотря на .нет, вопрос остаёцо
...
Рейтинг: 0 / 0
11.08.2007, 12:02
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Наследие стилей быстро: только через ртф?
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&tid=2163592]:
 0ms
get settings:
 10ms
get forum list:
 20ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 185ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 48ms
get tp. blocked users:
 2ms
others: 247ms
total:  532ms
созд. / загр.: 532ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]