wenn es denn unbedingt sein muss... heute wuerde ich aber lieber scintilla oder sowas nehmen.
Code: Alles auswählen
; PB V4.0keine_ahnung
Prototype PrevProc(hwnd,uMsg,wParam,lParam)
Define PrevEditProc.PrevProc = 0
Define hwnd
Define hEdit
Define i
Define event
Macro DrawWord(word,color)
If Not CompareMemoryString(*ptr_char,@word,#PB_String_NoCase,Len(word)) ; wort vergleichen
SetTextColor_(hdc,color) ; farbe setzen
SendMessage_(hwnd, #EM_POSFROMCHAR, @rect, first_index + ((*ptr_char - @Buffer)/SizeOf(character))) ; aktuelle Position des Chars holen
DrawText_(hdc,*ptr_char,Len(word), rect, 0) ; und strng ueber den alten malen
EndIf
EndMacro
Procedure EditCallback(hwnd,uMsg,wParam,lParam)
Shared PrevEditProc.PrevProc
Protected Buffer.s
Protected first_index.l
Protected last_index.l
Protected rect.RECT
Protected TextRange.TEXTRANGE
Protected *ptr_char.Character
Protected hdc.l , hreg.l
Protected hFont.l = GetStockObject_(#DEFAULT_GUI_FONT)
Protected result
; WM_PAINT abfangen
If uMsg = #WM_PAINT
; alten Calback aufrufen um alles zu zeichnen
result = PrevEditProc(hwnd,uMsg,wParam,lParam)
SendMessage_(hwnd,#EM_GETRECT,0,@rect)
; Charakter index des ersten und letzten Zeichens auslesen.
first_index = SendMessage_(hwnd,#EM_CHARFROMPOS,0,rect)
last_index = SendMessage_(hwnd,#EM_CHARFROMPOS,0,@rect\right)
If (last_index-first_index) > 0 ; mehr als 0 Zeichen
Buffer = Space(last_index-first_index) ; PB String genug speicher geben
TextRange\chrg\cpMin = first_index
TextRange\chrg\cpMax = last_index
TextRange\lpstrText = @Buffer
SendMessage_(hwnd,#EM_GETTEXTRANGE,0,TextRange) ; Text in buffer schreiben lassen
hdc = GetDC_(hwnd)
hreg = CreateRectRgn_(rect\left,rect\top,rect\right,rect\bottom) ; eine Region erstellen
SelectObject_(hdc,hreg) ; Region zuweisen
SetBkMode_(hdc,#TRANSPARENT) ; hintergrund auf transparent setzen
SelectObject_(hdc,hFont) ; !Wichtig , Font setzen
; Es muss der gleiche Font sein, inc. Eigenschaften
; er darf weder breiter noch groesser sein, als der normale Font.
*ptr_char = @Buffer
While *ptr_char\c
DrawWord("hallo",$0000FF) ; Achtung Macro !
DrawWord("du",$FF0000) ; Achtung Macro !
DrawWord("da",$008000) ; Achtung Macro !
*ptr_char + SizeOf(Character)
Wend
DeleteObject_(hreg) ; region wieder loeschen
ReleaseDC_(hwnd,hdc)
EndIf
; und raus hier
ProcedureReturn result
EndIf
; sonstige Nachrichten an den alten Callback weiterleiten
ProcedureReturn PrevEditProc(hwnd,uMsg,wParam,lParam)
EndProcedure
hwnd = OpenWindow(0,0,0,500,500,"TEST")
hEdit = EditorGadget(0,0,0,500,500)
PrevEditProc = SetWindowLong_(hEdit,#GWL_WNDPROC,@EditCallback())
For i = 0 To 1000
AddGadgetItem(0,i," Hallo du da")
Next
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow