Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.64/11: Рейтинг темы: голосов - 11, средняя оценка - 4.64
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
#1

Notepad ++

27.09.2013, 20:23. Просмотров 1922. Ответов 23
Метки нет (Все метки)

Ребятки, может у кого есть исходник текстового редактора для HTML кода типа Notepad ++ или обычного блокнота с подсветкой тегов?? У меня курсовая на эту тему а я не могу такое написать.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.09.2013, 20:23
Ответы с готовыми решениями:

открытие текстового файла при помощи Notepad
Все перепробовал но ни как мне не удается открыть конкретный текстовый файл при...

Чтение из файлов типа .doc в открытые Notepad и WordPad
Здравствуйте, форумчане! Помогите, пожалуйста, решить следующую задачу. ...

Где взять Solarized Light Notepad Theme для Notepad++ ?
Где взять Solarized Light Notepad Theme для Notepad++ ?

Notepad++
добрый вечер! А кто подскажет как запустить код из Notepad++? Начал изучать...

Notepad++ и C++
Подскажите, пожалуйста, как связать Notepad++ с компилятором Borland C++?...

23
The trick
Модератор
7359 / 2578 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
27.09.2013, 20:30 #2
Делал контрол с подсветкой синтаксиса, так и не доделал. Если надо могу выложить
0
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
27.09.2013, 20:56  [ТС] #3
Цитата Сообщение от The trick Посмотреть сообщение
Если надо могу выложить
Я был бы тебе очень признателен
0
SoftIce
comment ca va
10443 / 3952 / 1008
Регистрация: 27.07.2011
Сообщений: 9,554
Завершенные тесты: 1
27.09.2013, 20:59 #4
Лучший ответ Сообщение было отмечено The trick как решение

Решение

Cricket93, посмотри, может что полезное для себя найдёшь...
2
Вложения
Тип файла: rar 111.rar (6.0 Кб, 21 просмотров)
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
27.09.2013, 21:11  [ТС] #5
SoftIce,
Именно то, что я искал!!! Осталось только HTML теги прописать
0
The trick
Модератор
7359 / 2578 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
27.09.2013, 22:09 #6
Лучший ответ Сообщение было отмечено как решение

Решение

Держи. Я там делал поддержку нумерации, брекпоинтов, выделение строки как в бейсике и еще фичи разные, компонент практически готов, его только надо немного доработать и отладить. К тому же он может работать с любыми шрифтами, не только с моноширинными.
4
Миниатюры
Notepad ++  
Вложения
Тип файла: rar CodeEditor.rar (59.5 Кб, 32 просмотров)
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
27.09.2013, 22:52  [ТС] #7
The trick,
Конечно весьма впечатляет, но мне не поверят что я писал этот код)))

Добавлено через 4 минуты
А подскажите пожалуйста как реализовать следующее:

Есть строка
Visual Basic
1
AddColorWord "<a href="URL"></a>", RGB(100, 25, 255)
Не могу сделать чтоб если в место "URL" можно было вставить любой текст. Тег просто перестает подсвечиваться. Я то понял почему, но решить эту задачку не могу.
0
The trick
Модератор
7359 / 2578 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
27.09.2013, 22:59 #8
Смотри AddColorRange
0
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
27.09.2013, 23:26  [ТС] #9
Цитата Сообщение от The trick Посмотреть сообщение
AddColorRange
То же самое

Добавлено через 2 минуты
Visual Basic
1
AddColorWord "<a href = " & ">", RGB(100, 25, 255)
Пишу <a href = > и все нормально, а если после = добавить текст то уже не то
0
The trick
Модератор
7359 / 2578 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
27.09.2013, 23:30 #10
Visual Basic
1
AddColorRange "<a href=", ">", vbGreen
1
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
28.09.2013, 10:01  [ТС] #11
А может можно реализовать и такое:
Например все, что под тегом <body></body> можно было бы свернуть нажав на + слева от тега.
0
locm
2138 / 866 / 113
Регистрация: 28.10.2011
Сообщений: 2,717
Записей в блоге: 6
28.09.2013, 11:16 #12
Цитата Сообщение от Cricket93 Посмотреть сообщение
Например все, что под тегом <body></body> можно было бы свернуть нажав на + слева от тега.
Бери Scintilla.
0
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
28.09.2013, 13:50  [ТС] #13
Цитата Сообщение от locm Посмотреть сообщение
Бери Scintilla.
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
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_EX_CLIENTEDGE = &H200
Private Const SCI_START = 2000
Private Const SCI_ADDTEXT = SCI_START + 1
Private Const SCI_SETSELBACK = SCI_START + 68
Private Declare Function CreateWindowEx Lib "USER32" _
    Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String, _
    ByVal dwStyle As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hWndParent As Long, _
    ByVal hMenu As Long, ByVal hInstance As Long, _
    lpParam As Any) As Long
