Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.50/8: Рейтинг темы: голосов - 8, средняя оценка - 4.50
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327

Как выделить текст?

24.07.2013, 00:54. Показов 1794. Ответов 14
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Допустим, у меня есть строковая переменная, которая содержит текст,как можно выделить красным цветом содержание этой переменной?
0
Лучшие ответы (1)
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
24.07.2013, 00:54
Ответы с готовыми решениями:

Как по двум ключевым словам выделить текст в Wordе
Мне надо выделить по двум известным мне словам текст в Документе Word 97. Слова я нахожу с помощью Selection.Find

Как выделить текст нескольких контролов (TextBox) одновременно?
Всем привет! На форме массив текстбоксов. Мне нужно при нажатой левой кнопки мыши выделить текст сразу в нескольких текстбоксах. Третий...

Как выделить текст жирным (не ключевое слово, а простой текст)?
Я выделяю ключевые слова тегом <strong>. А как выделить «обычные слова», которые не являются ключевыми словами? Добавлено через 1 час...

14
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
24.07.2013, 00:56
Никак. 1-а строковая переменная может хранить только символы, но не информацию об их цвете.
0
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 01:12  [ТС]
ааа, спасибо, буду знать, а к примеру, если надо выделить красным, слово "Когда", как тогда можно выделить это?
0
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
24.07.2013, 01:14
Смотря в каком объекте отображается это слово.
0
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 09:06  [ТС]
в TextBox'е
0
es geht mir gut
 Аватар для SoftIce
11274 / 4760 / 1183
Регистрация: 27.07.2011
Сообщений: 11,439
24.07.2013, 09:29
Лучший ответ Сообщение было отмечено как решение

Решение

Было уже

Модуль
Кликните здесь для просмотра всего текста
Visual Basic
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
Option Explicit
 
Private Type TColorWord
    Word        As String
    Color       As Long
End Type
 
Private Type TColorRange
    StartString   As String
    StopString    As String
    Color       As Long
End Type
 
Private Type POINTAPI
        X       As Long
        Y       As Long
End Type
 
Private Type RECT
        Left    As Long
        Top     As Long
        Right   As Long
        Bottom  As Long
End Type
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpPoint As Any) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
 
Private Const GWL_WNDPROC = (-4), _
              WM_PAINT = &HF, _
              WM_MOUSEMOVE = &H200, _
              MK_LBUTTON = &H1, _
              WM_LBUTTONUP = &H202, _
              WM_PASTE = &H302, _
              WM_KILLFOCUS = &H8, _
              WM_SETFOCUS = &H7, _
              WM_HSCROLL = &H114, _
              WM_VSCROLL = &H115, _
              WM_MOUSEWHEEL = &H20A, _
              SB_ENDSCROLL = 8, _
              WM_KEYDOWN = &H100, _
              VK_BACK = &H8, _
              VK_TAB = &H9, _
              WM_CHAR = &H102, _
              VK_SHIFT = &H10, _
              EM_POSFROMCHAR = &HD6
Private Const EM_LINEFROMCHAR = &HC9, _
              WM_GETFONT = &H31, _
              EM_LINEINDEX = &HBB, _
              EM_LINELENGTH = &HC1, _
              EM_GETLINE = &HC4, _
              EM_CHARFROMPOS = &HD7, _
              EM_GETFIRSTVISIBLELINE = &HCE, _
              EM_GETRECT = &HB2, _
              PS_SOLID = 0, _
              DEFAULT_CHARSET = 1, _
              LOGPIXELSY = 90, _
              OUT_DEFAULT_PRECIS = 0, _
              CLIP_DEFAULT_PRECIS = 0, _
              DEFAULT_PITCH = 0, _
              FW_NORMAL = 400, _
              DEFAULT_QUALITY = 0, _
              WM_SETFONT = &H30, _
              COLOR_HIGHLIGHT = 13, _
              COLOR_HIGHLIGHTTEXT = 14, _
              COLOR_BTNFACE = 15, _
              EM_GETLINECOUNT = &HBA
 
Public PrevProc                 As Long
 
Private ColorTextBox            As TextBox, _
        ColorTextBoxParentForm  As Form, _
        CWord()                 As TColorWord, _
        CRange()                As TColorRange, _
        TexthDC                 As Long, _
        hFont                   As Long, _
        hPen                    As Long, _
        CharHeight              As Long, _
        CharWidth               As Long, _
        HLColor                 As Long, _
        NColor                  As Long, _
        HLTextColor             As Long, _
        NTextColor              As Long, _
        CurrentBkColor          As Long, _
        CurrentTextColor        As Long, _
        CColor                  As Long, _
        CTextColor              As Long
 
