PureBasic Forums - English

Code: Select all

FirstVisibleLine = SendMessage_(RichEditID, #EM_GETFIRSTVISIBLELINE, 0, 0)

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)
  FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, AllocateMemory(0, 256, 0), 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#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

Code: Select all

'Adding line numbers to the front of text in a rich text box 
'Example by HeSaidJoe
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long 
Private Const EM_GETLINE = &HC4 
Private Const EM_GETLINECOUNT = &HBA 
Private Const EM_LINEINDEX = &HBB 
Private Const EM_LINELENGTH = &HC1 
Private Sub Command1_Click() 
    Dim lngCount As Long 
    Dim lngLineIndex As Long 
    Dim lngLength As Long 
    Dim strBuffer As String 
    Dim strRichText As String 
    Dim i As Integer 
    'Get Line count 
    lngCount = SendMessage(RichTextBox1.hwnd, EM_GETLINECOUNT, 0, 0) 
    With RichTextBox1 
        For i = 0 To lngCount - 1 
            'Get line index 
            lngLineIndex = SendMessage(.hwnd, EM_LINEINDEX, i, 0) 
            'get line length 
            lngLength = SendMessage(.hwnd, EM_LINELENGTH, lngLineIndex, 0) 
            'resize buffer 
            strBuffer = Space(lngLength) 
            'get line text 
            Call SendMessageStr(.hwnd, EM_GETLINE, i, ByVal strBuffer) 
            'Number each line 
            strRichText = strRichText & CStr(i + 1) & " " & strBuffer & vbCrLf 
        Next 
        'rewrite numbered text in RichTextBox 
        .Text = strRichText 
    End With 
End Sub
Private Sub Form_Load() 
    With RichTextBox1 
        .Text = "line one" & vbCrLf 
        .Text = .Text & "line two" & vbCrLf 
        .Text = .Text & "line three" 
    End With