Code : Tout sélectionner
;RichEdit.pbi
#CFM_ALLCAPS = $80
#CFM_ANIMATION = $40000
#CFM_BACKCOLOR = $4000000
#CFM_BOLD = $1
#CFM_CHARSET = $8000000
#CFM_COLOR = $40000000
#CFM_DISABLED = $2000
#CFM_EMBOSS = $800
#CFM_FACE = $20000000
#CFM_HIDDEN = $100
#CFM_IMPRINT = $1000
#CFM_ITALIC = $2
#CFM_KERNING = $100000
#CFM_LCID = $2000000
#CFM_LINK = $20
#CFM_OFFSET = $10000000
#CFM_OUTLINE = $200
#CFM_PROTECTED = $10
#CFM_REVAUTHOR = $8000
#CFM_REVISED = $4000
#CFM_SHADOW = $400
#CFM_SIZE = $80000000
#CFM_SMALLCAPS = $40
#CFM_SPACING = $200000
#CFM_STRIKEOUT = $8
#CFM_STYLE = $80000
#CFM_SUPERSCRIPT = $20000; #CFM_SUBSCRIPT
#CFM_UNDERLINE = $4
#CFM_UNDERLINETYPE = $800000
#CFM_WEIGHT = $400000
#CFE_ALLCAPS = #CFM_ALLCAPS
#CFE_AUTOBACKCOLOR = #CFM_BACKCOLOR
#CFE_AUTOCOLOR = $40000000
#CFE_BOLD = #CFM_BOLD
#CFE_DISABLED = #CFM_DISABLED
#CFE_EMBOSS = #CFM_EMBOSS
#CFE_HIDDEN = #CFM_HIDDEN
#CFE_IMPRINT = #CFM_IMPRINT
#CFE_ITALIC = #CFM_ITALIC
#CFE_LINK = #CFM_LINK
#CFE_OUTLINE = #CFM_OUTLINE
#CFE_PROTECTED = #CFM_PROTECTED
#CFE_REVISED = #CFM_REVISED
#CFE_SHADOW = #CFM_SHADOW
#CFE_SMALLCAPS = #CFM_SMALLCAPS
#CFE_STRIKEOUT = $8
#CFE_SUBSCRIPT = $10000
#CFE_SUPERSCRIPT = $20000
#CFE_UNDERLINE = $4
#CFM_SUBSCRIPT = #CFE_SUBSCRIPT | #CFE_SUPERSCRIPT
#ENM_LINK = $04000000
#PFA_JUSTIFY = 4 ;Nouvelle option d'alignement du paragraphe 2.0
#ST_DEFAULT = 0
#ST_KEEPUNDO = 1
#ST_SELECTION = 2
Structure RichEditOle
*pIntf.IRicheditOle
Refcount.l
hwnd.i
EndStructure
Interface RichEdit
Free(); libère le gadget et le conteneur d'objets
GetID.i(); renvoie l'ID PB
GethWnd.i(); renvoie le handle OS
GetX.i(); Abscisse
GetY.i(); Ordonnée
GetWidth.i(); Largeur Editeur
GetHeight.i(); Hauteur Editeur
GetReadOnly.i(); déterminer si ReadOnly oui ou non
GetCursorX.i(); Rangée du curseur
GetCursorY.i(); Colonne du curseur
GetFont.s()
GetFontSize.i()
GetFontStyle.l()
GetZoom.i(); Pourcentage Zoom
Resize(x.l, y.l, w.l, h.l)
DisableRedraw.i(bVal.i = #True);Empêche la redéfinition de l'éditeur
Clear(); Vider Editeur
GetText.s()
GetRTFText.s(); Est le flux RTF en tant que chaîne
GetSelText.s()
FindText.i(Texte.s,Drapeaux.l = #FR_DOWN);Drapeaux: #FR_DOWN, #FR_MATCHCASE, #FR_WHOLEWORD
CountWords.i()
Cut()
Copy()
Paste()
BeginUndo(); démarre l'annulation d'enregistrement
StopUndo(); termine l'annulation d'enregistrement
CanUndo.i()
Undo()
Redo()
LoadRTF(NomFichier.s, insert.l = #False)
LoadText(NomFichier.s, insert.l = #False)
SaveRTF(NomFichier.s)
SaveText(NomFichier.s)
Print(NomDoc.s = "pbprint", Dialogue.i = #False)
SetFont.i(Nom.s)
SetFontSize.i(Taille.l)
SetFontStyle.i(Style.l = 0)
SetZoom.i(zoom.i); Définir Zoom (en pour cent)
SetAlignment(Drapeau.l = #PB_Default); #PB_Text_Center, #PB_Text_Right
SetLeftMargin(pixel.w)
SetRightMargin(pixel.w)
SetCtrlBackColor.i(Couleur.l)
SetTextBackColor.i(Couleur.l)
GetTextBackColor.i()
ClearTextBackColor.i()
SetTextColor.i(CouleurTexte.l, CouleurFond.l = #PB_Default)
SetSelection.i(LigneDebut.l, CarDebut.l, LigneFin.l = #PB_Default, CarFin.l = #PB_Default)
IsTextSelected.i(); #True, lorsqu'une sélection est disponible
SetText.i(Texte.s); insère le texte à la position du curseur, ou remplace la sélection-
SetReadOnly.i(Drapeau.l); activer ou désactiver ReadOnly
SetCursorPos.i(x.l, y.l); curseur de texte
SetWordWrap.i(Drapeau.l); sur une nouvelle ligne (standard) ou à partir de
SelectAll.i(); Sélectionne tout le texte
Unselect()
Indent.i(mm.i = 10); Indentation en mm (à droite)
Outdent.i(mm.i = 10); Désengagement en mm (à gauche)
ScrollToLine(Ligne.i)
GetParagraphAlign.l()
GetLineSpacing.f()
SetLineSpacing.i(vInter.f)
IsModified.i()
SetModified.i()
IsLink.i() ;; Parce que GetFontStyle prend uniquement en charge la constante PB, mais aucune liste de liens disponibles
GetWordUnderMouse.s(x.i, y.i) ; x,y = Position de la souris par rapport au gadget!!!
GetCurrentWord.s()
Replace.i(A_Remplacer.s, Texte.s,Drapeaux.i = 0)
ReplaceAll.i(A_Remplacer.s, Texte.s,Drapeaux.i = 0)
SetBulleted.i()
GetLineCount.i()
IsSuperscript()
SetSuperscript()
IsSubscript()
SetSubscript()
ChangeFontSize(iDelta.i=1)
LimitText(iLimiter_A.i)
HideSelection(bVal.i=#True)
SetUnderlineWave()
ClearUnderlineWave()
Redraw()
GetTextLength.i()
GetTextColor.i()
IsSmallCaps()
SetSmallCaps(bVal.i = #True)
IsAllCaps()
SetAllCaps(bVal.i = #True)
CanPaste()
GetCursorPosition()
GetWordAtPosition.s(Pos.i)
GetFirstVisibleLineNumber.i()
GetFirstVisibleLinePos.i()
GetFirstVisibleLineText.s()
GetLastVisibleLineNumber.i()
GetLastVisibleLinePos.i()
GetLastVisibleLineText.s()
GetCharPosOfPreviousWord.i(Pos.i)
GetCharPosOfNextWord.i( Pos.i )
EmptyUndoBuffer()
GetFirstCharPosOnLine(iLigne.i)
GetLineLength(iLigne.i)
IsAlignLeft()
IsAlignCenter()
IsAlignRight()
IsAlignJustify()
GetWordUnderCursorStart()
GetWordUnderCursorEnd()
GetScrollPosX()
GetScrollPosY()
SetScrollPos(x.i, y.i)
SetLink(bVal = #True)
SetUndoLimit(Limite.i)
AppendText(Texte.s) ; ajoute du texte à la fin
SetHidden(bVal.i = #True)
IsHidden.i()
SetTextEx.i(sTexte.s) ;Travaux pour Unicode
SetInterface.i()
SetImage.i(hImage)
EndInterface
Structure RichEditClassTemplate
*vTable
ID.i
hWnd.i
TextInterface.ITextDocument
RTFStreamTextResult.s; Si le flux 'RTF' doit être lu dans une chaîne
TwipsPeSpaceUnit.f
WordUnderCursorRange.CHARRANGE
RichComObject.RichEditOle
EndStructure
ProcedureDLL.i New_RichEdit(x.l, y.l, w.l, h.l)
Protected *obj.RichEditClassTemplate
Protected RichEditOleObject.IRichEditOle
*obj = AllocateMemory(SizeOf(RichEditClassTemplate))
If *obj
With *obj
\vTable = ?vTable_RichEditClassTemplate
\ID = EditorGadget(#PB_Any, x, y, w, h)
\hWnd = GadgetID(\ID)
SetGadgetColor(\ID, #PB_Gadget_BackColor, #White)
SetGadgetFont(\ID, FontID(LoadFont(#PB_Any, "Arial", 10)))
SendMessage_(\hWnd, #EM_SETEVENTMASK, 0, #ENM_KEYEVENTS | #ENM_MOUSEEVENTS | #ENM_SELCHANGE | #ENM_CHANGE | #ENM_LINK)
SendMessage_(\hWnd, #EM_SETTARGETDEVICE, 0, 0)
SendMessage_(\hWnd, #EM_GETOLEINTERFACE, 0, @RichEditOleObject)
SendMessage_(\hWnd, #EM_AUTOURLDETECT , #True, 0)
If RichEditOleObject
RichEditOleObject\QueryInterface(?IID_ITextDocument, @\TextInterface)
RichEditOleObject\Release()
EndIf
SendMessage_(\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
SetActiveGadget(\ID)
EndWith
EndIf
ProcedureReturn *obj
EndProcedure
ProcedureDLL RichEdit_Free(*Ceci.RichEditClassTemplate)
FreeGadget(*Ceci\ID)
FreeMemory(*Ceci)
EndProcedure
ProcedureDLL.i RichEdit_GetID(*Ceci.RichEditClassTemplate)
ProcedureReturn *Ceci\ID
EndProcedure
ProcedureDLL.i RichEdit_GethWnd(*Ceci.RichEditClassTemplate)
ProcedureReturn *Ceci\hWnd
EndProcedure
ProcedureDLL.i RichEdit_GetX(*Ceci.RichEditClassTemplate)
ProcedureReturn GadgetX(*Ceci\ID)
EndProcedure
ProcedureDLL.i RichEdit_GetY(*Ceci.RichEditClassTemplate)
ProcedureReturn GadgetY(*Ceci\ID)
EndProcedure
ProcedureDLL.i RichEdit_GetWidth(*Ceci.RichEditClassTemplate)
ProcedureReturn GadgetWidth(*Ceci\ID)
EndProcedure
ProcedureDLL.i RichEdit_GetHeight(*Ceci.RichEditClassTemplate)
ProcedureReturn GadgetHeight(*Ceci\ID)
EndProcedure
ProcedureDLL.i RichEdit_GetReadOnly(*Ceci.RichEditClassTemplate)
Protected Style.l = GetWindowLongPtr_(*Ceci\hWnd, #GWL_STYLE)
If Style & #ES_READONLY : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_GetCursorX(*Ceci.RichEditClassTemplate)
Protected.CHARRANGE Domaine
SendMessage_(*Ceci\hWnd, #EM_EXGETSEL, 0, @Domaine)
ProcedureReturn Domaine\cpMax - (SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, SendMessage_(*Ceci\hWnd, #EM_EXLINEFROMCHAR, 0, Domaine\cpMin), 0)) + 1
EndProcedure
ProcedureDLL.i RichEdit_GetCursorY(*Ceci.RichEditClassTemplate)
Protected.CHARRANGE Domaine
SendMessage_(*Ceci\hWnd, #EM_EXGETSEL, 0, @Domaine)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_EXLINEFROMCHAR, 0, Domaine\cpMin) + 1
EndProcedure
ProcedureDLL.s RichEdit_GetFont(*Ceci.RichEditClassTemplate)
Protected.CHARFORMAT2 Format
Protected Police.s
Format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
Police = PeekS(@Format\szFaceName[0])
If Police = ""
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_DEFAULT, @Format)
Police = PeekS(@Format\szFaceName[0])
EndIf
ProcedureReturn Police
EndProcedure
ProcedureDLL.i RichEdit_GetFontSize(*Ceci.RichEditClassTemplate)
Protected.CHARFORMAT2 Format
Format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
ProcedureReturn Format\yHeight / 20
EndProcedure
ProcedureDLL.l RichEdit_GetFontStyle(*Ceci.RichEditClassTemplate)
Protected.CHARFORMAT2 Format
Protected Resultat.l = 0
With Format
\cbSize = SizeOf(CHARFORMAT2)
\dwMask = #CFM_BOLD | #CFM_ITALIC | #CFM_STRIKEOUT | #CFM_UNDERLINE
EndWith
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
If Format\dwEffects & #CFM_BOLD
Resultat | #PB_Font_Bold
EndIf
If Format\dwEffects & #CFM_ITALIC
Resultat | #PB_Font_Italic
EndIf
If Format\dwEffects & #CFM_STRIKEOUT
Resultat | #PB_Font_StrikeOut
EndIf
If Format\dwEffects & #CFM_UNDERLINE
Resultat | #PB_Font_Underline
EndIf
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_GetZoom(*Ceci.RichEditClassTemplate)
Protected wParam.l, hParam.l, Resultat.l
Resultat = SendMessage_(*Ceci\hWnd, #EM_GETZOOM, @wParam, @hParam)
ProcedureReturn Int((wParam * 100) / hParam )
EndProcedure
ProcedureDLL RichEdit_Resize(*Ceci.RichEditClassTemplate, x.l, y.l, w.l, h.l)
ResizeGadget(*Ceci\ID, x, y, w, h)
EndProcedure
ProcedureDLL.i RichEdit_DisableRedraw(*Ceci.RichEditClassTemplate, bVal.i = #True)
; Description: Lors de l'exécution de plusieurs actions, ou d'actions sur le texte qui
; n'est pas visible dans la fenêtre, ou en cas de changement
; à plusieurs reprises de sélections - un Editeur peut scintiller
; Désactiver le gadget avec WM_SETREDRAW avant de faire les
; actions, puis en inversant permettant après aux actions qui ont
; été prises peut améliorer considérablement les performances ..
;
; Paramètre(s) ......: bVal - #True (par défaut) pour désactiver Redessiner
; - #False pour activer / réactiver Redessiner
ProcedureReturn SendMessage_(*Ceci\hWnd, #WM_SETREDRAW, 1 ! bVal, 0)
EndProcedure
ProcedureDLL RichEdit_Clear(*Ceci.RichEditClassTemplate)
ClearGadgetItems(*Ceci\ID)
SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndProcedure
ProcedureDLL.s RichEdit_GetText(*Ceci.RichEditClassTemplate)
ProcedureReturn GetGadgetText(*Ceci\ID)
EndProcedure
ProcedureDLL.i RichEdit_GetRTFStreamCallback(dwCookie, *pbBuff, cb, *pcb.Long)
Protected *Ceci.RichEditClassTemplate = dwCookie
*Ceci\RTFStreamTextResult + PeekS(*pbBuff, cb)
*pcb\l = cb
ProcedureReturn 0
EndProcedure
ProcedureDLL.s RichEdit_GetRTFText(*Ceci.RichEditClassTemplate)
Protected Flux.EDITSTREAM
Flux\dwCookie = *Ceci
Flux\pfnCallback = @RichEdit_GetRTFStreamCallback()
SendMessage_(*Ceci\hWnd, #EM_STREAMOUT, #SF_RTF | #SFF_PLAINRTF, @Flux)
ProcedureReturn *Ceci\RTFStreamTextResult
EndProcedure
ProcedureDLL.s RichEdit_GetSelText(*Ceci.RichEditClassTemplate)
Protected PosDebut.l, PosFin.l, Taille.l, *mem, Resultat.s
If SendMessage_(*Ceci\hWnd, #EM_GETSEL, @PosDebut, @PosFin)
Taille = PosFin - PosDebut + 1
Taille * SizeOf(Character)
*mem = AllocateMemory(Taille)
If *mem
SendMessage_(*Ceci\hWnd, #EM_GETSELTEXT, 0, *mem)
Resultat = PeekS(*mem)
FreeMemory(*mem)
EndIf
EndIf
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_FindText(*Ceci.RichEditClassTemplate, Texte.s,Drapeaux.l = #FR_DOWN)
Protected.FINDTEXTEX ChaineAChercher
Protected.l PosActuelleCurseur
If Texte <> ""
SendMessage_(*Ceci\hWnd, #EM_GETSEL, @PosActuelleCurseur, 0)
With ChaineAChercher
\chrg\cpMin = PosActuelleCurseur
\chrg\cpMax = GetWindowTextLength_(*Ceci\hWnd)
\lpstrText = @Texte
EndWith
If SendMessage_(*Ceci\hWnd, #EM_FINDTEXTEX,Drapeaux, @ChaineAChercher) <> -1
SendMessage_(*Ceci\hWnd, #EM_SETSEL, ChaineAChercher\chrgText\cpMin, ChaineAChercher\chrgText\cpMax)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_CountWords(*Ceci.RichEditClassTemplate)
Protected Texte.s = GetGadgetText(*Ceci\ID)
Protected Compte.i = 0
Protected DernMotCar.i = 0
Protected *p.CHARACTER
If Len(Trim(Texte)) = 0 : ProcedureReturn 0 : EndIf
*p = @Texte
While *p\c <> 0
If *p\c = ' ' Or *p\c = 9 Or *p\c = 10 Or *p\c = 13
If DernMotCar
If DernMotCar > 1
Compte + 1
EndIf
DernMotCar = 0
EndIf
Else
DernMotCar + 1
EndIf
*p + SizeOf(CHARACTER)
Wend
If Not DernMotCar : Compte - 1 : EndIf
ProcedureReturn Compte + 1
EndProcedure
ProcedureDLL RichEdit_Cut(*Ceci.RichEditClassTemplate)
SendMessage_(*Ceci\hWnd, #WM_CUT, 0, 0)
EndProcedure
ProcedureDLL RichEdit_Copy(*Ceci.RichEditClassTemplate)
SendMessage_(*Ceci\hWnd, #WM_COPY, 0, 0)
EndProcedure
ProcedureDLL RichEdit_Paste(*Ceci.RichEditClassTemplate)
SendMessage_(*Ceci\hWnd, #WM_PASTE, 0, 0)
EndProcedure
ProcedureDLL RichEdit_BeginUndo(*Ceci.RichEditClassTemplate)
If *Ceci\TextInterface
*Ceci\TextInterface\Undo(-9999994, 0)
EndIf
EndProcedure
ProcedureDLL RichEdit_StopUndo(*Ceci.RichEditClassTemplate)
If *Ceci\TextInterface
*Ceci\TextInterface\Undo(-9999995, 0)
EndIf
EndProcedure
ProcedureDLL.i RichEdit_CanUndo(*Ceci.RichEditClassTemplate)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_CANUNDO, 0, 0)
EndProcedure
ProcedureDLL RichEdit_Undo(*Ceci.RichEditClassTemplate)
SendMessage_(*Ceci\hWnd, #EM_UNDO, 0, 0)
EndProcedure
ProcedureDLL RichEdit_Redo(*Ceci.RichEditClassTemplate)
SendMessage_(*Ceci\hWnd, #EM_REDO, 0, 0)
EndProcedure
ProcedureDLL RichEdit_StreamInCallback(dwCookie, *pbBuff, cb, *pcb.Long)
Protected Longueur.q
Longueur = Lof(dwCookie) - Loc(dwCookie)
If Longueur > cb
ReadData(dwCookie, *pbBuff, cb)
*pcb\l = cb
Else
ReadData(dwCookie, *pbBuff, Longueur)
*pcb\l = Longueur
EndIf
ProcedureReturn 0
EndProcedure
ProcedureDLL RichEdit_StreamOutCallback(dwCookie, *pbBuff, cb, *pcb.Long)
WriteData(dwCookie, *pbBuff, cb)
*pcb\l = cb
ProcedureReturn 0
EndProcedure
ProcedureDLL RichEdit_LoadRTF(*Ceci.RichEditClassTemplate, NomFichier.s, insert.l = #False)
Protected.EDITSTREAM Flux
Protected Drapeau.l = #SF_RTF
If insert : Drapeau | #SFF_SELECTION : EndIf
With Flux
\dwCookie = ReadFile(#PB_Any, NomFichier)
If \dwCookie
\pfnCallback = @RichEdit_StreamInCallback()
SendMessage_(*Ceci\hWnd, #EM_STREAMIN, Drapeau, @Flux)
CloseFile(\dwCookie)
SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
ProcedureDLL RichEdit_LoadText(*Ceci.RichEditClassTemplate, NomFichier.s, insert.l = #False)
Protected.EDITSTREAM Flux
Protected Drapeau.l = #SF_TEXT
If insert : Drapeau | #SFF_SELECTION : EndIf
CompilerIf #PB_Compiler_Unicode : Drapeau | #SF_UNICODE : CompilerEndIf
With Flux
\dwCookie = ReadFile(#PB_Any, NomFichier)
If \dwCookie
\pfnCallback = @RichEdit_StreamInCallback()
SendMessage_(*Ceci\hWnd, #EM_STREAMIN, Drapeau, @Flux)
CloseFile(\dwCookie)
SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
ProcedureDLL RichEdit_SaveRTF(*Ceci.RichEditClassTemplate, NomFichier.s)
Protected.EDITSTREAM Flux
With Flux
\dwCookie = CreateFile(#PB_Any, NomFichier+".Rtf")
If \dwCookie
\pfnCallback = @RichEdit_StreamOutCallback()
SendMessage_(*Ceci\hWnd, #EM_STREAMOUT, #SF_RTF, @Flux)
CloseFile(\dwCookie)
SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
ProcedureDLL RichEdit_SaveText(*Ceci.RichEditClassTemplate, NomFichier.s)
Protected.EDITSTREAM Flux
Protected Drapeau.l = #SF_TEXT
CompilerIf #PB_Compiler_Unicode : Drapeau | #SF_UNICODE : CompilerEndIf
With Flux
\dwCookie = CreateFile(#PB_Any, NomFichier)
If \dwCookie
\pfnCallback = @RichEdit_StreamOutCallback()
SendMessage_(*Ceci\hWnd, #EM_STREAMOUT, Drapeau, @Flux)
CloseFile(\dwCookie)
SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
ProcedureDLL RichEdit_Print(*Ceci.RichEditClassTemplate, NomDoc.s = "pbprint", Dialogue.i = #False)
Protected.PRINTDLG lppd
Protected.RECT cRect
Protected.FORMATRANGE FormatRange
Protected.Docinfo Docinfo
Protected DernierCar.l, LongueurMax.l, AncienModeMap.l, OffsetX.l, OffsetY.l, HorzRes.l, VertRes.l
Protected DC.i, i.i = 1
If Dialogue
lppd\lStructsize = SizeOf(PRINTDLG)
lppd\Flags = #PD_ALLPAGES | #PD_HIDEPRINTTOFILE | #PD_NOSELECTION | #PD_RETURNDC
If PrintDlg_(@lppd)
DC = lppd\hDC
EndIf
Else
DC = DefaultPrinter()
EndIf
If DC
Docinfo\cbSize = SizeOf(Docinfo)
Docinfo\lpszDocName = @NomDoc
StartDoc_(DC, Docinfo)
LongueurMax = Len(GetGadgetText(*Ceci\ID)) - SendMessage_(*Ceci\hWnd, #EM_GETLINECOUNT, 0, 0)
AncienModeMap = GetMapMode_(DC)
SetMapMode_(DC, #MM_TWIPS)
OffsetX = GetDeviceCaps_(DC, #PHYSICALOFFSETX)
OffsetY = - GetDeviceCaps_(DC, #PHYSICALOFFSETY)
HorzRes = GetDeviceCaps_(DC, #HORZRES)
VertRes = - GetDeviceCaps_(DC, #VERTRES)
SetRect_(cRect, OffsetX, OffsetY, HorzRes, VertRes)
DPtoLP_(DC, cRect, 2)
SetMapMode_(DC, AncienModeMap)
FormatRange\hDC = DC
FormatRange\hdcTarget = DC
FormatRange\rc\left = cRect\left
FormatRange\rc\top = cRect\top
FormatRange\rc\right = cRect\right
FormatRange\rc\bottom = cRect\bottom
FormatRange\rcPage\left = cRect\left
FormatRange\rcPage\top = cRect\top
FormatRange\rcPage\right = cRect\right
FormatRange\rcPage\bottom = cRect\bottom
Repeat
StartPage_(DC)
FormatRange\chrg\cpMax = - 1
DernierCar = SendMessage_(*Ceci\hWnd, #EM_FORMATRANGE, #True, @FormatRange)
FormatRange\chrg\cpMin = DernierCar
SendMessage_(*Ceci\hWnd, #EM_DISPLAYBAND, 0, cRect)
i + 1
EndPage_(DC)
Until DernierCar >= LongueurMax Or DernierCar = -1
EndDoc_(DC)
SendMessage_(*Ceci\hWnd, #EM_FORMATRANGE, 0, 0)
EndIf
EndProcedure
ProcedureDLL.i RichEdit_SetFont(*Ceci.RichEditClassTemplate, Nom.s)
Protected.CHARFORMAT Format
With Format
\cbSize = SizeOf(CHARFORMAT)
\dwMask = #CFM_FACE
PokeS(@\szFaceName[0], Nom)
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure
ProcedureDLL.i RichEdit_SetFontSize(*Ceci.RichEditClassTemplate, Taille.l)
Protected.CHARFORMAT Format
With Format
\cbSize = SizeOf(CHARFORMAT)
\dwMask = #CFM_SIZE
\yHeight = Taille * 20
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure
ProcedureDLL RichEdit_SetFontStyle(*Ceci.RichEditClassTemplate, Style.l = 0)
Protected Format.CHARFORMAT
Protected Drapeaux.l = 0
If Style & #PB_Font_Bold :Drapeaux | #CFM_BOLD : EndIf
If Style & #PB_Font_Italic :Drapeaux | #CFM_ITALIC : EndIf
If Style & #PB_Font_StrikeOut :Drapeaux | #CFM_STRIKEOUT : EndIf
If Style & #PB_Font_Underline :Drapeaux | #CFM_UNDERLINE : EndIf
With Format
\cbSize = SizeOf(CHARFORMAT)
\dwMask = #CFM_ITALIC | #CFM_BOLD | #CFM_STRIKEOUT | #CFM_UNDERLINE
\dwEffects =Drapeaux
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure
ProcedureDLL.i RichEdit_SetZoom(*Ceci.RichEditClassTemplate, zoom.i)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETZOOM, zoom, 100)
EndProcedure
ProcedureDLL.i RichEdit_SetAlignment(*Ceci.RichEditClassTemplate, Drapeau.l = #PB_Default)
Protected.PARAFORMAT Format
Select Drapeau
Case #PB_Text_Center : Drapeau = #PFA_CENTER
Case #PB_Text_Right : Drapeau = #PFA_RIGHT
Default : Drapeau = #PFA_LEFT
EndSelect
With Format
\cbSize = SizeOf(PARAFORMAT)
\dwMask = #PFM_ALIGNMENT
\wAlignment = Drapeau
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETPARAFORMAT, 0, @Format)
EndProcedure
ProcedureDLL RichEdit_SetLeftMargin(*Ceci.RichEditClassTemplate, pixel.w)
SendMessage_(*Ceci\hWnd, #EM_SETMARGINS, #EC_LEFTMARGIN, $FFFF + pixel)
EndProcedure
ProcedureDLL RichEdit_SetRightMargin(*Ceci.RichEditClassTemplate, pixel.w)
SendMessage_(*Ceci\hWnd, #EM_SETMARGINS, #EC_RIGHTMARGIN, $FFFF * pixel)
EndProcedure
ProcedureDLL.i RichEdit_SetCtrlBackColor(*Ceci.RichEditClassTemplate, Couleur.l)
ProcedureReturn SetGadgetColor(*Ceci\ID, #PB_Gadget_BackColor, Couleur)
EndProcedure
ProcedureDLL.i RichEdit_SetTextBackColor(*Ceci.RichEditClassTemplate, Couleur.l)
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_BACKCOLOR
format\crBackColor = Couleur
SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_SetTextColor(*Ceci.RichEditClassTemplate, CouleurTexte.l, CouleurFond.l = #PB_Default)
Protected.CHARFORMAT2 Format
With Format
\cbSize = SizeOf(CHARFORMAT2)
\dwMask = #CFM_COLOR | #CFM_BACKCOLOR
\crTextColor = CouleurTexte
If CouleurFond = #PB_Default
\crBackColor = GetGadgetColor(*Ceci\ID, #PB_Gadget_BackColor)
Else
\crBackColor = CouleurFond
EndIf
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure
ProcedureDLL.i RichEdit_GetTextBackColor(*Ceci.RichEditClassTemplate)
Protected CouleurRetournee.i = #White
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
; Is AutoColor?
If (format\dwEffects & #CFE_AUTOBACKCOLOR) = #CFE_AUTOBACKCOLOR
CouleurRetournee = GetSysColor_(#COLOR_WINDOW)
Else
CouleurRetournee = format\crBackColor
EndIf
ProcedureReturn CouleurRetournee
EndProcedure
ProcedureDLL.i RichEdit_ClearTextBackColor(*Ceci.RichEditClassTemplate)
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_BACKCOLOR
format\dwEffects = #CFE_AUTOBACKCOLOR
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_SetSelection(*Ceci.RichEditClassTemplate, LigneDebut.l, CarDebut.l, LigneFin.l = #PB_Default, CarFin.l = #PB_Default)
Protected.CHARRANGE sel
Protected.i hWnd = *Ceci\hWnd
With sel
\cpMin = SendMessage_(hWnd, #EM_LINEINDEX, LigneDebut, 0) + CarDebut - 1
If LigneFin = #PB_Default
LigneFin = SendMessage_(hWnd, #EM_GETLINECOUNT, 0, 0) - 1
EndIf
\cpMax = SendMessage_(hWnd, #EM_LINEINDEX, LigneFin, 0)
If CarFin = #PB_Default
\cpMax + SendMessage_(hWnd, #EM_LINELENGTH, \cpMax, 0)
Else
\cpMax + CarFin - 1
EndIf
EndWith
ProcedureReturn SendMessage_(hWnd, #EM_EXSETSEL, 0, @sel)
EndProcedure
ProcedureDLL.i RichEdit_IsTextSelected(*Ceci.RichEditClassTemplate)
Protected cr.CHARRANGE
SendMessage_(*Ceci\hWnd, #EM_EXGETSEL, 0, @cr)
If cr\cpMin <> cr\cpMax
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetText(*Ceci.RichEditClassTemplate, Texte.s)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_REPLACESEL, 0, Texte)
EndProcedure
ProcedureDLL.i RichEdit_SetReadOnly(*Ceci.RichEditClassTemplate, Drapeau.l)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETREADONLY, Drapeau, 0)
EndProcedure
ProcedureDLL.i RichEdit_SetCursorPos(*Ceci.RichEditClassTemplate, x.l, y.l)
Protected.CHARRANGE Domaine
Protected.l char, lenght
char = SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, y - 1, 0)
lenght = SendMessage_(*Ceci\hWnd, #EM_LINELENGTH, char, 0)
If lenght >= x - 1
char + x - 1
EndIf
Domaine\cpMin = char
Domaine\cpMax = char
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_EXSETSEL, 0, @Domaine)
EndProcedure
ProcedureDLL.i RichEdit_SetWordWrap(*Ceci.RichEditClassTemplate, Drapeau.l)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETTARGETDEVICE, 0, Drapeau | 1)
EndProcedure
ProcedureDLL.i RichEdit_SelectAll(*Ceci.RichEditClassTemplate)
;Sélectionner tout le contenu du gadget éditeur.
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETSEL, 0, -1)
EndProcedure
ProcedureDLL.i RichEdit_Unselect(*Ceci.RichEditClassTemplate)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETSEL, -1, 0)
EndProcedure
ProcedureDLL.i RichEdit_Indent(*Ceci.RichEditClassTemplate, mm.i = 10)
Protected format.PARAFORMAT2
format\cbSize = SizeOf(PARAFORMAT2)
;A lire en premier
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT, 0, @format)
format\dxStartIndent = Int(mm * (1440/25.4)); Millimètres juste
format\dwMask = #PFM_OFFSETINDENT
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure
ProcedureDLL.i RichEdit_Outdent(*Ceci.RichEditClassTemplate, mm.i = 10)
Protected format.PARAFORMAT2
format\cbSize = SizeOf(PARAFORMAT2)
;A lire en premier
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT, 0, @format)
format\dxStartIndent = 0 - Int(mm * (1440/25.4)) ; Millimètres juste
format\dwMask = #PFM_OFFSETINDENT
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure
ProcedureDLL.i RichEdit_ScrollToLine(*Ceci.RichEditClassTemplate, Ligne.i)
ProcedureReturn SendMessage_(*Ceci\hWnd,#EM_LINESCROLL,#Null,Ligne)
EndProcedure
ProcedureDLL.l RichEdit_GetParagraphAlign(*Ceci.RichEditClassTemplate)
; Retour #PFA_LEFT - justifié à gauche
; #PFA_CENTER - Centré
; #PFA_Right - justifié à droite
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected bRet.i = #False
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
ProcedureReturn paraf\wAlignment
EndProcedure
ProcedureDLL.i RichEdit_SetLineSpacing(*Ceci.RichEditClassTemplate, vInter.f)
; Description .......: Changer Interligne
;
; Paramètre(s) ......: vInter.f 1.0 - Interligne Normal
; 1.5 - Interligne 1.5
; 2.0 - Interligne 2.0
; d'autres modifications des valeurs de l'interligne sur mesure
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
If vInter >= 1.0
If vInter = 1.0
paraf\bLineSpacingRule = 0
ElseIf vInter = 1.5
paraf\bLineSpacingRule = 1
ElseIf vInter = 2.0
paraf\bLineSpacingRule = 2
Else
paraf\bLineSpacingRule = 5 ; espacement en lignes
paraf\dyLineSpacing = Int(vInter * 20)
EndIf
paraf\dwMask = #PFM_LINESPACING
SendMessage_(*Ceci\hWnd, #EM_SETPARAFORMAT,0, @paraf)
Else
Debug("Editor_SetParaSpacing() - Interligne trop faible (< 1.0) !")
EndIf
EndProcedure
ProcedureDLL.f RichEdit_GetLineSpacing(*Ceci.RichEditClassTemplate)
; Description .......: Obtenir une sélection d'interligne
; Valeur(s) retournée(s) ...: 1.0 - Interligne Normal
; 1.5 - Interligne 1.5
; 2.0 - Interligne 2.0
; autres valeurs sont l'interligne personnalisé
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected ValeurRetournee.f
paraf\dwMask = #PFM_LINESPACING
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT,0, @paraf)
Select paraf\bLineSpacingRule
Case 0
ValeurRetournee = 1.0
Case 1
ValeurRetournee = 1.5
Case 2
ValeurRetournee = 2.0
Default
ValeurRetournee =( paraf\dyLineSpacing / 20)
EndSelect
ProcedureReturn ValeurRetournee
EndProcedure
ProcedureDLL.i RichEdit_IsModified(*Ceci.RichEditClassTemplate)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_GETMODIFY, 0, 0)
EndProcedure
ProcedureDLL.i RichEdit_IsLink(*Ceci.RichEditClassTemplate)
Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
If cf2\dwEffects &#CFM_LINK : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.s RichEdit_GetWordUnderMouse( *Ceci.RichEditClassTemplate, x.i, y.i )
; x,y = Position de la souris par rapport au gadget !!!
Protected.TEXTRANGE TR
Protected.s Resultat
Protected.POINT ps
Protected.i Pos, Debut, Longueur, Taille
; Peut-être que nous avons besoin de quelques astuces d'ajustements.
ps\x = X ;* GetTwipsPerPixelX()
ps\y = Y ;* GetTwipsPerPixelY()
;obtenir le caractère à la position des coordonnées
Pos = SendMessage_(*Ceci\hWnd, #EM_CHARFROMPOS, 0,@ps)
;si rien, retourner chaîne vide
If pos <= 0 : ProcedureReturn "" : EndIf
Debut = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, Pos)
Longueur = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,Pos) - Debut
If Longueur<=0 : ProcedureReturn "" : EndIf
TR\chrg\cpMin = Debut
TR\chrg\cpMax = Debut+Longueur
*Ceci\WordUnderCursorRange\cpMin = TR\chrg\cpMin
*Ceci\WordUnderCursorRange\cpMax = TR\chrg\cpMax
Taille = Longueur * SizeOf(Character)
TR\lpstrText = AllocateMemory(128+Taille)
SendMessage_(*Ceci\hWnd, #EM_GETTEXTRANGE, 0, @TR)
Resultat = PeekS(TR\lpstrText,Longueur)
FreeMemory(TR\lpstrText)
ProcedureReturn Trim(ReplaceString(ReplaceString(ReplaceString(Resultat,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure
ProcedureDLL.s RichEdit_GetCurrentWord(*Ceci.RichEditClassTemplate)
Protected TR.TEXTRANGE
Protected Resultat.s
Protected SelDebut.l
Protected SelFin.l
SendMessage_(*Ceci\hWnd, #EM_GETSEL, @SelDebut, @SelFin)
Protected Debut.i = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, SelDebut)
Protected Longueur.i = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,SelDebut) - Debut
Protected Taille.i
If Longueur=0 : ProcedureReturn "" : EndIf
TR\chrg\cpMin = Debut
TR\chrg\cpMax = Debut+Longueur
Taille = Longueur* SizeOf(Character)
TR\lpstrText = AllocateMemory(128+Taille)
SendMessage_(*Ceci\hWnd, #EM_GETTEXTRANGE, 0, @TR)
Resultat = PeekS(TR\lpstrText,Longueur)
FreeMemory(TR\lpstrText)
ProcedureReturn Trim(ReplaceString(ReplaceString(ReplaceString(Resultat,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure
ProcedureDLL.i RichEdit_Replace(*Ceci.RichEditClassTemplate, A_Remplacer.s, Texte.s,Drapeaux.i = 0)
; Description .......: Remplacer un mot (pas tout le texte!)
; Paramètre(s) ......: A_Remplacer.s - Texte à Remplacé
; Texte.s - Nouveau Texte, Remplace le Texte dans 'A_Remplacer'
; Drapeaux.i - Options recherche:
; 0 - Normal
; #FR_MATCHCASE - Recherche correspondante
; #FR_Wholeword - Mots entiers, pas de sous-mots
; Valeur(s) retournée(s) ...: #True si remplacer quelque chose
Protected Info.FINDTEXT, TextLength.i = Len(A_Remplacer)
Protected Compte.i, Domaine.CHARRANGE,Trouve
Protected ValeurRetournee = #False
Info\lpstrText = @A_Remplacer
Info\chrg\cpMin = 0
Info\chrg\cpMax = -1
Drapeaux|#FR_DOWN
SendMessage_(*Ceci\hWnd, #EM_SETSEL, 0, 0)
Trouve = SendMessage_(*Ceci\hWnd, #EM_FINDTEXT,Drapeaux, @Info)
If Trouve > -1
Info\chrg\cpMin = Trouve + 1
Domaine\cpMin = Trouve
Domaine\cpMax = Trouve + TextLength
SendMessage_(*Ceci\hWnd, #EM_EXSETSEL, 0, @Domaine)
SendMessage_(*Ceci\hWnd, #EM_REPLACESEL, 0, @Texte)
ValeurRetournee = #True
EndIf
ProcedureReturn ValeurRetournee
EndProcedure
ProcedureDLL.i RichEdit_ReplaceAll(*Ceci.RichEditClassTemplate, A_Remplacer.s, Texte.s,Drapeaux.i = 0)
; Description .......: Remplacer un mot dans le Texte complet
; Paramètre(s) ......: A_Remplacer.s - Texte à Remplacer
; Texte.s - Nouveau Texte, Remplace le Texte dans 'A_Remplacer'
; Drapeaux.i - Options recherche:
; 0 - Normal
; #FR_MATCHCASE - Rechercher correspondante
; #FR_Wholeword - Mots entiers, pas de sous-mots
; Valeur(s) retournée(s) ...: Nombre de Remplacements
Protected Info.FINDTEXT, LongueurTexte.i = Len(A_Remplacer)
Protected Compte.i, Domaine.CHARRANGE,Trouve
Info\lpstrText = @A_Remplacer
Info\chrg\cpMin = 0
Info\chrg\cpMax = -1
Drapeaux|#FR_DOWN
SendMessage_(*Ceci\hWnd, #EM_SETSEL, 0, 0)
Repeat
Trouve = SendMessage_(*Ceci\hWnd, #EM_FINDTEXT,Drapeaux, @Info)
If Trouve > -1
Info\chrg\cpMin = Trouve + 1
Domaine\cpMin = Trouve
Domaine\cpMax = Trouve + LongueurTexte
SendMessage_(*Ceci\hWnd, #EM_EXSETSEL, 0, @Domaine)
SendMessage_(*Ceci\hWnd, #EM_REPLACESEL, 0, @Texte)
Compte + 1
Else
ProcedureReturn Compte
EndIf
ForEver
EndProcedure
ProcedureDLL.i RichEdit_SetBulleted(*Ceci.RichEditClassTemplate)
; Description .......: Démarrer / Modifier la sélection des puces
Protected format.PARAFORMAT
format\cbSize = SizeOf(PARAFORMAT)
format\dwMask = #PFM_NUMBERING
format\wNumbering = #PFN_BULLET
;A lire en premier
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT, 0, @format)
format\dwMask = #PFM_NUMBERING
If format\wNumbering = #PFN_BULLET
format\wNumbering = #Null
Else
format\wNumbering = #PFN_BULLET
EndIf
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure
ProcedureDLL.i RichEdit_InsertTable(*Ceci.RichEditClassTemplate, cols, rows, cellWidth)
Protected i, j, rtfTable.s
;initial \par ajoute un saut de ligne POUR ASSURER départs de table sur une nouvelle ligne.
;trgaph définit marginLeft dans les cellules, en twips (ici 30 twips)
rtfTable = "{\par \trgaph30 "
For i = 1 To cols
rtfTable + "\cellx" + Str(i * cellWidth)
Next
For j = 1 To rows
rtfTable + "\intbl "
For i = 1 To cols
rtfTable + "\cell "
; Si vous voulez insérer directement du texte, placez-le juste avant \cell
; Utilisez la ligne suivante à la place de ce qui précède, pour voir ce que je veux dire
; rtfTable + "\cellx" + Str(i * cellWidth)
Next
rtfTable = rtfTable + "\row"
Next
rtfTable = rtfTable + "\pard}"
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_REPLACESEL, 0, rtfTable)
EndProcedure
ProcedureDLL.i RichEdit_SetModified(*Ceci.RichEditClassTemplate, state.i=#True)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETMODIFY, state ,0)
EndProcedure
ProcedureDLL.i RichEdit_GetLineCount(*Ceci.RichEditClassTemplate)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_GETLINECOUNT, 0, 0)
EndProcedure
ProcedureDLL.i RichEdit_IsSuperscript(*Ceci.RichEditClassTemplate)
Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
If cf2\dwEffects &#CFM_SUPERSCRIPT : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetSuperscript(*Ceci.RichEditClassTemplate)
Protected format.CHARFORMAT2
Protected.i Drapeaux
format\cbSize = SizeOf(CHARFORMAT2)
;bascule
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, 1, @format)
Drapeaux=format\dwEffects!Drapeaux
format\dwMask = #CFM_SUPERSCRIPT
format\dwEffects =Drapeaux
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_IsSubscript(*Ceci.RichEditClassTemplate)
Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
If cf2\dwEffects &#CFM_SUBSCRIPT : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetSubscript(*Ceci.RichEditClassTemplate)
Protected format.CHARFORMAT2
Protected.i Drapeaux
format\cbSize = SizeOf(CHARFORMAT2)
;bascule
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, 1, @format)
Drapeaux=format\dwEffects!Drapeaux
format\dwMask = #CFM_SUBSCRIPT
format\dwEffects =Drapeaux
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_ChangeFontSize(*Ceci.RichEditClassTemplate, iDelta.i=1)
; Description .......: Augmenter ou diminuer la taille de la police
; Paramètre .........: Delta - Valeur d'incrémentation, Négatif ==> décrémentation
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETFONTSIZE, iDelta,0)
EndProcedure
ProcedureDLL.i RichEdit_LimitText(*Ceci.RichEditClassTemplate, iLimiter_A.i)
; Description .......: Limiter le contrôle à N caractères
; Paramètre(s) ......: iLimiter_A - Nombre de caractères
Protected.i Resultat
If iLimiter_A > 64000
Resultat = SendMessage_(*Ceci\hWnd, #EM_EXLIMITTEXT, iLimiter_A, 0)
Else
Resultat = SendMessage_(*Ceci\hWnd, #EM_LIMITTEXT, iLimiter_A, 0)
EndIf
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_HideSelection(*Ceci.RichEditClassTemplate, bVal.i=#True)
; Description .......: Définit si la marque de sélection est visible.
; Paramètre(s) ......: bVal.i - #True pour cacher, #False pour décaché
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_HIDESELECTION, bVal, 0)
EndProcedure
ProcedureDLL.i RichEdit_SetUnderlineWave(*Ceci.RichEditClassTemplate)
; Description .......: Pour marquer les passages ou des mots spéciaux avec une ligne ondulée rouge
; soulignée, vous pouvez utiliser cette procédure.
; L'utilisation est prévue pour ce correcteur orthographique, il est donc toujours
; souligner 'red'. Mais ce n'est qu'un "hack", et la
; coloration du soulignement n'a pas été documentée par ms.
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_UNDERLINETYPE
format\dwEffects = #CFE_UNDERLINE
format\bUnderlineType = #CFU_UNDERLINEWAVE | $50
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i Richedit_ClearUnderlineWave(*Ceci.RichEditClassTemplate)
; Description .......: Comme la procédure ci-dessus, elle supprime la ligne ondulée rouge
; du texte sélectionné.
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_UNDERLINETYPE
format\dwEffects = 0
format\bUnderlineType = 0;
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_Redraw( *Ceci.RichEditClassTemplate )
; Description .......: Envoie un message 'RedrawWindow()' pour le gadget.
; Utile après la désactivation / activation du dessin d'un
; Gadget.
ProcedureReturn RedrawWindow_(*Ceci\hWnd,0,0,#RDW_UPDATENOW|#RDW_ERASE|#RDW_INVALIDATE)
EndProcedure
ProcedureDLL.i RichEdit_GetTextLength( *Ceci.RichEditClassTemplate )
Protected LongueurTexte.GETTEXTLENGTHEX
LongueurTexte\flags = #GTL_NUMCHARS | #GTL_DEFAULT
;suivant le document MS, utiliser 1200 pour Unicode
CompilerIf #PB_Compiler_Unicode
LongueurTexte\codepage = 1200
CompilerElse
LongueurTexte\codepage = #CP_ACP
CompilerEndIf
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_GETTEXTLENGTHEX, @LongueurTexte, 0)
EndProcedure
ProcedureDLL.i RichEdit_GetTextColor(*Ceci.RichEditClassTemplate)
Protected CouleurRetournee.i = #White
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT,#SCF_SELECTION, @format)
If (format\dwEffects & #CFE_AUTOCOLOR) = #CFE_AUTOCOLOR
CouleurRetournee = GetSysColor_(#COLOR_WINDOWTEXT)
Else
CouleurRetournee = format\crTextColor
EndIf
ProcedureReturn CouleurRetournee
EndProcedure
ProcedureDLL.i RichEdit_IsSmallCaps(*Ceci.RichEditClassTemplate)
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @format)
If format\dwEffects & #CFE_SMALLCAPS : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetSmallCaps(*Ceci.RichEditClassTemplate, bVal.i = #True)
;Les caractères sont composés en petites capitales. La valeur n'a aucune incidence
;sur le comment contrôle affiche le texte.
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_SMALLCAPS
If bVal
format\dwEffects = #CFE_SMALLCAPS
EndIf
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_IsAllCaps(*Ceci.RichEditClassTemplate)
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT,#SCF_SELECTION, @format)
If format\dwEffects &#CFE_ALLCAPS : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetAllCaps(*Ceci.RichEditClassTemplate, bVal.i = #True)
;Les caractères sont en majuscules. La valeur n'affecte pas la façon dont le
;contrôle affiche le texte. Cette valeur s'applique uniquement aux versions
;antérieures à Microsoft Rich Edit 3.0
Protected format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_ALLCAPS
If bVal
format\dwEffects = #CFE_ALLCAPS
EndIf
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
ProcedureDLL.i RichEdit_CanPaste(*Ceci.RichEditClassTemplate)
; Description....: Le contenu du presse-papiers peut-il être collé dans le contrôle?
;
; Remarques .......: Des données dans deux formats presse-papiers peuvent être collées. RTF et RTF avec des objets
; Cette fonction détermine si les données sont soit au format soit dans le presse-papiers.
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_CANPASTE, 0, 0)
EndProcedure
ProcedureDLL.i RichEdit_GetCursorPosition(*Ceci.RichEditClassTemplate)
Protected SelDebut.l
Protected SelFin.l
SendMessage_(*Ceci\hWnd, #EM_GETSEL, @SelDebut, @SelFin)
ProcedureReturn SelDebut
EndProcedure
ProcedureDLL.s RichEdit_GetWordAtPosition(*Ceci.RichEditClassTemplate, Pos.i)
Protected TR.TEXTRANGE
Protected Resultat.s
Protected Debut.i = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, Pos)
Protected Longueur.i = SendMessage_(*Ceci\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,Pos) - Debut
Protected Taille.i
If Longueur<=0 : ProcedureReturn "" : EndIf
TR\chrg\cpMin = Debut
TR\chrg\cpMax = Debut+Longueur
Taille = Longueur * SizeOf(Character)
TR\lpstrText = AllocateMemory(128+Taille)
SendMessage_(*Ceci\hWnd, #EM_GETTEXTRANGE, 0, @TR)
Resultat = PeekS(TR\lpstrText,Longueur)
FreeMemory(TR\lpstrText)
ProcedureReturn Trim(ReplaceString(ReplaceString(ReplaceString(Resultat,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure
ProcedureDLL.i RichEdit_GetFirstVisibleLineNumber(*Ceci.RichEditClassTemplate)
Protected Resultat=SendMessage_(*Ceci\hWnd,#EM_GETFIRSTVISIBLELINE,0 ,0)
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_GetFirstVisibleLinePos(*Ceci.RichEditClassTemplate)
Protected Resultat.i
Protected iLigneHaut.i= SendMessage_(*Ceci\hWnd,#EM_GETFIRSTVISIBLELINE,0 ,0)
;position du 1er car en ligne iLigneHaut
Resultat = SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, iLigneHaut ,0)
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.s RichEdit_GetFirstVisibleLineText(*Ceci.RichEditClassTemplate)
Protected iLigneHaut.i, iLongueurLigne.i, iPosCar.i, Resultat.s
iLigneHaut=SendMessage_(*Ceci\hWnd, #EM_GETFIRSTVISIBLELINE, 0 ,0)
iPosCar=SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, iLigneHaut ,0)
iLongueurLigne=SendMessage_(*Ceci\hWnd, #EM_LINELENGTH ,iPosCar ,0)
Resultat = Space(iLongueurLigne)
SendMessage_(*Ceci\hWnd, #EM_GETLINE, iLigneHaut ,@Resultat)
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_GetLastVisibleLineNumber(*Ceci.RichEditClassTemplate)
Protected iPremiereLigne.i, iDerniereLigne.i
Protected p.POINT
p\x = GadgetWidth(*Ceci\ID)
p\y = GadgetHeight(*Ceci\ID)
iPremiereLigne = SendMessage_(*Ceci\hWnd, #EM_GETFIRSTVISIBLELINE, 0 ,0)
iDerniereLigne = SendMessage_(*Ceci\hWnd, #EM_CHARFROMPOS, 0, @p)
iDerniereLigne = SendMessage_(*Ceci\hWnd, #EM_LINEFROMCHAR, iDerniereLigne, 0)
ProcedureReturn iDerniereLigne
EndProcedure
ProcedureDLL.i RichEdit_GetLastVisibleLinePos(*Ceci.RichEditClassTemplate)
Protected *self.RichEdit = *Ceci ;L'accès à leurs propres fonctions de classe
Protected Resultat.i
Protected iLigneBas.i= *self\GetLastVisibleLineNumber()
Resultat = SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, iLigneBas+1 ,0)
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.s RichEdit_GetLastVisibleLineText(*Ceci.RichEditClassTemplate)
Protected *Auto.RichEdit = *Ceci ;L'accès à leurs propres fonctions de classe
Protected iLongueurLigne.i, iPosCar.i, Resultat.s
Protected iLigneBas.i = *Auto\GetLastVisibleLineNumber()
iPosCar=SendMessage_(*Ceci\hWnd , #EM_LINEINDEX, iLigneBas ,0)
iLongueurLigne=SendMessage_(*Ceci\hWnd, #EM_LINELENGTH ,iPosCar ,0)
Resultat = Space(iLongueurLigne)
SendMessage_(*Ceci\hWnd, #EM_GETLINE, iLigneBas ,@Resultat)
ProcedureReturn Resultat
EndProcedure
ProcedureDLL.i RichEdit_GetCharPosOfPreviousWord(*Ceci.RichEditClassTemplate, Pos.i)
ProcedureReturn SendMessage_( *Ceci\hWnd, #EM_FINDWORDBREAK, #WB_MOVEWORDLEFT, pos)
EndProcedure
ProcedureDLL.i RichEdit_GetCharPosOfNextWord(*Ceci.RichEditClassTemplate, pos)
ProcedureReturn SendMessage_( *Ceci\hWnd, #EM_FINDWORDBREAK, #WB_MOVEWORDRIGHT, pos)
EndProcedure
ProcedureDLL.i RichEdit_EmptyUndoBuffer(*Ceci.RichEditClassTemplate)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndProcedure
ProcedureDLL.i RichEdit_GetFirstCharPosOnLine(*Ceci.RichEditClassTemplate, iLigne.i)
If iLigne > 0 : iLigne -1 : EndIf
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_LINEINDEX, iLigne, 0)
EndProcedure
ProcedureDLL.i RichEdit_GetLineLength(*Ceci.RichEditClassTemplate, iLigne.i)
Protected.RichEdit *Auto = *Ceci ;L'accès à leurs propres fonctions de classe
Protected.i PosCar
PosCar = *Auto\GetFirstCharPosOnLine(iLigne)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_LINELENGTH, PosCar, 0)
EndProcedure
ProcedureDLL.i RichEdit_IsAlignLeft(*Ceci.RichEditClassTemplate)
;Vérifie si le paragraphe est aligné à gauche
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected bRet.i = #False
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
If paraf\wAlignment = #PFA_LEFT : bRet = #True: EndIf
ProcedureReturn bRet
EndProcedure
ProcedureDLL.i RichEdit_IsAlignCenter(*Ceci.RichEditClassTemplate)
;Vérifie si le paragraphe est centré
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected bRet.i = #False
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
If paraf\wAlignment = #PFA_CENTER : bRet = #True: EndIf
ProcedureReturn bRet
EndProcedure
ProcedureDLL.i RichEdit_IsAlignRight(*Ceci.RichEditClassTemplate)
;Vérifie si le paragraphe est aligné à droite
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected bRet.i = #False
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
If paraf\wAlignment = #PFA_RIGHT : bRet = #True: EndIf
ProcedureReturn bRet
EndProcedure
ProcedureDLL.i RichEdit_IsAlignJustify(*Ceci.RichEditClassTemplate)
;Vérifie si le paragraphe est justifié Aligner à droite
Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
Protected bRet.i = #False
SendMessage_(*Ceci\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
If paraf\wAlignment = #PFA_JUSTIFY : bRet = #True: EndIf
ProcedureReturn bRet
EndProcedure
ProcedureDLL.i RichEdit_GetWordUnderCursorStart(*Ceci.RichEditClassTemplate)
ProcedureReturn *Ceci\WordUnderCursorRange\cpMin
EndProcedure
ProcedureDLL.i RichEdit_GetWordUnderCursorEnd(*Ceci.RichEditClassTemplate)
ProcedureReturn *Ceci\WordUnderCursorRange\cpMax
EndProcedure
ProcedureDLL.i RichEdit_GetScrollPosX(*Ceci.RichEditClassTemplate)
Protected pt.POINT
SendMessage_(*Ceci\hWnd, #EM_GETSCROLLPOS, 0 , @pt)
ProcedureReturn pt\x
EndProcedure
ProcedureDLL.i RichEdit_GetScrollPosY(*Ceci.RichEditClassTemplate)
Protected pt.POINT
SendMessage_(*Ceci\hWnd, #EM_GETSCROLLPOS, 0 , @pt)
ProcedureReturn pt\y
EndProcedure
ProcedureDLL.i RichEdit_SetScrollPos(*Ceci.RichEditClassTemplate,x.i,y.i)
Protected pt.POINT
pt\x = x
pt\y = y
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETSCROLLPOS, 0 , @pt)
EndProcedure
ProcedureDLL.i RichEdit_SetLink(*Ceci.RichEditClassTemplate, bVal.i = #True)
Protected Format.CHARFORMAT
With Format
\cbSize = SizeOf(CHARFORMAT)
\dwMask = #CFM_LINK
If bVal
\dwEffects = #CFE_LINK
EndIf
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure
ProcedureDLL.i RichEdit_SetUndoLimit(*Ceci.RichEditClassTemplate, Limite.l)
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETUNDOLIMIT, Limite, 0)
EndProcedure
ProcedureDLL.i RichEdit_AppendText(*Ceci.RichEditClassTemplate, sTexte.s)
Protected.SETTEXTEX DefinirTexte
Protected.i NbreLignes = SendMessage_(*Ceci\Hwnd, #EM_GETLINECOUNT, 0, 0)
Protected.i IndexLigne = SendMessage_(*Ceci\Hwnd, #EM_LINEINDEX, NbreLignes-1, 0)
Protected.i LongueurLigne = SendMessage_(*Ceci\Hwnd, #EM_LINELENGTH, IndexLigne, 0)
LongueurLigne + IndexLigne
SendMessage_(*Ceci\Hwnd, #EM_SETSEL, LongueurLigne, LongueurLigne)
SendMessage_(*Ceci\Hwnd, #EM_HIDESELECTION, 0, 0)
;Suivant la doc MS, 1200 pour Unicode
CompilerIf #PB_Compiler_Unicode
DefinirTexte\codepage = 1200
CompilerElse
DefinirTexte\codepage = #CP_ACP
CompilerEndIf
DefinirTexte\flags = #ST_SELECTION
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETTEXTEX, @DefinirTexte, @sTexte)
EndProcedure
ProcedureDLL.i RichEdit_SetHidden(*Ceci.RichEditClassTemplate, bVal.i = #True)
Protected Format.CHARFORMAT2
With Format
\cbSize = SizeOf(CHARFORMAT2)
\dwMask = #CFM_HIDDEN
If bVal
\dwEffects = #CFE_HIDDEN
EndIf
EndWith
ProcedureReturn SendMessage_(*Ceci\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION | #SCF_USEUIRULES, @Format)
EndProcedure
ProcedureDLL.i RichEdit_IsHidden(*Ceci.RichEditClassTemplate)
Protected Format.CHARFORMAT2
With Format
\cbSize = SizeOf(CHARFORMAT2)
\dwMask = #CFM_HIDDEN
EndWith
SendMessage_(*Ceci\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION | #SCF_USEUIRULES , @format)
If format\dwEffects & #CFE_HIDDEN : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
ProcedureDLL.i RichEdit_SetTextEx(*Ceci.RichEditClassTemplate, sTexte.s)
Protected tx.SETTEXTEX
Protected *mem
Protected.SETTEXTEX DefinirTexte
;;Suivant la doc MS, 1200 pour Unicode
CompilerIf #PB_Compiler_Unicode
DefinirTexte\codepage = 1200
*mem = AllocateMemory(MemoryStringLength(@sTexte , #PB_Unicode) + 1)
CompilerElse
DefinirTexte\codepage = #CP_ACP
*mem = AllocateMemory(MemoryStringLength(@sTexte , #PB_UTF8) + 1)
CompilerEndIf
If *mem
PokeS(*mem , sTexte , -1 , #PB_UTF8)
SendMessage_(*Ceci\hwnd, #EM_SETTEXTEX , tx , *mem)
FreeMemory(*mem)
EndIf
EndProcedure
ProcedureDLL.i RichEdit_SetInterface(*Ceci.RichEditClassTemplate)
*Ceci\RichComObject\pIntf = ?vTable_RichEditOle
*Ceci\RichComObject\hwnd = *Ceci\hWnd
SendMessage_(*Ceci\hWnd, #EM_SETOLECALLBACK, 0, *Ceci\RichComObject)
ProcedureReturn *Ceci\RichComObject
EndProcedure
ProcedureDLL RichEdit_SetImage(*Ceci.RichEditClassTemplate, hImage)
Protected rtf$, bitmap.BITMAP, screenDC, hdcMF, hMF, hdc
Protected oldImage, widthTwips, heightTwips, numBytes, mem, *bytes.BYTE, *string.WORD, i, low, high
Protected tx.SETTEXTEX
Protected *mem
If GetObject_(hImage, SizeOf(BITMAP), bitmap)
If bitmap\bmWidth And bitmap\bmHeight
screenDC = GetDC_(0)
;Créer un EMF pour tenir le bitmap.
hdcMF = CreateMetaFile_(0)
If hdcMF
SetMapMode_(hdcMF, #MM_ANISOTROPIC)
SetWindowOrgEx_(hdcMF, 0, 0, 0)
SetWindowExtEx_(hdcMF, bitmap\bmWidth, bitmap\bmHeight, 0)
hdc = CreateCompatibleDC_(screenDC)
If hdc
oldImage = SelectObject_(hdc, hImage)
BitBlt_(hdcMF, 0, 0, bitmap\bmWidth, bitmap\bmHeight, hdc, 0, 0, #SRCCOPY)
SelectObject_(hdc, oldImage)
DeleteDC_(hdc)
hMF = CloseMetaFile_(hdcMF)
If hMF
;Avant de créer l'en-tête RTF nous devons calculer la largeur d'image / taille en twips.
widthTwips = MulDiv_(bitmap\bmWidth,1440,GetDeviceCaps_(screenDC, #LOGPIXELSX))
heightTwips = MulDiv_(bitmap\bmHeight,1440,GetDeviceCaps_(screenDC, #LOGPIXELSY))
;Maintenant, l'en-tête RTF.
rtf$ = "{\rtf1{\pict\wmetafile8\picw" + Str(bitmap\bmWidth) + "\pich" + Str(bitmap\bmHeight) + "\picwgoal" + Str(widthTwips) + "\pichgoal" + Str(heightTwips) + " "
;Ajouter les bits MF comme double caractère hexadécimal.
;D'abord récupérer les bits MF.
numBytes = GetMetaFileBitsEx_(hMF, 0, 0)
mem = AllocateMemory(numBytes*3)
If mem
If GetMetaFileBitsEx_(hMF, numBytes, mem) = numBytes
*bytes=mem : *string = mem + numBytes
For i = 0 To numBytes-1
low = (*bytes\b)&$f + '0': high = (*bytes\b)>>4&$f + '0'
If low > '9'
low + 7
EndIf
If high > '9'
high + 7
EndIf
*string\w = low<<8 + high
*string + 2
*bytes + 1
Next
rtf$ + PeekS(mem + numBytes, numBytes<<1, #PB_Ascii) + "}}"
Else
rtf$ = ""
EndIf
FreeMemory(mem)
Else
rtf$ = ""
EndIf
DeleteMetaFile_(hMF)
EndIf
Else
hMF = CloseEnhMetaFile_(hdcMF)
DeleteEnhMetaFile_(hMF)
EndIf
EndIf
ReleaseDC_(0, screenDC)
EndIf
EndIf
If rtf$
*mem = AllocateMemory(StringByteLength(rtf$ , #PB_UTF8) + 1)
tx\flags = #ST_SELECTION
If *mem
PokeS(*mem , rtf$ , -1 , #PB_UTF8)
SendMessage_(*Ceci\hwnd, #EM_SETTEXTEX , tx , *mem)
FreeMemory(*mem)
EndIf
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;{ Interface pour rappel OLE
ProcedureDLL RichEdit_QueryInterface(*pObject.RichEditOle, REFIID, *ppvObj.Integer)
Protected *pointeur.IRicheditOle
*pointeur=*pObject
If CompareMemory(REFIID, ?IID_IUnknown, 16) = 1 Or CompareMemory(REFIID, ?IID_IRichEditOleCallback, 16) = 1
*ppvObj\i = *pObject
*pointeur\AddRef()
ProcedureReturn #S_OK
Else
*ppvObj=0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
ProcedureDLL RichEdit_AddRef(*pObject.RichEditOle)
*pObject\Refcount + 1
ProcedureReturn *pObject\Refcount
EndProcedure
ProcedureDLL RichEdit_Release(*pObject.RichEditOle)
*pObject\Refcount - 1
If *pObject\Refcount > 0
ProcedureReturn *pObject\Refcount
Else
*pObject = 0
EndIf
EndProcedure
ProcedureDLL RichEdit_GetInPlaceContext(*pObject.RichEditOle, lplpFrame, lplpDoc, lpFrameInfo)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_ShowContainerUI(*pObject.RichEditOle, fShow)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_QueryInsertObject(*pObject.RichEditOle, lpclsid, lpstg, cp)
ProcedureReturn #S_OK
EndProcedure
ProcedureDLL RichEdit_DeleteObject(*pObject.RichEditOle, lpoleobj)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_QueryAcceptData(*pObject.RichEditOle, lpdataobj, lpcfFormat, reco, fReally, hMetaPict)
ProcedureReturn #S_OK
EndProcedure
ProcedureDLL RichEdit_ContextSensitiveHelp(*pObject.RichEditOle, fEnterMode)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_GetClipboardData(*pObject.RichEditOle, lpchrg, reco, lplpdataobj)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_GetDragDropEffect(*pObject.RichEditOle, fDrag, grfKeyState, pdwEffect)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_GetContextMenu(*pObject.RichEditOle, seltype.w, lpoleobj, lpchrg, lphmenu)
ProcedureReturn #E_NOTIMPL
EndProcedure
ProcedureDLL RichEdit_GetNewStorage(*pObject.RichEditOle, lplpstg)
Protected sc, lpLockBytes, t.ILockBytes
;Essayer de créer un objet tableau d'octets qui agit en tant que «fondation» pour le fichier composé à venir.
sc = CreateILockBytesOnHGlobal_(#Null, #True, @lpLockBytes)
If sc ;Cela signifie que l'allocation a échoué.
ProcedureReturn sc
EndIf
;Allocation réussie si nous essayons maintenant de créer un objet de stockage composé de fichier.
sc=StgCreateDocfileOnILockBytes_(lpLockBytes, #STGM_SHARE_EXCLUSIVE|#STGM_READWRITE|#STGM_CREATE, 0, lplpstg)
t = lpLockBytes
t\Release()
EndProcedure
;}