Private Sub PrepareTextBox()
Dim FontHeight As Long
ColorTextBox.ForeColor = vbBlack
ColorTextBox.BackColor = vbWhite
FontHeight = -MulDiv(10, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72)
hFont = CreateFont(FontHeight, 0, 0, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "courier new")
SendMessage ColorTextBox.hwnd, WM_SETFONT, hFont, 0
TexthDC = GetDC(ColorTextBox.hwnd)
SelectObject TexthDC, hFont
hPen = CreatePen(PS_SOLID, 0, ColorTextBox.BackColor)
SelectObject TexthDC, hPen
End Sub
 
Private Sub PrepareVars()
Dim Size As POINTAPI
ReDim CWord(0)
ReDim CRange(0)
GetTextExtentPoint32 TexthDC, "x", 1, Size
CharHeight = Size.Y: CharWidth = Size.X
HLColor = GetSysColor(COLOR_HIGHLIGHT)
HLTextColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
NColor = ColorTextBox.BackColor
NTextColor = vbBlue
CColor = ColorTextBox.BackColor
CTextColor = ColorTextBox.ForeColor
CurrentTextColor = 1
End Sub
 
Public Sub AddColorWord(Word As String, Color As Long)
Dim i As Long
For i = 0 To UBound(CWord)
    If CWord(i).Word = "" Or UCase(CWord(i).Word) = UCase(Word) Then
        With CWord(i)
            .Word = Word
            .Color = Color
        End With
        Exit Sub
    End If
Next i
ReDim Preserve CWord(UBound(CWord) + 1)
With CWord(UBound(CWord))
    .Word = Word
    .Color = Color
End With
End Sub
 
Public Sub DeleteColorWord(Word As String)
Dim i As Long
For i = 0 To UBound(CWord)
    If UCase(CWord(i).Word) = UCase(Word) Then CWord(i).Word = ""
Next i
End Sub
 
Public Sub AddColorRange(StartString As String, StopString As String, Color As Long)
Dim i As Long
For i = 0 To UBound(CRange)
    If CRange(i).StartString = "" Or UCase(CRange(i).StartString) = UCase(StartString) Then
        With CRange(i)
            .StartString = StartString
            .StopString = StopString
            .Color = Color
        End With
        Exit Sub
    End If
Next i
ReDim Preserve CRange(UBound(CRange) + 1)
With CRange(UBound(CRange))
    .StartString = StartString
    .StopString = StopString
    .Color = Color
End With
End Sub
 
Public Sub DeleteColorRange(StartString As String)
Dim i As Long
For i = 0 To UBound(CRange)
    If UCase(CRange(i).StartString) = UCase(StartString) Then CRange(i).StartString = ""
Next i
End Sub
 
Private Sub PaintLine(LineIndex As Long, Selected As Boolean)
Dim s               As String, _
    ss              As String, _
    Chp             As Long, _
    Chp2            As Long, _
    MinChp          As Long, _
    MinChpIndex     As Long, _
    m               As Long, _
    X               As Long, _
    Y               As Long, _
    SChp            As Long, _
    PosFromChar     As Long, _
    chIndex         As Long, _
    SelLength       As Long, _
    i               As Long, _
    SelStart        As Long, _
    n               As Long, _
    OK              As Boolean, _
    WordForOut      As String, _
    CW              As Boolean, _
    WordForFinding  As String
