Editorgadget line numbers possible??

zapman* · Post by zapman* » Tue Oct 02, 2007 3:15 pm

Thanks for this code.

I've adapted it to PB 4 and improved to allow zoom in and out whith CTRL + MouseWheel

With this version, the line numbers also move better when scrolling the text.

Code: Select all


Global hLnFont,OldRedProc,mzoom,mspos,mlineno


Procedure FindInRichEdit(REGadgetID.l,SearchString$,startPos.l,MATCHCASE.l,WHOLEWORD.l,UP.l) 
  ; By Zapman 
  FindParam.findtext\chrg\cpMin = startPos -1
  FindParam.findtext\chrg\cpMax = -1 
  FindParam\lpstrText = @SearchString$ 
  Flags = (MatchCase*#FR_MATCHCASE) | (WHOLEWORD*#FR_WHOLEWORD) 
  If UP = 0 : Flags | #FR_DOWN : EndIf 
  Res = SendMessage_(REGadgetID, #EM_FINDTEXT , Flags, FindParam) 
  ProcedureReturn Res + 1 
EndProcedure 
; 
mspos = -1
;
Procedure DrawLineNumbers(REGadgetID) 

  hDC = GetDC_(REGadgetID) 
  GetClientRect_(REGadgetID, rc.RECT) 
  rc\right = 33 
  
  OldObject = SelectObject_(hDC, hLnFont) 
  p.point\x = 0:p\y = 0
  nchar=SendMessage_(REGadgetID, #EM_CHARFROMPOS, 0, @p)
  
  FillRect_(hDC, rc, 0)
  
  SetBkMode_(hDC, #TRANSPARENT) 
  SetTextColor_(hDC, $A0A0A0) 
  HRGN = CreateRectRgn_(rc\left,rc\top,rc\right,rc\bottom) 
  SelectClipRgn_(hDC,HRGN) 
  rc\right -4 

  mrctop = rc\top 
  SendMessage_(REGadgetID, #EM_GETZOOM, @Zoomnumerator, @Zoomdenominator) 
  If Zoomnumerator>200 
    mrctop + (5*Zoomnumerator/Zoomdenominator) 
  ElseIf Zoomnumerator>150 
    mrctop + (3*Zoomnumerator/Zoomdenominator) 
  ElseIf Zoomnumerator>110 
    mrctop + (2*Zoomnumerator/Zoomdenominator) 
  EndIf 
  ypos = -1 
  LengthParam.GETTEXTLENGTHEX\flags = 0 
  LengthParam.GETTEXTLENGTHEX\codepage = 1200 
  length = SendMessage_(REGadgetID, #EM_GETTEXTLENGTHEX,LengthParam,0)
  ;
  p.point\x = 0:p\y = 0
  nchar=SendMessage_(REGadgetID, #EM_CHARFROMPOS, 0, @p)
  If nchar<>mspos
    mspos = nchar
    ;
    ; Tips to quickly count how much carriage returns are before the current position
    lineno = 1 
    If nchar>0
      *txbuffer = GlobalAlloc_(0,(nchar*2)+2)
      If *txbuffer
        txRange.textrange\chrg\cpMin = 0
        txRange\chrg\cpMax = nchar
        txRange\lpstrText = *txbuffer
        SendMessage_(REGadgetID, #EM_GETTEXTRANGE,0,txRange)
        PrecText$ = PeekS(*txbuffer)
        GlobalFree_(*txbuffer)
        lineno=Len(PrecText$)-Len(ReplaceString(PrecText$,Chr(13),""))
      EndIf
    EndIf
    ; That's all folks!
    mlineno = lineno
  Else
    lineno = mlineno
  EndIf
  ;
  Repeat 
    ypos = SendMessage_(REGadgetID, #EM_POSFROMCHAR , nchar,0) &$FFFF0000 
    ypos/$10000 
    If ypos>-20 And ypos<(rc\bottom+20) 
      buffer.s = Str(lineno) 
      rc\top= mrctop + ypos 
      DrawText_(hDC, @buffer, -1, rc, #DT_RIGHT) 
    EndIf 
    nchar = FindInRichEdit(REGadgetID,Chr(13),nchar+1,0,0,0) 
    lineno+1 
  Until nchar = 0 Or nchar >length Or ypos>=(rc\bottom+20) 

  MoveToEx_(hDC, rc\right+3, 0, #Null) 
  Pen = CreatePen_(#PS_SOLID,1,$D0D0D0) 
  SelectObject_(hdc,Pen) 
  LineTo_(hDC, rc\right+3, rc\bottom) 
  DeleteObject_(pen) 
  ReleaseDC_(REGadgetID, hDC) 
  
EndProcedure 
  
Procedure RedProc(hWnd, uMsg, wParam, lParam) 
  Select uMsg
    Case #WM_PAINT 
      SendMessage_(hWnd, #EM_GETZOOM, @Zoomnumerator, @Zoomdenominator) 
      If Zoomnumerator 
        If mzoom<>Zoomnumerator 
          mzoom=Zoomnumerator 
          GetClientRect_(hWnd, rc.RECT) 
          If Zoomnumerator>100 
            Zoomnumerator/1.2 
          EndIf 
          rc\left+(40 *Zoomdenominator/Zoomnumerator) 
          SendMessage_(hWnd, #EM_SETRECT, 0, rc) 
        EndIf 
      EndIf 
      CallWindowProc_(OldRedProc, hWnd, uMsg, wParam, lParam) 
      DrawLineNumbers(hWnd) 
      result = 0 
    Default 
      result = CallWindowProc_(OldRedProc, hWnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

hWindow = OpenWindow(0, 0, 0, 640, 480 ,"RichEdit line numbers example", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget) 
If hWindow 
  SetClassLong_(hWindow, #GCL_HBRBACKGROUND, 0) ; remove resize flicker 

  WindowWidth = WindowWidth(0) 
  WindowHeight = WindowHeight(0) 
  
  If CreateGadgetList(hWindow) 
    PB_REGadgetID = EditorGadget(#PB_Any, 0,0, WindowWidth, WindowHeight) 
    SendMessage_(GadgetID(PB_REGadgetID), #EM_SETTARGETDEVICE, #Null, 0)  ; <<--  Set wrapping style  (retour à la ligne automatique)
    SendMessage_(GadgetID(PB_REGadgetID), #EM_LIMITTEXT, -1, 0)  ; set unlimited content size
    GetClientRect_(GadgetID(PB_REGadgetID), rc.RECT) 
    rc\left+40 
    SendMessage_(GadgetID(PB_REGadgetID), #EM_SETRECT, 0, rc) 

    lfnt.LOGFONT 
    FontName.s = "Courier" 
    lstrcpy_(@lfnt\lfFaceName[0], @FontName) 
    lfnt\lfHeight = -12 
    lfnt\lfWeight = 400 
    hLnFont = CreateFontIndirect_(lfnt) 

    OldRedProc = SetWindowLong_(GadgetID(PB_REGadgetID), #GWL_WNDPROC, @RedProc()) 
        
    Repeat 
      EventID = WaitWindowEvent() 
      If EventID=#WM_SIZE 
        WindowWidth = WindowWidth(0) 
        WindowHeight = WindowHeight(0) 
        ResizeGadget(PB_REGadgetID,#PB_Ignore,#PB_Ignore ,WindowWidth,WindowHeight) 
      EndIf 
    Until EventID = #PB_Event_CloseWindow 

  EndIf 

EndIf 
  
End

srod · Post by **srod** » Tue Oct 02, 2007 6:18 pm

Nice.

r_hyde · Post by **r_hyde** » Tue Oct 02, 2007 6:25 pm

That's really nice! The line numbers start to flicker at a few hundred lines though, and get very flickery at >1000 lines.

zapman* · Post by zapman* » Wed Oct 03, 2007 5:37 am

Thank you for this observation, r_hyde.

The problem is that I want to numerotate only lines ending with a carriage return. If the editor is set to "wrap" mode, some "real" lines (with a CR at end) can be printed along many window lines because they are too long to fit the window.

When the user scrolls the content of the Editor, the numerotation figuring on the left side must be adapted to the line being viewed. But what is this line number???
EM_LINEFROMPOS nor EM_GETFIRSTVISIBLELINE Windows functions can't be used to know that :
-> they return the total number of line preceeding a given position without making any distinction between the line ending with a CR or segmented because they are too long to be printed into the window.

The only solution is so to examinate the text preceeding the actual scrolling position and to count how many CR it includes.

The method used to do that in my first version of the code was a bit too long to do its job, that's why it flickered a lot.

I have reactualized the code. Please test the new version and tell me if you find it better.

milan1612 · Post by **milan1612** » Wed Oct 03, 2007 11:47 am

Excellent, no flickering at all

Thanks zapman...

utopiomania · Post by **utopiomania** » Wed Oct 03, 2007 8:23 pm

Thanks for the code, unfortunately it seems to be too slow in redrawing the linenumbers

zapman* · Post by zapman* » Wed Oct 03, 2007 10:46 pm

Did you test the last version?

utopiomania · Post by **utopiomania** » Thu Oct 04, 2007 8:06 am

Yes, I tested the version available just before posting. It's so slow I can see the redraw of the linenumbers from top to
bottom as the text scrolls.. It's tested on a Lenovo 3000 V100 running Windows Vista Business.

r_hyde · Post by **r_hyde** » Thu Oct 04, 2007 6:17 pm

It's not so slow on XP, so perhaps it's a vista thing. BTW zapman*, the drawing is much better now, but there is still some flicker at >1000 lines. I wonder if it is really necessary to repaint the line numbers every time a character is input?

Derek · Post by **Derek** » Thu Oct 04, 2007 6:51 pm

I'm running Vista Business and apart from a slight flicker the program works great, running on a HP 6715s laptop with a pretty bad graphics card.

srod · Post by **srod** » Thu Oct 04, 2007 7:40 pm

Flickers a lot here on xp when there's close to a hundred or so lines. When I say flicker I mean that the line numbers flicker.

gnozal · Post by **gnozal** » Fri Oct 05, 2007 8:02 am

Hmm, maybe a stupid question, but why not use the new scintilla gadget ?

You have line numbers and zooming.

And a lot more.

utopiomania · Post by **utopiomania** » Fri Oct 05, 2007 8:53 am

Maybe I'm running with some Vista 'eye-candy' enabled that I'm not aware of that makes it slow. It runs ok on XP at work, but it should
run fine on the Lenovo too to be useful, because the PC is generally quite responsive.

I also have a problem with cut/paste where the linenumbering fails on the inserted text. This works fine with Trond's code. I'll check out if
the latter works ok in Vista, if not, the scintilla gadget seems to be the way to go.

utopiomania · Post by **utopiomania** » Thu Oct 25, 2007 11:52 pm

I'm trying to PureBasic-ify Tronds post, but the linenumbers are seriously out of sync here on my Vista machine, can you spot the problem????

Code: Select all

enumeration
  #WIN: #EDIT
endEnumeration

declare openMainWindow()
declare drawLinenumbers()
declare editCallback(hWnd, uMsg,  wParam, lParam)

global editProc, winW = 800, winH = 600, leftM = 64

openMainWindow()

repeat
  select waitWindowEvent()
    case #PB_EVENT_SIZEWINDOW
       winW = windowWidth(#WIN)
       winH = windowHeight(#WIN)
       resizeGadget(#EDIT, 0, 0, winW, winH)
    case #PB_EVENT_CLOSEWINDOW
      end
  endSelect
forever

procedure openMainWindow()
  if openWindow(#WIN, 0, 0, winW, winH, "Linenumbers", $CF0001)
    if createGadgetList(windowID(#WIN))
      editorGadget(#EDIT, 0, 0, winW, winH)
      ;margins
      editRect.RECT\left = leftM
      editRect\right = winW 
      editRect\bottom = winH
      sendMessage_(gadgetId(#EDIT), #EM_SETRECT, 0, editRect) 
      ;subclass the editorgadget
      editProc = setWindowLong_(gadgetID(#EDIT), #GWL_WNDPROC, @editCallback()) 
    endIf
  endIf
endProcedure

procedure editCallback(hWnd, uMsg, wParam, lParam) 
  select uMsg 
    case #WM_PAINT 
      callWindowProc_(editProc, hWnd, uMsg, wParam, lParam) 
      drawLineNumbers() 
      procedurereturn 0 
  endSelect 
  procedureReturn callWindowProc_(editProc, hWnd, uMsg, wParam, lParam) 
endProcedure

procedure drawLinenumbers()
  id = gadgetId(#EDIT)
  hDC = getDC_(id)
  
  getTextExtentPoint32_(hDC, "1", 1, sz.SIZE) 
  fontH = sz\cy
  ;oldObject = selectObject_(hDC, 0) 
  
  getClientRect_(id, rc.RECT) 
  rc\right = leftM - 8
  fillRect_(hDC, rc, getStockObject_(#WHITE_BRUSH))
  setBkMode_(hDC, #TRANSPARENT)
  setTextColor_(hDC, $C0C0C0) 

  line = sendMessage_(id, #EM_GETFIRSTVISIBLELINE, 0, 0) + 1 
  last = line + winH / FontH
  while line < last  
    drawText_(hDC, str(line), -1, rc, #DT_RIGHT) 
    rc\top + FontH
    line + 1 
  wend 
  
  ;selectObject_(hDC, OldObject) 
  releaseDC_(id, hDC)
endProcedure

Derek · Post by **Derek** » Fri Oct 26, 2007 9:27 am

Out of sync on my XP machine as well.

Looks like a totally different font height.

Changing the procedure to this shows the problem

Code: Select all

Procedure openMainWindow() 
  If OpenWindow(#WIN, 0, 0, winW, winH, "Linenumbers", $CF0001) 
    If CreateGadgetList(WindowID(#WIN)) 
      EditorGadget(#EDIT, 0, 0, winW, winH) 
      LoadFont(0,"Times",11)
      SetGadgetFont(#edit,FontID(0))
      ;margins 
      editRect.RECT\left = leftM 
      editRect\right = winW 
      editRect\bottom = winH 
      SendMessage_(GadgetID(#EDIT), #EM_SETRECT, 0, editRect) 
      ;subclass the editorgadget 
      editProc = SetWindowLong_(GadgetID(#EDIT), #GWL_WNDPROC, @editCallback()) 
    EndIf 
  EndIf 
EndProcedure

So obviously the linenumbers aren't using the same font height as the gadget and are going out of sync.