Surligner le texte sélectionné d'un gadget editor

Codes specifiques à Windows
hub73
Messages : 126
Inscription : sam. 16/janv./2021 20:17

Surligner le texte sélectionné d'un gadget editor

Message par hub73 »

Bonjour à vous.
Dans un editor gadget je souhaiterai sélectionner une portion du texte et la 'surligner' en rouge par exemple.

J'ai trouvé cette procédure sur le forum anglais :

Code : Tout sélectionner

Procedure EditorTextColor(gad,fgcolor,startpos=-1,endpos=-1,bgcolor=-1)
  hWnd=GadgetID(gad)
  Highlight.CHARFORMAT2
  #CFM_BACKCOLOR=$4000000
  If startpos=-1
    startpos=0
    endpos=-1
  Else
    startpos-1
  EndIf
  SendMessage_(hWnd,#EM_SETSEL,startpos,endpos)
  Highlight\cbSize=SizeOf(CHARFORMAT2)
  Highlight\dwMask=#CFM_COLOR|#CFM_BACKCOLOR
  Highlight\crTextColor=fgcolor
  If bgcolor=-1 : bgcolor=GetSysColor_(#COLOR_WINDOW) : EndIf
  Highlight\crBackColor=bgcolor
  SendMessage_(hWnd,#EM_SETCHARFORMAT,#SCF_SELECTION,Highlight)
  SendMessage_(hWnd,#EM_SETSEL,0,0)
EndProcedure
Par contre je ne sais pas comment récupérer la position de départ (startpos) et de fin (endpos) du texte qui est sélectionné dans l'editor gadget.

Merci à vous.
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Surligner le texte sélectionné d'un gadget editor

Message par MLD »

regarde c'est quelque chose comme ceci

Code : Tout sélectionner

Procedure WndProc(hWnd, uMsg, wParam, lParam)
 If uMsg = #EM_SETSEL 

  ;regarde avec les valeurs de  wParam, lParam)

  endif
endprocedure  

désolé je n'est pas trop de temps.
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Surligner le texte sélectionné d'un gadget editor

Message par Mesa »

Code : Tout sélectionner

; ====================
; Editor Gadget Routines
; ====================


Procedure.i EditorGadgetGetSelectionStart(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define startPos.i
				startPos=gtk_text_iter_get_offset_(@startIter)
				ProcedureReturn startPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
				Define startpos, endpos
				SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn startpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionStart() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.i EditorGadgetGetSelectionEnd(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define endPos.i
				endPos=gtk_text_iter_get_offset_(@endIter)
				ProcedureReturn endPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
				SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn endpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionEnd() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.i EditorGadgetGetSelectionLength(editornum)
	ProcedureReturn EditorGadgetGetSelectionEnd(editornum)-EditorGadgetGetSelectionStart(editorNum)
EndProcedure

Procedure EditorGadgetSetSelectionRange(editornum, rstart, rend)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
			gtk_text_iter_set_offset_(@startIter, rstart)
			gtk_text_iter_set_offset_(@endIter, rend)
			gtk_text_buffer_select_range_(*buffer, @startIter, @endIter)
		CompilerCase #PB_OS_Windows
			SendMessage_(GadgetID(editorNum),#EM_SETSEL,rstart,rend)
			SendMessage_(GadgetID(editorNum), #EM_SCROLLCARET, 0, 0)
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetSetSelectionRange() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.s EditorGadgetGetSelection(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter, *slice, result$
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				*slice = gtk_text_buffer_get_slice_(*buffer, @startIter, @endIter, 1)
				result$ = PeekS(*slice, -1, #PB_UTF8)
				g_free_(*slice)
				ProcedureReturn result$
			Else
				ProcedureReturn ""
			EndIf
		CompilerCase #PB_OS_Windows
			Define text$
			text$=Space(EditorGadgetGetSelectionLength(editorNum)+8)
			SendMessage_(GadgetID(editorNum),#EM_GETSELTEXT,0,@text$)
		ProcedureReturn text$
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelection() not implemented on Mac OS"
			ProcedureReturn ""
	CompilerEndSelect
EndProcedure


Procedure.i EditorGadgetGetCursorAt(editorNum)
	ProcedureReturn EditorGadgetGetSelectionEnd(editorNum)
EndProcedure

Procedure EditorGadgetSetCursorAt(editorNum, pos)
	EditorGadgetSetSelectionRange(editorNum, pos, pos)
EndProcedure

Procedure EditorGadgetInsert(editorNum, text$, autoselect=#False)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, *buffer2, len, selStart
			selStart=EditorGadgetGetSelectionStart(editorNum)
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			gtk_text_buffer_delete_selection_ (*buffer, 0, 1)
			len=StringByteLength(text$, #PB_UTF8)
			*buffer2=AllocateMemory(len+2)
			PokeS(*buffer2, text$, len, #PB_UTF8)
			gtk_text_buffer_insert_at_cursor_(*buffer, *buffer2, len)
			If autoselect
				EditorGadgetSetSelectionRange(editorNum, selStart, selStart+len)
			Else
				SetActiveGadget(editorNum)
			EndIf
			ProcedureReturn #True
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetInsert() not implemented on Mac OS"
		CompilerCase #PB_OS_Windows
			Define success, selstart
			If autoselect
				selStart=EditorGadgetGetSelectionStart(GadgetID(editorNum))
			EndIf
			success=SendMessage_(GadgetID(editorNum),#EM_REPLACESEL,0,@text$)
			If autoselect
				EditorGadgetSetSelectionRange(editorNum, selstart, Len(text$))
			EndIf
				ProcedureReturn success
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetSelectAll(editorNum)
	EditorGadgetSetSelectionRange(editorNum, 0, Len(GetGadgetText(editorNum)))
EndProcedure

Procedure EditorGadgetDeselectAll(editorNum)
	EditorGadgetSetSelectionRange(editorNum, EditorGadgetGetSelectionEnd(editorNum), EditorGadgetGetSelectionEnd(editorNum))
EndProcedure

; Procedure EditorGadgetCopy(editorNum)
;   Define selection$
;   selection$=EditorGadgetGetSelection(editorNum)
;   If selection$<>""
;     SetClipboardText(selection$)
;   EndIf
; EndProcedure

; Procedure EditorGadgetPaste(editorNum)
;   Define selection$
;   selection$=GetClipboardText()
;   If selection$<>""
;     EditorGadgetInsert(editorNum, selection$)
;   EndIf
; EndProcedure

; Procedure EditorGadgetCut(editorNum)
;   EditorGadgetCopy(editorNum)
;   EditorGadgetInsert(editorNum, "")
; EndProcedure

Procedure EditorGadgetSetFont(editorNum, font_id)
	Define buff$
	If IsGadget(editorNum)
		buff$=GetGadgetText(editorNum)
		SetGadgetFont(editorNum, font_id)
		SetGadgetText(editornum, buff$)
	EndIf
EndProcedure

#PB_EventType_EditorChange=1024

Procedure EditorGadgetScrollToEnd(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Protected lines, lastline$
			lines=CountGadgetItems(editorNum)
			lastline$=GetGadgetItemText(editorNum, lines)
			SetGadgetItemText(editorNum, lines, lastline$)
		CompilerCase #PB_OS_Linux
			Protected end_mark,*buffer, end_iter.GtkTextIter
			*buffer=gtk_text_view_get_buffer_(GadgetID(editorNum))
			gtk_text_buffer_get_end_iter_(*buffer,@end_iter)
			end_mark=gtk_text_buffer_create_mark_(*buffer,"end_mark",@end_iter,#False)
			gtk_text_view_scroll_mark_onscreen_(GadgetID(editorNum),end_mark)
		CompilerCase #PB_OS_Windows
			Protected range.CHARRANGE         ;instantiates 'range' as CHARRANGE structure
			range\cpMin=-1                    ;range element cpMin
			range\cpMax=-1                    ;range element cpMax
			SendMessage_(GadgetID(editorNum),#EM_EXSETSEL,0,@range)
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetRegisterChangeCallback(editorNum, *callback)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetRegisterChangeCallback() not yet implemented!"
		CompilerCase #PB_OS_Windows
			Debug "EditorGadgetRegisterChangeCallback() not yet implemented!"
		CompilerCase #PB_OS_Linux
			Define *buff,*buff2,len
			Define *buffer.GtkTextBuffer
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			len=StringByteLength("insert-text", #PB_Ascii)
			*buff=AllocateMemory(len+2)
			PokeS(*buff, "insert-text", len, #PB_Ascii)
			g_signal_connect_(*buffer, *buff, *callback, #Null)
			len=StringByteLength("delete-range", #PB_Ascii)
			*buff2=AllocateMemory(len+2)
			PokeS(*buff, "delete-range", len, #PB_Ascii)
			g_signal_connect_(*buffer, *buff, *callback, #Null)  
			FreeMemory(*buff)
			FreeMemory(*buff2)
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetUndo( editorNum )
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetUndo() not yet implemented!"
		CompilerCase #PB_OS_Windows
			ProcedureReturn SendMessage_(GadgetID(editorNum), #EM_UNDO, 0, 0)
		CompilerCase #PB_OS_Linux
			Debug "EditorGadgetUndo() not implemented!"
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetCanUndo( editorNum )
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetUndo() not yet implemented!"
		CompilerCase #PB_OS_Windows
			ProcedureReturn SendMessage_(GadgetID(editorNum), #EM_CANUNDO, 0, 0)
		CompilerCase #PB_OS_Linux
			Debug "EditorGadgetUndo() not implemented!"
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetRedo( editorNum )
		CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetUndo() not yet implemented!"
		CompilerCase #PB_OS_Windows
			ProcedureReturn SendMessage_(GadgetID(editorNum), #EM_REDO, 0, 0)
		CompilerCase #PB_OS_Linux
			Debug "EditorGadgetUndo() not implemented!"
	CompilerEndSelect
EndProcedure

Procedure EditorGadgetCanRedo( editorNum )
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetUndo() not yet implemented!"
		CompilerCase #PB_OS_Windows
			ProcedureReturn SendMessage_(GadgetID(editorNum), #EM_CANREDO, 0, 0)
		CompilerCase #PB_OS_Linux
			Debug "EditorGadgetUndo() not implemented!"
	CompilerEndSelect
EndProcedure


If OpenWindow(0, 0, 0, 322, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)  
    EditorGadget(0, 8, 8, 306, 133) 
    For a = 0 To 5 
      AddGadgetItem(0, a, "Ligne "+Str(a)) 
    Next 
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow 
  EndIf 


M.
hub73
Messages : 126
Inscription : sam. 16/janv./2021 20:17

Re: Surligner le texte sélectionné d'un gadget editor

Message par hub73 »

Merci Mesa.

J'ai essayé le code suivant, mais il ne fonctionne pas, je parviens à sélectionner la zone de texte à surligner, c'est au niveau de la couleur que survient le problème (d'écriture et de fond : Surligner_texte et DeSurligner_texte). Au mieux j'obtiens un texte illisible écriture noire sur fond noir !
Une idée ?

Code : Tout sélectionner


Structure CHARFORMAT2_
  cbSize.l
  dwMask.l
  dwEffects.l
  yHeight.l
  yOffset.l
  crTextColor.l
  bCharSet.b
  bPitchAndFamily.b
  szFaceName.b[#LF_FACESIZE]
  _wPad2.w
  wWeight.w
  sSpacing.w
  crBackColor.l
  lcid.l
  dwReserved.l
  sStyle.w
  wKerning.w
  bUnderlineType.b
  bAnimation.b
  bRevAuthor.b
  bReserved1.b
EndStructure

Procedure.i EditorGadgetGetSelectionStart(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define startPos.i
				startPos=gtk_text_iter_get_offset_(@startIter)
				ProcedureReturn startPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
				Define startpos, endpos
				SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn startpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionStart() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.i EditorGadgetGetSelectionEnd(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define endPos.i
				endPos=gtk_text_iter_get_offset_(@endIter)
				ProcedureReturn endPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
				SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn endpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionEnd() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure


Procedure EditorTextColor(gad,fgcolor,startpos=-1,endpos=-1,bgcolor=-1)
  
  Define hWnd
  Define Highlight.CHARFORMAT2_
  
  hWnd=GadgetID(gad)
  
  #CFM_BACKCOLOR=$4000000
  If startpos=-1
    startpos=0
    endpos=-1
  Else
    startpos-1
  EndIf
  SendMessage_(hWnd,#EM_SETSEL,startpos,endpos)
  Highlight\cbSize=SizeOf(CHARFORMAT2)
  Highlight\dwMask=#CFM_COLOR|#CFM_BACKCOLOR
  Highlight\crTextColor=fgcolor
  If bgcolor=-1 : bgcolor=GetSysColor_(#COLOR_WINDOW) : EndIf
  Highlight\crBackColor=bgcolor
  SendMessage_(hWnd,#EM_SETCHARFORMAT,#SCF_SELECTION,Highlight)
  SendMessage_(hWnd,#EM_SETSEL,0,0)
EndProcedure

Procedure Surligner_texte(Gadget)
  
  Define Startpos
  Define EndPos
  Define CouleurEcriture
  Define CouleurFond
  
  StartPos = EditorGadgetGetSelectionStart(Gadget)
  EndPos = EditorGadgetGetSelectionEnd(Gadget)
  
  CouleurEcriture = RGB (255,0,0)
  CouleurFond = GetSysColor_(#COLOR_WINDOW)
  
  If StartPos <> 0
    EditorTextColor (Gadget, CouleurEcriture, StartPos, EndPos,CouleurFond)
  EndIf
  
EndProcedure

Procedure DeSurligner_texte(Gadget)
  
  Define Startpos
  Define EndPos
  Define CouleurEcriture
  Define CouleurFond
  
  StartPos = EditorGadgetGetSelectionStart(Gadget)
  EndPos = EditorGadgetGetSelectionEnd(Gadget)
  
  CouleurEcriture = RGB (0,0,0)
  CouleurFond = GetSysColor_(#COLOR_WINDOWTEXT)
  
  If StartPos <> 0
    EditorTextColor (Gadget, CouleurEcriture, StartPos, EndPos,CouleurFond)
  EndIf
  
EndProcedure


Global Window_0

Global Button_Surligner, Button_normal, Editor1
Window_0 = OpenWindow(#PB_Any, 100, 100, 800, 500, "test", #PB_Window_SystemMenu)
Button_Surligner = ButtonGadget(#PB_Any, 520, 310, 100, 25, "Surligner")
Button_normal = ButtonGadget(#PB_Any, 520, 350, 100, 25, "Normal")
Editor1 = EditorGadget(#PB_Any, 10, 10, 490, 370)

Fini = #False


For i=0 To 1000
  
  Chaine$ = Chaine$ + Chr(Random (80, 65))
  If Mod (Len(Chaine$),60) = 0
    Chaine$ = Chaine$ + Chr(13)
  EndIf
  If Mod(i,100) = 0 
    Chaine$ = Chaine$ + Chr(13) + Chr(13)
  EndIf
Next
SetGadgetText (Editor1, Chaine$)
  
Repeat
  Event   = WaitWindowEvent(100)  
  
  Select event
    Case #PB_Event_CloseWindow
      Fini = #True

    Case #PB_Event_Gadget
      Select EventGadget()
        Case Button_normal
          Surligner_texte (Editor1)
          
        Case Button_surligner
          DeSurligner_texte (Editor1)
      EndSelect
  EndSelect
  
Until Fini <> #False

End
Dernière modification par hub73 le jeu. 07/oct./2021 14:57, modifié 1 fois.
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Surligner le texte sélectionné d'un gadget editor

Message par Mesa »

Il manque du code, je ne peux pas le tester.

M.
hub73
Messages : 126
Inscription : sam. 16/janv./2021 20:17

Re: Surligner le texte sélectionné d'un gadget editor

Message par hub73 »

J'ai mis à jour le post précédent pour que vous puissiez essayer via copier-coller.
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Surligner le texte sélectionné d'un gadget editor

Message par Mesa »

Code : Tout sélectionner

Procedure.i EditorGadgetGetSelectionStart(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define startPos.i
				startPos=gtk_text_iter_get_offset_(@startIter)
				ProcedureReturn startPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
			SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn startpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionStart() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.i EditorGadgetGetSelectionEnd(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define endPos.i
				endPos=gtk_text_iter_get_offset_(@endIter)
				ProcedureReturn endPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
			SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn endpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionEnd() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure colortext(Gadget,Color,BG_Color,StartColor,EndColor)
	Protected Highlight.CHARFORMAT2,ID
	#CFM_BACKCOLOR = $4000000
	ID=GadgetID(Gadget) ; turn PB ID into Win ID
											;   SendMessage_(ID, #EM_SETSEL,StartColor,EndColor) ; select text to change
	Highlight\cbSize = SizeOf(CHARFORMAT2)
	Highlight\dwMask = #CFM_COLOR|#CFM_BACKCOLOR ;mask to change Text Color and Background Color
	Highlight\crBackColor = BG_Color						 ; set Background Color
	Highlight\crTextColor = Color								 ; Set Text Color
	SendMessage_(ID, #EM_SETCHARFORMAT, #SCF_SELECTION,Highlight) ; highlight and or change text color
	SendMessage_(ID, #EM_SETSEL, 0, 0)														; turn off selection
EndProcedure


Procedure Surligner_texte(Gadget)
	
	Protected Startpos
	Protected EndPos
	Protected CouleurEcriture
	Protected CouleurFond
	
	StartPos = EditorGadgetGetSelectionStart(Gadget)
	EndPos = EditorGadgetGetSelectionEnd(Gadget)
	
	CouleurEcriture = GetGadgetColor(Gadget, #PB_Gadget_FrontColor)
	CouleurFond = $00FFFF;
	
	If StartPos <> 0
		colortext(Gadget,CouleurEcriture,CouleurFond,StartPos, EndPos)
		
	EndIf
	
EndProcedure

Procedure DeSurligner_texte(Gadget)
	
	Protected Startpos
	Protected EndPos
	Protected CouleurEcriture
	Protected CouleurFond
	
	StartPos = EditorGadgetGetSelectionStart(Gadget)
	EndPos = EditorGadgetGetSelectionEnd(Gadget)
	
	CouleurEcriture  = GetGadgetColor(Gadget, #PB_Gadget_FrontColor)
	CouleurFond = GetSysColor_(#COLOR_WINDOW);GetGadgetColor(Gadget, #PB_Gadget_BackColor)
	
	If StartPos <> 0
		colortext(Gadget,CouleurEcriture,CouleurFond,StartPos, EndPos)
	EndIf
	
EndProcedure


Global Window_0

Global Button_Surligner, Button_normal, Editor1
Window_0 = OpenWindow(#PB_Any, 100, 100, 800, 500, "test", #PB_Window_SystemMenu)
Button_Surligner = ButtonGadget(#PB_Any, 520, 310, 100, 25, "Surligner")
Button_normal = ButtonGadget(#PB_Any, 520, 350, 100, 25, "Normal")
Editor1 = EditorGadget(#PB_Any, 10, 10, 490, 370)

Fini = #False


For i=0 To 1000
	
	Chaine$ = Chaine$ + Chr(Random (80, 65))
	If Mod (Len(Chaine$),60) = 0
		Chaine$ = Chaine$ + Chr(13)
	EndIf
	If Mod(i,100) = 0 
		Chaine$ = Chaine$ + Chr(13) + Chr(13)
	EndIf
Next
SetGadgetText (Editor1, Chaine$)
SetActiveGadget(Editor1)


Repeat
	Event   = WaitWindowEvent(100)  
	
	Select event
		Case #PB_Event_CloseWindow
			Fini = #True
			
		Case #PB_Event_Gadget
			Select EventGadget()
				Case Button_normal
					DeSurligner_texte (Editor1)
					
					
				Case Button_surligner
					Surligner_texte (Editor1)
			EndSelect
	EndSelect
	
Until Fini <> #False

End
M.
hub73
Messages : 126
Inscription : sam. 16/janv./2021 20:17

Re: Surligner le texte sélectionné d'un gadget editor

Message par hub73 »

Merci beaucoup Mesa. J'ai également essayé d'enregistrer depuis le gadget editor le contenu en format .rtf, et ensuite le recharger mais je n'y suis pas parvenu.
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Surligner le texte sélectionné d'un gadget editor

Message par Mesa »

Code : Tout sélectionner

Global CouleurF=#White
Global CouleurT=#Black

Procedure.i EditorGadgetGetSelectionStart(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define startPos.i
				startPos=gtk_text_iter_get_offset_(@startIter)
				ProcedureReturn startPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
			SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn startpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionStart() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure.i EditorGadgetGetSelectionEnd(editorNum)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			Define *buffer.GtkTextBuffer, startIter.GtkTextIter, endIter.GtkTextIter
			*buffer = gtk_text_view_get_buffer_(GadgetID(editorNum))
			If gtk_text_buffer_get_selection_bounds_(*buffer, @startIter, @endIter)
				Define endPos.i
				endPos=gtk_text_iter_get_offset_(@endIter)
				ProcedureReturn endPos
			Else
				ProcedureReturn -1
			EndIf
		CompilerCase #PB_OS_Windows
			Define startpos, endpos
			SendMessage_(GadgetID(editorNum), #EM_GETSEL, @startpos, @endpos)
			ProcedureReturn endpos
		CompilerCase #PB_OS_MacOS
			Debug "EditorGadgetGetSelectionEnd() not implemented on Mac OS"
			ProcedureReturn -1
	CompilerEndSelect
EndProcedure

Procedure colortext(Gadget,Color,BG_Color,StartColor,EndColor)
	Protected Highlight.CHARFORMAT2,ID
	#CFM_BACKCOLOR = $4000000
	ID=GadgetID(Gadget) ; turn PB ID into Win ID
											;   SendMessage_(ID, #EM_SETSEL,StartColor,EndColor) ; select text to change
	Highlight\cbSize = SizeOf(CHARFORMAT2)
	Highlight\dwMask = #CFM_COLOR|#CFM_BACKCOLOR ;mask to change Text Color and Background Color
	Highlight\crBackColor = BG_Color						 ; set Background Color
	Highlight\crTextColor = Color								 ; Set Text Color
	SendMessage_(ID, #EM_SETCHARFORMAT, #SCF_SELECTION,Highlight) ; highlight and or change text color
	SendMessage_(ID, #EM_SETSEL, 0, 0)														; turn off selection
EndProcedure


Procedure Surligner_texte(Gadget)
	
	Protected Startpos
	Protected EndPos
	Protected CouleurEcriture
	Protected CouleurFond
	
	StartPos = EditorGadgetGetSelectionStart(Gadget)
	EndPos = EditorGadgetGetSelectionEnd(Gadget)
	
	CouleurEcriture = CouleurT;GetGadgetColor(Gadget, #PB_Gadget_FrontColor)
	CouleurFond = $00FFFF			;
	
	If StartPos <> 0
		colortext(Gadget,CouleurEcriture,CouleurFond,StartPos, EndPos)
		
	EndIf
	
EndProcedure

Procedure DeSurligner_texte(Gadget)
	
	Protected Startpos
	Protected EndPos
	Protected CouleurEcriture
	Protected CouleurFond
	
	StartPos = EditorGadgetGetSelectionStart(Gadget)
	EndPos = EditorGadgetGetSelectionEnd(Gadget)
	
	CouleurEcriture  = CouleurT;GetGadgetColor(Gadget, #PB_Gadget_FrontColor)
	CouleurFond = CouleurF		 ;GetSysColor_(#COLOR_WINDOW);GetGadgetColor(Gadget, #PB_Gadget_BackColor)
	
	If StartPos <> 0
		colortext(Gadget,CouleurEcriture,CouleurFond,StartPos, EndPos)
	EndIf
	
EndProcedure

Procedure EditStreamCallback(dwCookie, pbBuff, cb, pcb)
	ProcedureReturn WriteFile_(dwCookie, pbBuff, cb, pcb, 0) ! 1
EndProcedure
Procedure CreateRTF(Gadget, nom.s)
	Protected file=CreateFile(#PB_Any, nom)
	Protected rtf.EDITSTREAM
	If file
		
		rtf\dwCookie = FileID(file)
		rtf\pfnCallback = @EditStreamCallback()
		SendMessage_(GadgetID(Gadget), #EM_STREAMOUT, #SF_RTF, rtf)
		
		CloseFile(file)  
	EndIf	
EndProcedure
Global PrinterDC

Procedure  StartPrint(Doc.s)
	mDI.DOCINFO
	mDI\cbSize = SizeOf(DOCINFO)
	mDI\lpszDocName = @Doc
	mDI\lpszOutput = 0
	StartDoc_(PrinterDC,mDI)
EndProcedure

Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, RM, TM, BM)
	
	fr.FORMATRANGE
	pd.PRINTDLG
	
	pd\lStructSize = SizeOf(PRINTDLG)
	pd\hwndOwner = hWnd
	pd\hDevMode = 0
	pd\hDevNames = 0
	pd\nFromPage = 0
	pd\nToPage = 0
	pd\nMinPage = 0
	pd\nMaxPage = 0
	pd\nCopies = 0
	pd\hInstance = hInst
	pd\Flags = #PD_RETURNDC | #PD_PRINTSETUP
	pd\lpfnSetupHook = 0
	pd\lpSetupTemplateName = 0
	pd\lpfnPrintHook = 0
	pd\lpPrintTemplateName = 0
	
	If PrintDlg_(pd)
		b = GlobalLock_(pd\hDevNames)       
		drv.s  = PeekS(b + PeekW(b))
		name.s = PeekS(b + PeekW(b + 2))
		PrinterDC = DefaultPrinter()
		
		fr\hdc = PrinterDC
		fr\hdcTarget = PrinterDC
		fr\chrg\cpMin = 0
		fr\chrg\cpMax = -1
		fr\rc\top = TM*1440
		fr\rcPage\top = fr\rc\top
		fr\rc\left = LM*1440
		fr\rcPage\left = fr\rc\left
		
		iWidthTwips = Int((GetDeviceCaps_(PrinterDC, #HORZRES)/GetDeviceCaps_(PrinterDC, #LOGPIXELSX))*1440)
		iHeightTwips = Int((GetDeviceCaps_(PrinterDC, #VERTRES )/GetDeviceCaps_(PrinterDC, #LOGPIXELSY))*1440)
		fr\rc\right = iWidthTwips-RM*1440
		fr\rcPage\right = fr\rc\right
		fr\rc\Bottom = iHeightTwips-BM*1440
		fr\rcPage\bottom = fr\rc\bottom
		
		StartPrint("RTF Printing")
		StartPage_(PrinterDC)
		
		iTextOut = 0
		iTextAmt = SendMessage_(rtfEdit, #WM_GETTEXTLENGTH, 0, 0)
		While iTextOut<iTextAmt
			iTextOut = SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, fr)           
			If iTextOut<iTextAmt                   
				EndPage_(PrinterDC)
				StartPage_(PrinterDC)
				fr\chrg\cpMin = iTextOut
				fr\chrg\cpMax = -1 
				iTextAmt = iTextAmt - iTextOut
				iTextOut = 0
			EndIf
		Wend
		SendMessage_(rtfEdit, #EM_FORMATRANGE, 1, 0)
		EndPage_(PrinterDC)
		EndDoc_(PrinterDC)
		DeleteDC_(PrinterDC)
	EndIf
EndProcedure

Procedure StreamFileInCallback(hFile, pbBuff, cb, pcb)
	ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure loadFile(Gadget, pFilePath.s)
	If ReadFile(0, pFilePath)
		If GetExtensionPart(pFilePath)="rtf"
			uFormat = #SF_RTF
		Else
			uFormat = #SF_TEXT
		EndIf
		edstr.EDITSTREAM
		edstr\dwCookie = FileID(0)
		edstr\dwError = 0
		edstr\pfnCallback = @StreamFileInCallback()
		SendMessage_(GadgetID(Gadget), #EM_STREAMIN, uFormat, edstr)
		CloseFile(0)
	Else
		MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
	EndIf
EndProcedure
Global Window_0

Global Button_Surligner, Button_normal, Editor1
Window_0 = OpenWindow(#PB_Any, 100, 100, 800, 500, "test", #PB_Window_SystemMenu)
Button_Surligner = ButtonGadget(#PB_Any, 520, 10, 100, 25, "Surligner")
Button_normal = ButtonGadget(#PB_Any, 520, 50, 100, 25, "Normal")
Button_Nouveau = ButtonGadget(#PB_Any, 520, 90, 100, 25, "Nouveau")
Button_Ouvrir = ButtonGadget(#PB_Any, 520, 130, 100, 25, "Ouvrir")
Button_Enregistrer = ButtonGadget(#PB_Any, 520, 170, 100, 25, "Enregistrer")
Button_Imprimer = ButtonGadget(#PB_Any, 520, 210, 100, 25, "Imprimer")

Editor1 = EditorGadget(#PB_Any, 10, 10, 490, 370)


SetGadgetColor(Editor1, #PB_Gadget_FrontColor     , CouleurT)
SetGadgetColor(Editor1, #PB_Gadget_BackColor      , CouleurF)

Fini = #False


For i=0 To 1000
	
	Chaine$ = Chaine$ + Chr(Random (80, 65))
	If Mod (Len(Chaine$),60) = 0
		Chaine$ = Chaine$ + Chr(13)
	EndIf
	If Mod(i,100) = 0 
		Chaine$ = Chaine$ + Chr(13) + Chr(13)
	EndIf
Next
SetGadgetText (Editor1, Chaine$)
SetActiveGadget(Editor1)


Repeat
	Event   = WaitWindowEvent(100)  
	
	Select event
		Case #PB_Event_CloseWindow
			Fini = #True
			
		Case #PB_Event_Gadget
			Select EventGadget()
				Case Button_normal
					DeSurligner_texte (Editor1)
					
					
				Case Button_surligner
					Surligner_texte (Editor1)
					
				Case 	Button_Nouveau
					ClearGadgetItems(Editor1)
					
				Case 	Button_Ouvrir
					FileName$ = OpenFileRequester("", "", "Tous|*.*", 0)
					If FileName$
						loadFile(Editor1,FileName$)
					EndIf
					
				Case 	Button_Enregistrer 
					repm=#PB_MessageRequester_Yes
					If FileSize("c:\test.rtf")>0
						repm=MessageRequester("Attention", "Ecrasez le fichier ?",#PB_MessageRequester_YesNo|#PB_MessageRequester_Warning)
					EndIf
					If repm=#PB_MessageRequester_Yes
						CreateRTF(Editor1, "c:\test.rtf");<=== changer le chemin et le nom du fichier
					EndIf
					
				Case 	Button_Imprimer
					PrintRichText(WindowID(Window_0), GetModuleHandle_(0), GadgetID(Editor1), 0, 0, 0, 0)
					
			EndSelect
	EndSelect
	
Until Fini <> #False

End
M.
hub73
Messages : 126
Inscription : sam. 16/janv./2021 20:17

Re: Surligner le texte sélectionné d'un gadget editor

Message par hub73 »

Merci Mesa tout fonctionne désormais et je peux charger et enregistrer le texte avec le surlignage !
Répondre