SelStart = ColorTextBox.SelStart
SelLength = ColorTextBox.SelLength
chIndex = SendMessage(ColorTextBox.hwnd, EM_LINEINDEX, LineIndex, 0&)
s = Space(SendMessage(ColorTextBox.hwnd, EM_LINELENGTH, chIndex, 0&))
SendMessage ColorTextBox.hwnd, EM_GETLINE, LineIndex, ByVal s
HideCaret ColorTextBox.hwnd
CW = True
Do
    If CW Then WordForFinding = CWord(n).Word
    If WordForFinding <> "" Or Not CW Then
        Do
            OK = True
            If CW Then
                Chp = InStr(Chp + 1, UCase(s), UCase(WordForFinding))
                If Chp = 0 Then Exit Do
                If Chp = 1 Then
                    OK = True
                Else
                    If Mid(s, Chp - 1, 1) = " " Then
                        OK = True
                    Else
                        OK = False
                    End If
                End If
                If OK And Chp + Len(WordForFinding) - 1 <> Len(s) Then
                    ss = Mid(s, Chp + Len(WordForFinding), 1)
                    If ss <> " " And ss <> "," And ss <> "(" And ss <> ")" Then OK = False
                End If
            Else
                MinChpIndex = -1
                MinChp = Len(s)
                For m = 0 To UBound(CRange)
                    X = InStr(Chp2 + 1, UCase(s), UCase(CRange(m).StartString))
                    Y = IIf(CRange(m).StopString <> Chr(0), InStr(X + 1, UCase(s), UCase(CRange(m).StopString)), Len(s))
                    If X <> 0 And X < MinChp And Y <> 0 Then
                        MinChp = X
                        MinChpIndex = m
                        SChp = Y
                    End If
                Next m
                If MinChpIndex <> -1 Then
                    Chp = MinChp
                    Chp2 = SChp
                    OK = True
                Else
                    Exit Do
                End If
            End If
            If OK Then
                If CW Then
                    NTextColor = CWord(n).Color
                    WordForOut = WordForFinding
                Else
                    NTextColor = CRange(MinChpIndex).Color
                    WordForOut = Mid(s, Chp, Chp2 - Chp + 1)
                End If
                PosFromChar = SendMessage(ColorTextBox.hwnd, EM_POSFROMCHAR, chIndex + Chp - 1, 1)
                'если слово не выделено:
                If chIndex + Chp - 1 > SelStart + SelLength Or chIndex + Chp - 1 + Len(WordForOut) < SelStart Or Not Selected Then
                    If CurrentTextColor <> NTextColor Then
                        SetBkColor TexthDC, NColor
                        SetTextColor TexthDC, NTextColor
                        CurrentTextColor = NTextColor
                    End If
                    TextOut TexthDC, LoWord(PosFromChar), HiWord(PosFromChar), WordForOut, Len(WordForOut)
                Else
                    'если всё слово выделено:
                    If (chIndex + Chp - 1) >= SelStart And (chIndex + Chp - 1 + Len(WordForOut)) <= (SelStart + SelLength) Then
                        If CurrentTextColor <> HLTextColor Then
                            SetBkColor TexthDC, HLColor
                            SetTextColor TexthDC, HLTextColor
                            CurrentTextColor = HLTextColor
                        End If
                        TextOut TexthDC, LoWord(PosFromChar), HiWord(PosFromChar), WordForOut, Len(WordForOut)
                    Else
                        'полслова выделено, а полслова нет
                        For i = chIndex + Chp - 1 To chIndex + Chp - 1 + Len(WordForOut) - 1
                            If i >= SelStart And i < SelStart + SelLength Then
                                If CurrentTextColor <> HLTextColor Then
                                    SetBkColor TexthDC, HLColor
                                    SetTextColor TexthDC, HLTextColor
                                    CurrentTextColor = HLTextColor
                                End If
                            Else
                                If CurrentTextColor <> NTextColor Then
                                    SetBkColor TexthDC, NColor
                                    SetTextColor TexthDC, NTextColor
                                    CurrentTextColor = NTextColor
                                End If
                            End If
                            TextOut TexthDC, LoWord(PosFromChar) + (i - (chIndex + Chp - 1)) * CharWidth, HiWord(PosFromChar), Mid(WordForOut, i - (chIndex + Chp - 1) + 1, 1), 1
                        Next i
                    End If
                End If
            End If
        Loop
    End If
    n = n + 1
    If Not CW Then Exit Do
    If CW And n > UBound(CWord) Then CW = False
Loop
ShowCaret ColorTextBox.hwnd
End Sub
 
Public Sub CreateColorTextBox(TextBox As TextBox, ParentForm As Form)
Set ColorTextBox = TextBox
Set ColorTextBoxParentForm = ParentForm
PrepareTextBox
PrepareVars
HookTextBox
End Sub
 
Public Sub DestroyColorTextBox()
UnHookTextBox
ReDim CWord(0)
ReDim CRange(0)
ReleaseDC ColorTextBox.hwnd, TexthDC
DeleteObject hPen
ColorTextBox.Refresh
Set ColorTextBox = Nothing
Set ColorTextBoxParentForm = Nothing
End Sub
 
