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.