Editorgadget line numbers possible??

[Trond]

Hi! Is there a simple way to add line numbers to the editorgadget? I'm working on a
simple html editor, and Javascript errors usually report a line number on errors, so..

Editorgadget line numbers possible??

Possible? Yes. Simple way? No.

Here's an example I found for PB 3.94:

Code: Select all

#RICHEDIT = #WS_CHILD|#WS_VISIBLE|#WS_VSCROLL|#ES_MULTILINE|#ES_AUTOVSCROLL|#ES_NOHIDESEL 
#WINDOW_PARAMETERS = #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget 

Global RichEditID, hWindow, WindowWidth, WindowHeight 
Global hLnFont, rc.RECT, FontHeight, buffer.s, OldRedProc 

Procedure Error(message.s, fatal.b) 
  MemoryID = AllocateMemory(256) 
  FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, MenoryID, 256, 0) 
  MessageRequester("Error", message+Chr(10)+Chr(10)+PeekS(MemoryID), 0) 
  FreeMemory(0) 
  If fatal 
    End 
  EndIf 
EndProcedure 

Procedure DrawLineNumbers() 
  hDC = GetDC_(RichEditID) 
  OldObject = SelectObject_(hDC, hLnFont) 
  lineno = SendMessage_(RichEditID, #EM_GETFIRSTVISIBLELINE, 0, 0)+1 
  GetClientRect_(RichEditID, rc) 
  rc\right = 28 
  FillRect_(hDC, rc, GetStockObject_(#GRAY_BRUSH)) 
  SetBkMode_(hDC, #TRANSPARENT) 
  SetTextColor_(hDC, $0FFFF) 
  lastline = WindowHeight/FontHeight+lineno 
  While lineno<lastline 
    buffer = Str(lineno) 
    DrawText_(hDC, @buffer, -1, rc, #DT_RIGHT) 
    rc\top+FontHeight 
    lineno+1 
  Wend 
  MoveToEx_(hDC, rc\right, 0, #Null) 
  LineTo_(hDC, rc\right, rc\bottom) 
  SelectObject_(hDC, OldObject) 
  ReleaseDC_(RichEditID, hDC) 
EndProcedure 

Procedure RedProc(hWnd, uMsg, wParam, lParam) 
  Select uMsg 
    Case #WM_PAINT 
      CallWindowProc_(OldRedProc, hWnd, uMsg, wParam, lParam) 
      DrawLineNumbers() 
      result = 0 
    Default 
      result = CallWindowProc_(OldRedProc, hWnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure WndProc(hWnd, uMsg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select uMsg 
    Case #WM_SIZE 
      If hWnd=hWindow And wParam<>#SIZE_MINIMIZED 
        WindowWidth = lParam&$ffff 
        WindowHeight = lParam>>16 
        MoveWindow_(RichEditID, 0, 0, WindowWidth, WindowHeight, 1) 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 


hWindow = OpenWindow(0, 0, 0, 640, 480, #WINDOW_PARAMETERS, "RichEdit line numbers example") 
If hWindow 
  SetClassLong_(hWindow, #GCL_HBRBACKGROUND, 0) ; remove resize flicker 
  
  If LoadLibrary_("RICHED20.DLL") 
    RichClass.s = "RichEdit20A" 
  ElseIf LoadLibrary_("RICHED32.DLL") 
    RichClass.s = "RichEdit" 
  Else 
    Error("RichEdit library not present.", 0) 
    End 
  EndIf 
  
  WindowWidth = WindowWidth() 
  WindowHeight = WindowHeight() 
  
  RichEditID = CreateWindowEx_(#WS_EX_CLIENTEDGE, RichClass, 0, #RICHEDIT, 0, 0, WindowWidth, WindowHeight, hWindow, 0, GetModuleHandle_(0), 0) 
  
  If RichEditID 
    SendMessage_(RichEditID, #EM_GETRECT, 0, rc) 
    rc\left+32 
    SendMessage_(RichEditID, #EM_SETRECT, 0, rc) 
    lfnt.LOGFONT 
    cf.CHARFORMAT 
    FontName.s = "Courier New" 
    lstrcpy_(@lfnt\lfFaceName[0], @FontName) 
    lstrcpy_(@cf\szFaceName[0], @FontName) 
    lfnt\lfHeight = -12 
    lfnt\lfWeight = 400 
    hLnFont = CreateFontIndirect_(lfnt) 
    hFont = CreateFontIndirect_(lfnt) 
    cf\cbSize = SizeOf(CHARFORMAT) 
    cf\dwMask = #CFM_FACE|#CFM_SIZE 
    cf\yHeight=(-lfnt\lfHeight)*15 
    SendMessage_(RichEditID, #EM_SETCHARFORMAT, #SCF_SELECTION, cf) 
    hDC = GetDC_(RichEditID) 
    OldObject = SelectObject_(hDC, hFont) 
    GetTextExtentPoint32_(hDC, @"WWWW", 4, siz.SIZE) 
    FontHeight = siz\cy 
    SelectObject_(hDC, OldObject) 
    ReleaseDC_(RichEditID, hDC) 
    OldRedProc = SetWindowLong_(RichEditID, #GWL_WNDPROC, @RedProc()) 
    SetWindowCallback(@WndProc()) 
        
    Repeat 
      EventID = WaitWindowEvent() 
    Until EventID = #PB_EventCloseWindow 

  Else 
    Error("Could not create the RichEdit control.", 0) 
    End 
  EndIf 

Else 
  Error("Could not create the main window.", 0) 
EndIf 

End

[utopiomania]

Thanks, Trond! I didn't notice your answer until now. I'll check it out in the editor

[zapman*]

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]

Nice.

[r_hyde]

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

[zapman*]

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]

Excellent, no flickering at all
Thanks zapman...

[utopiomania]

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

[zapman*]

Did you test the last version?

[utopiomania]

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]

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]

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]

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]

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

You have line numbers and zooming.

And a lot more.

[utopiomania]

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.