Private Sub HookTextBox()
PrevProc = SetWindowLong(ColorTextBox.hwnd, GWL_WNDPROC, AddressOf TextBoxWindowProc)
End Sub
 
Private Sub UnHookTextBox()
SetWindowLong ColorTextBox.hwnd, GWL_WNDPROC, PrevProc
End Sub
 
Public Function TextBoxWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim ReDraw As Boolean
If uMsg = WM_CHAR And wParam = VK_BACK Then
    If Back_Pressed Then
        uMsg = 0
        ReDraw = True
    End If
End If
If uMsg = WM_CHAR And wParam = VK_TAB Then
    If (GetKeyState(VK_SHIFT) And &HF0000000) Then
        ShiftTab_Pressed
    Else
        Tab_Pressed
    End If
    uMsg = 0
    ReDraw = True
End If
 
TextBoxWindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_CHAR Then DrawCurrentLine
If uMsg = WM_PAINT _
   Or uMsg = WM_LBUTTONUP _
   Or uMsg = WM_PASTE _
   Or (uMsg = WM_MOUSEMOVE And wParam = MK_LBUTTON) _
   Or uMsg = WM_SETFOCUS _
   Or uMsg = WM_KILLFOCUS _
   Or ReDraw _
   Or uMsg = WM_KEYDOWN _
   Or uMsg = WM_CHAR _
Then PaintAllLines uMsg <> WM_KILLFOCUS
If uMsg = WM_KILLFOCUS Then SetTabStop True
If uMsg = WM_SETFOCUS Then SetTabStop False
If ((uMsg = WM_HSCROLL Or uMsg = WM_VSCROLL) And LoWord(wParam) = SB_ENDSCROLL) Or uMsg = WM_MOUSEWHEEL Then DrawVLines
End Function
 
Public Function LoWord(DWord As Long) As Integer
LoWord = IIf(DWord And &H8000&, DWord Or &HFFFF0000, DWord And &HFFFF&)
End Function
 
