It works reasonably well, but the line being edited flickers a lot.
Any simple tips on how to fix / improve this? Also any performance optimizations would be welcome!
If possible, I'd rather keep using the "drawtext_" method rather than alternatives.
Thanks!
PS This is based on code I once found on the German forum, but I can't remember who posted it.
Code: Select all
Prototype PrevProc(hwnd,uMsg,wParam,lParam)
PrevEditProc.PrevProc = 0
Macro RedrawCharacter(word)
If Not CompareMemoryString(*ptr_char,@word,#PB_String_NoCase,Len(word))
SetBkColor_(hdc,$839E9E)
SendMessage_(hwnd, #EM_POSFROMCHAR, @rect, first_index + ((*ptr_char - @Buffer)/SizeOf(character)))
DrawText_(hdc,*ptr_char,Len(word), rect, 0)
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 = FontID(1)
Protected result
If uMsg = #WM_PAINT
result = PrevEditProc(hwnd,uMsg,wParam,lParam)
SendMessage_(hwnd,#EM_GETRECT,0,@rect)
first_index = SendMessage_(hwnd,#EM_CHARFROMPOS,0,rect)
last_index = SendMessage_(hwnd,#EM_CHARFROMPOS,0,@rect\right)
If (last_index-first_index) > 0
Buffer = Space(last_index-first_index)
TextRange\chrg\cpMin = first_index
TextRange\chrg\cpMax = last_index
TextRange\lpstrText = @Buffer
SendMessage_(hwnd,#EM_GETTEXTRANGE,0,TextRange)
hdc = GetDC_(hwnd)
hreg = CreateRectRgn_(rect\left,rect\top,rect\right,rect\bottom)
SelectObject_(hdc,hreg)
SelectObject_(hdc,hFont)
*ptr_char = @Buffer
While *ptr_char\c
RedrawCharacter("*")
*ptr_char + SizeOf(Character)
Wend
DeleteObject_(hreg)
ReleaseDC_(hwnd,hdc)
EndIf
ProcedureReturn result
EndIf
ProcedureReturn PrevEditProc(hwnd,uMsg,wParam,lParam)
EndProcedure
OpenWindow(0,0,0,500,500,"TEST")
LoadFont(1, "Courier New", 14) : SetGadgetFont(-1, FontID(1))
hEdit = EditorGadget(0,0,0,500,500)
PrevEditProc = SetWindowLong_(hEdit,#GWL_WNDPROC,@EditCallback())
For i = 0 To 10
AddGadgetItem(0,i,"ITEM ***************************")
Next
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