Private Declare Function LoadLibrary Lib "Kernel32" _
    Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
    As Integer
Private Declare Function SendMessage Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Long) As Long
Private Declare Function SendMessageString Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Any) As Long
Private Declare Function SetWindowPos Lib "USER32" _
    (ByVal hWnd As Long, ByVal m As Long, _
    ByVal left As Long, ByVal top As Long, _
    ByVal width As Long, ByVal height As Long, _
    ByVal flags As Long) As Long
Dim sci As Long
 
Private Sub Form_Load()
    LoadLibrary ("SciLexer.DLL")
    sci = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", _
        "TEST", WS_CHILD Or WS_VISIBLE, 0, 0, 200, 200, _
        Form1.hWnd, 0, App.hInstance, 0)
    SendMessage sci, SCI_SETSELBACK, 1, &HFFEFD0
    SendMessageString sci, SCI_ADDTEXT, 16, "Hello non-Python"
End Sub
 
Private Sub Form_Resize()
    SetWindowPos sci, 0, 2, 2, Form1.width / 15 - 12, _
        Form1.height / 15 - 30, 0
End Sub
Оно?
0
locm
2138 / 866 / 113
Регистрация: 28.10.2011
Сообщений: 2,717
Записей в блоге: 6
28.09.2013, 13:57 #14
Цитата Сообщение от Cricket93 Посмотреть сообщение
Оно?
Да.
0
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
28.09.2013, 14:19  [ТС] #15
Цитата Сообщение от locm Посмотреть сообщение
Да.
Не, не то..
0
dev.Free
Заблокирован
28.09.2013, 14:37 #16
Как разукрасить HTML тэги в RichTextBox

Для этого нам необходимо добавить на форму два RichText Box-а, один назовём rchVisible, а второй rchHidden (у этого richtextbox необходимо установить свойство visible в false).

Далее, добавляем в форму нижеприведённый код. Не забудьте изменить в строке Open App.Path & " odbooks.htm" For Input As fnum имя файла на Ваш.

' Color the tags in the RichTextBox's text.
' This version is a little simple and does not
' ignores comment properly. It cannot handle nested
' brackets as in:
'
' <A HREF= <!-- here's a comment -->
' http://www.vb-helper.com>
'
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
Private Sub ColorTags(rch As RichTextBox)
Dim txt As String
Dim tag_open As Integer
Dim tag_close As Integer
 
    txt = rch.Text
    tag_close = 1
    Do
        ' See where the next tag starts.
        tag_open = InStr(tag_close, txt, "<")
        If tag_open = 0 Then Exit Do
       
        ' See where the tag ends.
        tag_close = InStr(tag_open, txt, ">")
        If tag_open = 0 Then tag_close = Len(txt)
       
        ' Color the tag.
        rch.SelStart = tag_open - 1
        rch.SelLength = tag_close - tag_open + 1
        rch.SelColor = vbRed
    Loop
End Sub
 
' Load the file.
Private Sub Form_Load()
Dim fnum As Integer
Dim txt As String
 
    ' Move the hidden text box so it cannot be seen.
    rchHidden.Move -rchHidden.Width - 120, 0
   
    ' Load the file.
    fnum = FreeFile
    Open App.Path & " odbooks.htm" For Input As fnum
    txt = Input$(LOF(fnum), fnum)
    rchHidden.Text = txt
    Close fnum
 
    ' Color the HTML tags.
    ColorTags rchHidden
 
    ' Copy the result to the visible text box.
    rchHidden.SelStart = 0
    rchHidden.SelLength = Len(rchHidden.Text)
    rchVisible.SelStart = 0
    rchVisible.SelLength = Len(rchVisible.Text)
    rchVisible.SelRTF = rchHidden.SelRTF
End Sub
Private Sub Form_Resize()
    rchVisible.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
1
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
28.09.2013, 14:43  [ТС] #17
inv.DS, У меня текстовый редактор для проектирования веб-страниц.

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
Option Explicit
 
'Scintilla
 
'Private Const WS_CHILD = &H40000000
'Private Const WS_VISIBLE = &H10000000
'Private Const WS_EX_CLIENTEDGE = &H200
'Private Const SCI_START = 2000
'Private Const SCI_ADDTEXT = SCI_START + 1
'Private Const SCI_SETSELBACK = SCI_START + 68
'Private Declare Function CreateWindowEx Lib "USER32" _
    Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String, _
    ByVal dwStyle As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hWndParent As Long, _
    ByVal hMenu As Long, ByVal hInstance As Long, _
    lpParam As Any) As Long
'Private Declare Function LoadLibrary Lib "Kernel32" _
    Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
    As Integer
'Private Declare Function SendMessage Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Long) As Long
'Private Declare Function SendMessageString Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Any) As Long
'Private Declare Function SetWindowPos Lib "USER32" _
    (ByVal hWnd As Long, ByVal m As Long, _
    ByVal left As Long, ByVal top As Long, _
    ByVal width As Long, ByVal height As Long, _
    ByVal flags As Long) As Long
'Dim sci As Long
'//////////////////////////////////////////////////////////////
 
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()
 
'Scintilla
'LoadLibrary ("SciLexer.DLL")
'   sci = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", _
        "TEST", WS_CHILD Or WS_VISIBLE, 0, 0, 200, 200, _
        Form1.hWnd, 0, App.hInstance, 0)
'    SendMessage sci, SCI_SETSELBACK, 1, &HFFEFD0
'    SendMessageString sci, SCI_ADDTEXT, 16, "Hello non-Python"
'/////////////////////////////////////////////////////////////////////
 
Dim s As String
 
CreateColorTextBox Text1, Me
 
' ГЋГ±Г*îâГ*ûå ГІГҐГЈГЁ ГЁ ГЁГµ Г*òðèáóòû
AddColorWord "<html>", vbBlue
AddColorWord "</html>", vbBlue
AddColorWord "<head>", vbBlue
AddColorWord "</head>", vbBlue
AddColorWord "<body>", vbBlue
AddColorWord "</body>", vbBlue
AddColorRange "<base", ">", vbBlue
AddColorRange "<meta", ">", vbBlue
AddColorWord "<title>", vbBlue
AddColorWord "</title>", vbBlue
 
'Г’Г*áëèöГ*
AddColorRange "<table", ">", vbBlue
AddColorRange "<td", ">", vbBlue
AddColorRange "<tr", ">", vbBlue
AddColorWord "</table>", vbBlue
AddColorWord "</td>", vbBlue
AddColorWord "</tr>", vbBlue
AddColorWord "</th>", vbBlue
AddColorWord "<th>", vbBlue
 
' Г’ГҐГЈГЁ ôîðìГ*òèðîâГ*Г*ГЁГї ГІГҐГЄГ±ГІГ*
AddColorWord "<pre>", vbGreen
AddColorWord "</pre>", vbGreen
AddColorWord "</h1>", vbGreen
AddColorWord "<h1>", vbGreen
AddColorWord "</h2>", vbGreen
AddColorWord "<h2>", vbGreen
AddColorWord "</h3>", vbGreen
AddColorWord "<h3>", vbGreen
AddColorWord "</h4>", vbGreen
AddColorWord "<h4>", vbGreen
AddColorWord "</h5>", vbGreen
AddColorWord "<h5>", vbGreen
AddColorWord "</h6>", vbGreen
AddColorWord "<h6>", vbGreen
AddColorWord "</b>", vbGreen
AddColorWord "<b>", vbGreen
AddColorWord "</i>", vbGreen
AddColorWord "<i>", vbGreen
AddColorWord "</tt>", vbGreen
AddColorWord "<tt>", vbGreen
AddColorWord "</kbd>", vbGreen
AddColorWord "<kbd>", vbGreen
AddColorWord "</var>", vbGreen
AddColorWord "<var>", vbGreen
AddColorWord "</em>", vbGreen
AddColorWord "<em>", vbGreen
AddColorWord "</font>", vbGreen
AddColorRange "<font", ">", vbGreen
 
