PureBasic Forums - English

Code: Select all

;' THE CODE IS PROVIDED "AS IS" With NO GUARANTEES OF ANY KIND!
;' USE THIS AT YOUR OWN RISK
;' Windows only
;' Tested on Win 10 with PB 5.60 (64)
;' --- 

EnableExplicit

;­--== Scintilla Procedures ==-----------------------------------------------
;­-- (first Character is ALT+0173 !---

;'
;' Define WindowID.i = Val(GetEnvironmentVariable("PB_TOOL_MAINWINDOW"))

Define s_hSciWnd ;­ semi global scintilla handle 


;­ new helper procedure ... 

Procedure.s GetClassName(hWnd)
  Protected cn${256} 
  GetClassName_(hWnd, @cn$, 256)                                       ;:Debug "GetClassname("+Str(hWnd)+") -> '"+cn$+"'"
  ProcedureReturn cn$ 
EndProcedure

Procedure EnumChildWndProc(hWnd, lParam)
  Shared s_hSciWnd
  Protected result = #False, cn$
 
  If hWnd
    cn$ = GetClassName(hWnd)                        ;:Debug cn$+", hWnd="+Str(hWnd)
    If cn$ = "Scintilla"
      s_hSciWnd = hwnd
    Else
      result = #True ;' continue
    EndIf 
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.i Scintilla_GetHandle()  ;' returns hWnd of the 'Scintilla Control'
  Shared s_hSciWnd
  Protected hWnd, cap${256}

  If s_hSciWnd = 0
    hWnd = FindWindowEx_(GetDesktopWindow_(), 0, "WindowClass_2", 0)     :Debug "WindowClass_2, hWnd="+Str(hWnd)
    If hWnd <> 0 ;And WindowIsPureBasic(hWnd)
      SendMessage_(hWnd, #WM_GETTEXT, 255, @cap$) 
      If Left(cap$, 9) = "PureBasic" 
        s_hSciWnd = 0
        EnumChildWindows_(hWnd, @EnumChildWndProc(), 0)
      EndIf
    EndIf  
    If s_hSciWnd <> 0
      Debug "  Scintilla found."
    EndIf
  EndIf
  ProcedureReturn s_hSciWnd
EndProcedure


Procedure.i Scintilla_CurrLine()  ;' get the current line, where the cursor is!
  Protected hSciWnd, pos, Line

  hSciWnd = Scintilla_GetHandle()
  If hSciWnd
    pos = SendMessage_(hSciWnd, #SCI_GETCURRENTPOS, 0, 0)         ;:Debug "CurrentPos="+Str(pos)
    Line = SendMessage_(hSciWnd, #SCI_LINEFROMPOSITION, pos, 0)   ;:Debug "Line="+Str(Line)
  EndIf
  ProcedureReturn Line
EndProcedure

Procedure.s Scintilla_GetTextline(Line.i=#PB_Any)
  Protected Result$, ProcessID, PID, hSciWnd
  Protected *MemoryID, *Buffer, Format, Length, BytesRead, pos, temp

  hSciWnd = Scintilla_GetHandle()
  If hSciWnd And GetWindowThreadProcessId_(hSciWnd, @PID)
    ProcessID = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID)
  EndIf

  If ProcessID
    Select SendMessage_(hSciWnd, #SCI_GETCODEPAGE, #Null, #Null)
      Case 0     : Format = #PB_Ascii : Debug "ASCII"
      Case 65001 : Format = #PB_UTF8  : Debug "UTF8"
    EndSelect
 
    If Line = #PB_Any
      pos = SendMessage_(hSciWnd, #SCI_GETCURRENTPOS, 0, 0)         ;:Debug "CurrentPos="+Str(pos)
      Line = SendMessage_(hSciWnd, #SCI_LINEFROMPOSITION, pos, 0)   ;:Debug "Line="+Str(Line)
    EndIf

    Length = SendMessage_(hSciWnd, #SCI_LINELENGTH, Line, 0)
    Length * StringByteLength("A", Format)

    *Buffer = AllocateMemory(Length+SizeOf(Character))
    If *Buffer
      *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
      If *MemoryID
        temp = SendMessage_(hSciWnd, #SCI_GETLINE, Line, *MemoryID)               ;: Debug "read chars: "+Str(temp)
        ReadProcessMemory_(ProcessID, *MemoryID, *Buffer, Length, @BytesRead)     ;: Debug "BytesRead="+Str(BytesRead)
        Result$ = PeekS(*Buffer, BytesRead, Format)                           ;­ correction: add the 'Format'
        VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
      EndIf
      FreeMemory(*Buffer)   
    EndIf
    CloseHandle_(ProcessID)
  EndIf
  ProcedureReturn Result$ 
EndProcedure

Procedure.s Scintilla_GetText()
  Protected Result$, ProcessID, PID, hSciWnd
  Protected *MemoryID, *Buffer, Format, Length, BytesRead

  hSciWnd = Scintilla_GetHandle()
  If hSciWnd And GetWindowThreadProcessId_(hSciWnd, @PID)
    ProcessID = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID)
  EndIf

  If ProcessID
    Select SendMessage_(hSciWnd, #SCI_GETCODEPAGE, #Null, #Null)
      Case 0     : Format = #PB_Ascii : Debug "ASCII"
      Case 65001 : Format = #PB_UTF8  : Debug "UTF8"
    EndSelect
 
    Length = SendMessage_(hSciWnd, #SCI_GETTEXTLENGTH, 0, 0) ;:Debug "TextLength = "+Str(Length)
    Length * StringByteLength("A", Format)                   ;:Debug "TextLength = "+Str(Length)

    *Buffer = AllocateMemory(Length+SizeOf(Character))
    If *Buffer
      *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
      If *MemoryID
        SendMessage_(hSciWnd, #SCI_GETTEXT, Length, *MemoryID)
        ReadProcessMemory_(ProcessID, *MemoryID, *Buffer, Length, @BytesRead)     ;: Debug "BytesRead="+Str(BytesRead)
        Result$ = PeekS(*Buffer, BytesRead, Format)                           ;­ correction: add the 'Format'
        VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
      EndIf
      FreeMemory(*Buffer)
    EndIf
    CloseHandle_(ProcessID)
  EndIf
  ProcedureReturn Result$ 
EndProcedure


;­--== Test Procedures ==----------------------------------------------------

Enumeration Gadgets
  #Edt
  #BtnReadLine
  #BtnReadAll
EndEnumeration

If OpenWindow(0, 20, 20, 400, 200, "Pure Preview ", #PB_Window_SystemMenu|#PB_Window_Tool|#PB_Window_SizeGadget)
  ButtonGadget(#BtnReadAll, 2, 2, 76, 18, "Read All")
  ButtonGadget(#BtnReadLine, 80, 2, 76, 18, "Read Line")
  EditorGadget(#Edt, 0, 24, 400, 200-26)

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_SizeWindow
        ResizeGadget(#Edt, #PB_Ignore, #PB_Ignore, WindowWidth(0), WindowHeight(0)-26)
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #BtnReadAll
            ClearGadgetItems(#Edt)
            SetGadgetText(#Edt, Scintilla_GetText())
          Case #BtnReadLine
            ClearGadgetItems(#Edt)
            SetGadgetText(#Edt, Scintilla_GetTextline())
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
EndIf
;-^ Bottom of File 

Code: Select all

Procedure.s GetClassName(hWnd)
  Protected cn${256} 
  GetClassName_(hWnd, @cn$, 256)                                       ;:Debug "GetClassname("+Str(hWnd)+") -> '"+cn$+"'"
  ProcedureReturn cn$ 
EndProcedure