Public Function HiWord(DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ &H10000
End Function
 
Private Sub PaintAllLines(Selected As Boolean)
Dim FirstVisibleLine    As Long, _
    VisibleLineCount    As Long, _
    R                   As RECT, _
    i                   As Long, _
    LineCount           As Long
LineCount = SendMessage(ColorTextBox.hwnd, EM_GETLINECOUNT, 0, 0)
FirstVisibleLine = SendMessage(ColorTextBox.hwnd, EM_GETFIRSTVISIBLELINE, 0, 0)
SendMessage ColorTextBox.hwnd, EM_GETRECT, 0, R
VisibleLineCount = Int((R.Bottom - R.Top) / CharHeight)
Debug.Print CStr(VisibleLineCount)
For i = FirstVisibleLine To FirstVisibleLine + VisibleLineCount
    If i >= VisibleLineCount + FirstVisibleLine Then Exit For
    PaintLine i, Selected
Next i
End Sub
 
Private Sub DrawLine(LineIndex As Long)
Dim s           As String, _
    PosFromChar As Long, _
    chIndex     As Long
chIndex = SendMessage(ColorTextBox.hwnd, EM_LINEINDEX, LineIndex, 0&)
s = Space(SendMessage(ColorTextBox.hwnd, EM_LINELENGTH, chIndex, 0&))
SendMessage ColorTextBox.hwnd, EM_GETLINE, LineIndex, ByVal s
HideCaret ColorTextBox.hwnd
PosFromChar = SendMessage(ColorTextBox.hwnd, EM_POSFROMCHAR, chIndex, 1)
If CurrentTextColor <> CTextColor Then
    SetBkColor TexthDC, CColor
    SetTextColor TexthDC, CTextColor
    CurrentTextColor = CTextColor
End If
TextOut TexthDC, LoWord(PosFromChar), HiWord(PosFromChar), s, Len(s)
ShowCaret ColorTextBox.hwnd
End Sub
 
Private Sub DrawCurrentLine()
DrawLine SendMessage(ColorTextBox.hwnd, EM_LINEFROMCHAR, ColorTextBox.SelStart, 0)
End Sub
 
Private Sub DrawVLines()
Dim ret As Long, _
    R   As RECT
SendMessage ColorTextBox.hwnd, EM_GETRECT, 0, R
MoveToEx TexthDC, 0, 0, ret
LineTo TexthDC, 0, R.Bottom
MoveToEx TexthDC, R.Right, 0, ret
LineTo TexthDC, R.Right, R.Bottom
End Sub
 
Private Sub SetTabStop(Value As Boolean)
Dim i As Long
On Error Resume Next
For i = 0 To ColorTextBoxParentForm.Controls.Count - 1
   ColorTextBoxParentForm.Controls(i).TabStop = Value
Next
End Sub
 
Private Sub Tab_Pressed()
Dim i           As Long, _
    SelLength   As Long, _
    k           As Long, _
    s()         As String, _
    SelStart    As Long
SelLength = ColorTextBox.SelLength
If SelLength = 0 Then
    ColorTextBox.SelText = "    "
Else
    SelStart = ColorTextBox.SelStart
    s = Split(ColorTextBox.SelText, vbCrLf)
    For i = 0 To UBound(s)
        If s(i) <> "" Then
            s(i) = "    " + s(i)
            k = k + 4
        End If
    Next i
    ColorTextBox.SelText = Join(s, vbCrLf)
    ColorTextBox.SelStart = SelStart
    ColorTextBox.SelLength = SelLength + k
End If
End Sub
 
Private Function Back_Pressed() As Boolean
Dim SelStart    As Long, _
    s           As String
SelStart = ColorTextBox.SelStart
s = ColorTextBox.Text
If SelStart < 4 Then
    Back_Pressed = False
    Exit Function
End If
If Mid(s, SelStart - 3, 4) = "    " Then
    s = Mid(s, 1, SelStart - 4) + Mid(s, SelStart + 1)
    ColorTextBox.SelStart = SelStart - 4
    ColorTextBox.SelLength = 4
    ColorTextBox.SelText = ""
    Back_Pressed = True
Else
    Back_Pressed = False
End If
End Function
 
Private Sub ShiftTab_Pressed()
Dim i           As Long, _
    SelLength   As Long, _
    k           As Long, _
    s()         As String, _
    n           As Long, _
    m           As Long, _
    SelStart    As Long
SelLength = ColorTextBox.SelLength
If SelLength = 0 Then Exit Sub
SelStart = ColorTextBox.SelStart
s = Split(ColorTextBox.SelText, vbCrLf)
For i = 0 To UBound(s)
    If s(i) <> "" Then
        m = Len(s(i))
        n = m - Len(LTrim(s(i))) 'количество левых пробелов
        If n <> 0 Then
            If n >= 4 Then
                s(i) = Space(n - 4) + LTrim(s(i))
            Else
                s(i) = LTrim(s(i))
            End If
            k = k + m - Len(s(i))
        End If
    End If
Next i
ColorTextBox.SelText = Join(s, vbCrLf)
ColorTextBox.SelStart = SelStart
ColorTextBox.SelLength = SelLength - k
End Sub



Форма

Кликните здесь для просмотра всего текста
Visual Basic
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
Option Explicit
 
Private Type RECT
        Left    As Long
        Top     As Long
        Right   As Long
        Bottom  As Long
End Type
 
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
 
Private Sub Form_Load()
    Dim s As String
 
    CreateColorTextBox Text1, Me
 
    AddColorWord "Когда", vbRed
 
    AddColorWord "MID", 817920
 
    AddColorRange "'", Chr(0), 9605778
    AddColorRange """", """", vbRed
 
    Text1.Text = s
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyColorTextBox
End Sub
Миниатюры
Как выделить текст?  
3
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 09:34  [ТС]
Ого, это для того чтобы выделить одно слово, надо прописывать такое кол-во строк кода..жесть.
0
24.07.2013, 09:36

Не по теме:

Зато красиво :D

0
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 09:41  [ТС]
Точно..

Добавлено через 2 минуты
а если мне нужно выделить еще какое нибудь слово, только зеленым, я могу добавить строку
Visual Basic
1
 AddColorWord "Где", vbGreen
после этой строки
Visual Basic
1
AddColorWord "Когда", vbRed
0
es geht mir gut
 Аватар для SoftIce
11274 / 4760 / 1183
Регистрация: 27.07.2011
Сообщений: 11,439
24.07.2013, 09:43
Цитата Сообщение от arsen1101995 Посмотреть сообщение
а если мне нужно выделить еще какое нибудь слово, только зеленым
0
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 09:46  [ТС]
Спасибо
0
Модератор
10057 / 3902 / 884
Регистрация: 22.02.2013
Сообщений: 5,853
Записей в блоге: 79
24.07.2013, 13:44
Можно использовать Rich TextBox, тогда код можно значительно сократить
0
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 14:59  [ТС]
А можете на примере показать?
0
Модератор
10057 / 3902 / 884
Регистрация: 22.02.2013
Сообщений: 5,853
Записей в блоге: 79
24.07.2013, 17:22
Можно не только цвет текста менять а любые параметры форматирования, в данном примере цвет текста и фона.
Кликните здесь для просмотра всего текста
Visual Basic
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Const EM_SETCHARFORMAT = (&H400 + 68)
Private Const EM_SETSEL = &HB1
 
Private Const LF_FACESIZE = 32
Private Const CFM_COLOR = &H40000000
Private Const CFM_BACKCOLOR = &H4000000
 
Private Type CHARFORMAT2
    cbSize As Integer
    wPad1 As Integer
    dwMask As Long
    dwEffects As Long
    yHeight As Long
    yOffset As Long
    crTextColor As Long
    bCharSet As Byte
    bPitchAndFamily As Byte
    szFaceName(0 To LF_FACESIZE - 1) As Byte
    wPad2 As Integer
    
    wWeight As Integer
    sSpacing As Integer
    crBackColor As Long
    lLCID As Long '
    dwReserved As Long
    sStyle As Integer
    wKerning As Integer
    bUnderlineType As Byte
    bAnimation As Byte
    bRevAuthor As Byte
    bReserved1 As Byte
End Type
 
Private Sub SetColor(cStart As Integer, cEnd As Integer, Color As Long, Optional BackColor As Long = vbWhite)
    Dim CF2 As CHARFORMAT2
    
    CF2.dwMask = CFM_COLOR Or CFM_BACKCOLOR
    CF2.crTextColor = Color
    CF2.crBackColor = BackColor
    CF2.cbSize = Len(CF2)
    
    SendMessage rtbText.hwnd, EM_SETSEL, cStart, cEnd
    SendMessage rtbText.hwnd, EM_SETCHARFORMAT, 1, VarPtr(CF2)
    SendMessage rtbText.hwnd, EM_SETSEL, cStart, cStart
End Sub
Private Sub Form_Load()
    rtbText.Text = "Допустим, у меня есть строковая переменная, которая содержит текст,как можно выделить красным цветом содержание этой переменной?"
 
    SetColor 22, 42, vbGreen, vbBlue
    SetColor 61, 66, vbYellow, vbMagenta
    SetColor 86, 93, vbRed
End Sub
Миниатюры
Как выделить текст?  
Вложения
Тип файла: rar ColorText.rar (2.0 Кб, 15 просмотров)
2
0 / 0 / 0
Регистрация: 07.03.2013
Сообщений: 327
24.07.2013, 17:56  [ТС]
Ооооу, четко, то что надо)Спасибо
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
24.07.2013, 17:56
Помогаю со студенческими работами здесь

Как выделить текст в С++?
В Norton Commander при навигации использовалось выделение, как здесь на картинке. Вот как таким образом &quot;выделить&quot; текст в...

Как выделить нативный текст
Приветствую! Подсобите советом. Как сделать что б при открытии файла с уже набранным текстом, отдельные его абзацы были...

Как выделить текст в textBox
Пробую так textBox1.SelectionStart = 0; textBox1.SelectionLength = textBox1.Text.Length; ...

Notepad++ как выделить текст
Привет! Вообщем есть документ(база данных Mysql) и в нём 600 000 строк и вес 43 Mb. Мне надо удалить- к примеру текст начиная с 200 000...

Как выделить текст в Edit?
Можно ли чтобы при нажатии на кнопку, текст в Edit выделялся и можно было сразу набирать на клавиатуре, то что будет записываться в Edit?...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
15
Ответ Создать тему
Новые блоги и статьи
Оттенки серого
Argus19 18.03.2026
Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++
8Observer8 17.03.2026
Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip
Символические и жёсткие ссылки в Linux.
algri14 15.03.2026
Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .
[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора
ФедосеевПавел 14.03.2026
Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .
делаю науч статью по влиянию грибов на сукцессию
anaschu 13.03.2026
прикрепляю статью
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++
8Observer8 10.03.2026
Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:
Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE
8Observer8 10.03.2026
Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .
Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки
Neotwalker 08.03.2026
Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru