API и FreeBasic. (RichEdit Control: подстветка синтаксиса)
Данный туториал я не стал адаптировать полностью , но основные моменты, касающиеся подсветки, здесь приведены.
И так:
Подсветка синтаксиса - это предмет жарких дискуссий между создателями текстовых редакторов. Лучший метод (на мой взгляд) - это создать собственный edit control. Именно этот метод применяется во многих коммерческих приложениях. Тем не менее для тех из нас, у кого нет времени на создание подобного контрола, лучшим вариантом будет приспособить существующий контрол к нашим нуждам.
Давайте посмотрим, как может нам помочь RichEdit в реализации цветовой подсветки. Я должен сказать, что следующий метод "неверен": я всего лишь продемонстрирую ловушку, в которую угодили многие. RichEdit предоставляет сообщение EM_SETCHARFORMAT, которое позволяет вам менять цвет текста. На первый взгляд это именно то, что нам нужно (я знаю, потому что я стал одной из жертв этого подхода). Тем не менее, более детальное исследование покажет вам, что у данного сообщения есть несколько недостатков:
EM_SETCHARFORMAT работает либо со всем текстом сразу, либо только с тем, который сейчас выделен. Если вам потребуется изменить цвет определенного слова, вам сначала придется выделить его.
EM_SETCHARFORMAT очень медленна.
У нее есть проблемы с позицией курсора в контроле RichEdit.
Из всего вышеизложенного вы можете сделать вывод, что использование EM_SETCHARFORMAT - неправильный выбор. Я покажу вам "относительно верный" выбор.
Мой метод заключает только в том, чтобы подсвечивать только видимую часть текста. В этом случае скорость подсветки не будет зависеть от размера файла. Вне зависимости от того, как велик файл, только маленькая его часть видна на экране.
Как это сделать? Ответ прост:
Субклассируйте контрол RichEdit и обрабатывайте сообщение WM_PAINT внутри вашей оконной процедуры.
Когда она встречает сообщение WM_PAINT, вызывается оригинальная оконная функция, которая обновляет экран как обычно.
После этого мы перерисовываем слова, которые нужно отобразить другим цветом.
Пример ниже дает принцип подсвечивания слов, но в нем реализован абсолютно неправильный поиск ключевых слов. То есть в примере будут подсвечиваться 5 слов в установленной последовательности ("function","sub","end","goto","len") и раскладке букв. Если слова в тексте будут встречаться в другой последовательности, то подсветка для последних слетит. Для правильного поиска нужно посимвольное чтение, которое адаптировать с примера , насыщенного исключительно ассемблерными опкодами затруднительно, а реализовывать заново пока нет нужды. Более того, для тех кто будет осуществлять подсветку в своем редакторе, реализация поиска, предложенная автором будет тоже не в тему. В любом случае придется писать свою, но принцип самой подсветки будет полезен.
#INCLUDE "windows.bi" #INCLUDE "win/richedit.bi" Var hlib = LoadLibrary ("RICHED20.DLL") Dim msg As MSG 'структурированная переменная MSG Dim As WNDCLASSEX wc 'структурированная переменная WNDCLASSEX Dim As String NameClass="MyClass" ' переменная имени класса Dim As HINSTANCE Hinst=GetModuleHandle(0) ' хендл модуля Dim Shared As Long OldWndProc,richeditversion Dim Shared As ZString*20 ArrayWord(4) =>{"function","sub","end","goto","len"} ' функция сабкласса Function childproc(hwnd As HWND, Umsg As Uinteger,_ wparam As WPARAM, lparam As LPARAM) As Integer Select Case umsg Case WM_PAINT Dim As HDC hdc Dim As RECT rect,realRect Dim txtrange As TEXTRANGE Dim As ZString*(1024*10) buffer Dim As HRGN hRgn,hOldRgn HideCaret(hwnd) CallWindowProc(OldWndProc,hWnd,uMsg,wParam,lParam) hdc = GetDC(hWnd) SetBkMode(hdc,TRANSPARENT) SendMessage(hWnd,EM_GETRECT,0,@rect) Var fi=SendMessage(hWnd,EM_CHARFROMPOS,0,@rect) Var L = SendMessage(hWnd,EM_LINEFROMCHAR,fi,0) fi = SendMessage(hWnd,EM_LINEINDEX,L,0) txtrange.chrg.cpMin = fi txtrange.chrg.cpMax = SendMessage(hWnd,EM_CHARFROMPOS,0,@rect.right)+20 '+20 много,по идее надо выставлять по самому длинному слову realRect = Type(rect.left,rect.top,rect.right,rect.bottom) hRgn = CreateRectRgn(RealRect.left,RealRect.top,RealRect.right,RealRect.bottom) hOldRgn = SelectObject(hdc,hRgn) SetTextColor(hdc,&hFF0000) txtrange.lpstrText = @buffer SendMessage(hWnd,EM_GETTEXTRANGE,0,@txtrange) Dim As Integer find =1, posfind=1 CharLower(buffer) Do For i As Integer = 0 To 4 find = Instr(posfind,buffer,ArrayWord(i)) If find>0 Then SendMessage(hWnd,EM_POSFROMCHAR,@rect,find-1) DrawText(hdc,@ArrayWord(i),-1,@rect,0) posfind+=(Len(ArrayWord(i))-1) Exit For Endif Next Loop Until find=0 SelectObject(hdc,hOldRgn) DeleteObject(hRgn) ShowCaret(hwnd) DeleteDC(hdc) Case Else Return CallWindowProc(OldWndProc,hWnd,uMsg,wParam,lParam) End Select End Function ' функция класса Function wndproc(hwnd As HWND, msg As Uinteger,_ wparam As WPARAM, lparam As LPARAM) As Integer Static childEdit As HWND Select Case msg Case WM_DESTROY PostQuitMessage(0) Case WM_CREATE childEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "RICHEDIT20A", 0,_ WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or WS_VSCROLL Or ES_MULTILINE Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL,_ 10,10,200,200, hwnd, Cast(HMENU,1), 0, 0) SendMessage(childEdit,EM_SETTYPOGRAPHYOPTIONS,TO_SIMPLELINEBREAK,TO_SIMPLELINEBREAK) If SendMessage(childEdit,EM_GETTYPOGRAPHYOPTIONS,1,1)= 0 Then richeditversion = 2 Else richeditversion = 3 SendMessage(childEdit,EM_SETEDITSTYLE,1,1) Endif OldWndProc = SetWindowLong(childEdit,GWL_WNDPROC,@childproc) End Select Return DefWindowProc(hwnd,msg,wparam,lparam) End Function ' Заполнение структуры WNDCLASSEX With wc .cbSize=SizeOf(WNDCLASSEX) .style=CS_HREDRAW Or CS_VREDRAW .lpfnWndProc=@wndproc .hInstance=Hinst .hIcon=LoadIcon(0,IDI_WINLOGO) .hCursor=LoadCursor(0,IDC_ARROW) .hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME) .lpszClassName=StrPtr(NameClass) .hIconSm=.hIcon End With ' Регистрация класса окна If RegisterClassEx(@wc)=0 Then Print "Register error, press any key" Sleep End Endif 'Создание окна CreateWindowEx(0,NameClass,"RichEdit",_ WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,240,260,0,0,Hinst,0) ' Цикл сообщений While GetMessage(@msg,0,0,0) TranslateMessage(@msg) DispatchMessage(@msg) Wend FreeLibrary(hlib)
После того, как контрол RichEdit создан, нам нужно определить его версию.
Этот шаг необходим, так как поведение EM_POSFROMCHAR отличается в зависимости от
версии RichEdit, а EM_POSFROMCHAR жизненно важна для нашей процедуры подсветки.
Я не видел документированного способа определения версии RichEdit, поэтому я
пошел окольным путем. Я устанавливаю опцию, которая свойственна версии 3.0 и
немедленно возвращаю его значение. Если я могу получить значение, я предполагаю,
что версия этого контрола 3.0.
Если вы используете контрол RichEdit версии 3.0, вы можете заметить, что обновление цвета фонт на больших файлах занимает довольно много времени. Похоже, что эта проблема существует только в версии 3.0. Я нашел способ обойти это, заставив конрол эмулировать поведение контрола edit, послав сообщение EM_SETEDITSTYLE.
После того, как мы получили информацию о версии контрола, мы переходим к сабклассированию контрола RichEdit. Сейчас мы рассмотрим новую процедуру для обработки сообщений.
Function childproc(hwnd As HWND, Umsg As Uinteger,_ wparam As WPARAM, lparam As LPARAM) As Integer Select Case umsg Case WM_PAINT Dim As HDC hdc Dim As RECT rect,realRect Dim txtrange As TEXTRANGE Dim As ZString*(1024*10) buffer Dim As HRGN hRgn,hOldRgn HideCaret(hwnd) CallWindowProc(OldWndProc,hWnd,uMsg,wParam,lParam)
Мы обрабатываем сообщение WM_PAINT. Во-первых, мы прячем курсор, чтобы
избежать уродливых артефактов после подсветки. Затем мы передаем сообщение
оригинальной процедуре richedit, чтобы оно обновило окно. Когда CallWindowProc
возвращает управление, текст обновляется согласно его обычному цвету/бэкграунду.
Теперь мы можем сделать подсветку синтаксиса.
hdc = GetDC(hWnd) SetBkMode(hdc,TRANSPARENT)
Мы получаем хэндл контекста устройства и делаем бэкграунд текста прозрачными, чтобы при выводе нами текста использовался текущий бэкграундный цвет.
SendMessage(hWnd,EM_GETRECT,0,@rect) Var fi=SendMessage(hWnd,EM_CHARFROMPOS,0,@rect) Var L = SendMessage(hWnd,EM_LINEFROMCHAR,fi,0) fi = SendMessage(hWnd,EM_LINEINDEX,L,0)
Мы хотим получить видимый текст, поэтому сначала нам требуется узнать размеры области, которую необходимо форматировать, послав ему EM_GETRECT. Затем мы получаем индес ближайшего к левому верхнему углу символа с помощью сообщения EM_CHARFROMPOS. Как только мы получаем индекс первого символа, мы начинаем делать цветовую подсветку, начиная с этой позиции. Но эффект может быть не так хорош, как если бы начали с первого символа линии, в которой находится символ. Вот почему мне нужно было получить номер линии, в которой находится первый видимый символ, с помощью сообщения EM_LINEFROMCHAR. Чтобы получить первый символ этой линии, я посылаю сообщение EM_LINEINDEX.
txtrange.chrg.cpMin = fi
txtrange.chrg.cpMax = SendMessage(hWnd,EM_CHARFROMPOS,0,@rect.right)+20 '+20 много,по идее надо выставлять по самому длинному слову
Затем мы получаем последний видимый символ, посылая ему EM_CHARFROMPOS,
передавая нижний правый угол форматируемой области в lParam.
realRect = Type(rect.left,rect.top,rect.right,rect.bottom)
hRgn = CreateRectRgn(RealRect.left,RealRect.top,RealRect.right,RealRect.bottom)
hOldRgn = SelectObject(hdc,hRgn)
Во время подсветки синтаксиса, я заметил один побочный эффект этого
метода: если у контрола richedit'а есть отступ (который вы можете указать,
послав сообщение EM_SETMARGINS контролу RichEdit), DrawText пишет поверх него.
Поэтому мне требуется создать функцией CreateRectRgn ограничительный регион, в
который будут выводиться результат выполнения функций GDI.
(Нет в примере, но для теории неплохо знать) Затем нам требуется подсветить коментарии и убрать их с нашего пути. Когда подсвечены все комментарии, мы замещаем их нулями в нашем буфере, чтобы слова к комментарии не обрабатывались позже.
SetTextColor(hdc,&hFF0000) txtrange.lpstrText = @buffer SendMessage(hWnd,EM_GETTEXTRANGE,0,@txtrange)
Устанавливаем цвет подсветки слов . В структуру TEXTRANGE отправляем
указатель на наш буфер и переписываем наш буфер с помощью сообщения
EM_GETTEXTRANGE. Буфер в итоге будет состоять только из видимого объема текста с
небольшим запасом (вправо на 20 символов), который мы добавляли в сообщении
EM_CHARFROMPOS.
CharLower(buffer) Do For i As Integer = 0 To 4 find = Instr(posfind,buffer,ArrayWord(i)) If find>0 Then SendMessage(hWnd,EM_POSFROMCHAR,@rect,find-1) DrawText(hdc,@ArrayWord(i),-1,@rect,0) posfind+=(Len(ArrayWord(i))-1) Exit For Endif Next Loop Until find=0
Далее идет непутный поиск ключевого слова в буфере и как только хоть одно из слов будет найдено, с помощью сообщения EM_POSFROMCHAR получаем его позицию и с помощью DrawText отрисовываем.
Перевод на русский с оригинала: Aquila, адаптация материалов под FreeBasic: Станислав Будинов