' Ãèïïåðññûëêè
AddColorRange "<a", ">", vbRed
AddColorWord "</a>", vbRed
AddColorRange "<atarget", ">", vbRed
AddColorRange "<link", ">", vbRed
 
' ÔîðìГ*òèðîâГ*Г*ГЁГҐ
AddColorWord "<p>", RGB(100, 25, 255)
AddColorWord "</p>", RGB(100, 25, 255)
AddColorWord "<wbr>", RGB(100, 25, 255)
AddColorWord "<br>", RGB(100, 25, 255)
AddColorWord "</ol>", RGB(100, 25, 255)
AddColorWord "<ol>", RGB(100, 25, 255)
AddColorWord "<li>", RGB(100, 25, 255)
AddColorWord "</ul>", RGB(100, 25, 255)
AddColorWord "<ul>", RGB(100, 25, 255)
AddColorRange "<div", ">", RGB(100, 25, 255)
 
'ГѓГ°Г*ГґГЁГ·ГҐГ±ГЄГЁГҐ ýëåìåГ*ГІГ»
AddColorRange "<img", ">", 817920
AddColorRange "<hr", ">", 817920
 
'Ôðåéìû
AddColorRange "<frameset", ">", vbRed
AddColorRange "<noframes", ">", vbRed
AddColorWord "</frameset>", vbRed
AddColorWord "</noframes>", vbRed
AddColorWord "<frame>", vbRed
AddColorRange "<iframe", ">", vbRed
 
'Ôîðìû
AddColorWord "<form>", RGB(300, 25, 255)
AddColorWord "</form>", RGB(300, 25, 255)
AddColorWord "<option>", RGB(300, 25, 255)
AddColorRange "<textarea", ">", RGB(300, 25, 255)
AddColorRange "<input", ">", RGB(300, 25, 255)
 
'Âñå,Г·ГІГ® Г§Г* ' ГЁ "
AddColorRange "'", Chr(0), 9605778
AddColorRange """", """", vbMagenta
 
Text1.Text = s
End Sub
Sub Red(moya_funczia As String)
  AddColorWord moya_funczia, vbRed
End Sub
 
Private Sub Form_Resize()
'Scintilla
    'SetWindowPos sci, 0, 2, 2, Form1.width / 15 - 12, _
        Form1.height / 15 - 30, 0
'////////////////////////////////////////////////////////////
 
Dim R As RECT
GetClientRect Me.hWnd, R
MoveWindow Text1.hWnd, 0, 0, R.Right, R.Bottom, True
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyColorTextBox
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
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
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, Lo
0
locm
28.09.2013, 15:13
  #18

Не по теме:

Цитата Сообщение от Cricket93 Посмотреть сообщение
Не, не то..
Вам нужен текстовый редактор типа Notepad++? Знаете что он на основе Scintilla?
Если Scintilla это не то, значит вам нужен другой редактор, не такой как Notepad++.

0
Cricket93
143 / 44 / 1
Регистрация: 06.11.2012
Сообщений: 283
28.09.2013, 15:22  [ТС] #19
Цитата Сообщение от locm Посмотреть сообщение
Вам нужен текстовый редактор типа Notepad++?
Именно.
Цитата Сообщение от locm Посмотреть сообщение
Знаете что он на основе Scintilla?
У меня vb отказывается подключать к проекту этот компонент. Я вроде с официального сайта качал.

Может скинете ссылку?
0
locm
2138 / 866 / 113
Регистрация: 28.10.2011
Сообщений: 2,717
Записей в блоге: 6
28.09.2013, 15:27 #20
Цитата Сообщение от Cricket93 Посмотреть сообщение
У меня vb отказывается подключать к проекту этот компонент.
Зачем подключать?
Это обычная DLL и из нее нужно вызывать функции как вы делаете с WinAPI.
0
28.09.2013, 15:27
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
28.09.2013, 15:27

Notepad
Просьба помогите сделать на с#, сам делал на delphi. исходники из delphi и...

Notepad ++
Подскажите пожалуйста решение следующих задач на языке Notepad++ 1. Даны два...

C# и notepad
Привет всем. Написала программу, где при нажатии кнопки открывается...


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

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru