Code
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 EditorBackColor(Gadget, Color.l)
format.CHARFORMAT2_
format\cbSize = SizeOf(CHARFORMAT2_)
format\dwMask = $4000000 ; = #CFM_BACKCOLOR
format\crBackColor = Color
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure EditorSelect(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
sel.CHARRANGE
sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1
If LineEnd = -1
LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
EndIf
sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)
If CharEnd = -1
sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
Else
sel\cpMax + CharEnd - 1
EndIf
SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure
; Set the Text color for the Selection
; in RGB format
Procedure EditorColor(Gadget, Color.l)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_COLOR
format\crTextColor = Color
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Font Size for the Selection
; in pt
Procedure EditorFontSize(Gadget, Fontsize.l)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_SIZE
format\yHeight = FontSize*20
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Font for the Selection
; You must specify a font name, the font doesn't need
; to be loaded
Procedure EditorFont(Gadget, FontName.s)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_FACE
PokeS(@format\szFaceName, FontName)
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Format of the Selection. This can be a combination of
; the following values:
; #CFM_BOLD
; #CFM_ITALIC
; #CFM_UNDERLINE
; #CFM_STRIKEOUT
Procedure EditorFormat(Gadget, Flags.l)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
format\dwEffects = Flags
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; -------------------------------------------------------------
; Source Example:
;- Save *******
Procedure StreamFileOut_Callback(hFile, pbBuff, cb, pcb)
ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure
; Hier eine Procedure + Callback zum speichern einer Datei:
;
; FileID freie ID fьr Dateioperationen
; File Die Datei ggf. mit Pfad
; Gadget Gadget ID vom EditorGadget()
Procedure FileStreamOut(FileID.l, File.s, Gadget.l)
r.b=0
Protected StreamData.EDITSTREAM
;Wenn die Datei erzeugt werden kann, fortfahren.
If CreateFile(FileID, File)
;Das Handle der Datei speichern
StreamData\dwCookie = FileID(FileID)
StreamData\dwError = #Null
;Die Adresse der Callback Procedure speichern
StreamData\pfnCallback = @StreamFileOut_Callback()
;Das RichEdit Control anweisen, den Stream zu aktivieren
SendMessage_(GadgetID(Gadget), #EM_STREAMOUT, #SF_RTF, @StreamData)
;Datei schliessen
CloseFile(FileID)
r.b=1
EndIf
ProcedureReturn r
EndProcedure
#Editor = 1
If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(0))
ButtonGadget(0,40,10,220,28,"Сохранить в файле и открыть в Ворде")
EditorGadget(#Editor, 10, 50, 480, 430)
AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined big text")
AddGadgetItem(#Editor, 1, "Times new Roman, red, striked out and italic")
AddGadgetItem(#Editor, 2, "This is usual text, with a yellow background color")
AddGadgetItem(#Editor, 3, "This is usual Text.")
EditorSelect(#Editor, 0, 1, 0, -1) ; select line 1
EditorColor(#Editor, RGB(0,0,255))
EditorFontSize(#Editor, 18)
EditorFormat(#Editor, #CFM_UNDERLINE)
EditorSelect(#Editor, 1, 1, 1, -1) ; select line 2
EditorColor(#Editor, RGB(255,0,0))
EditorFont(#Editor, "Times New Roman")
EditorFormat(#Editor, #CFM_ITALIC|#CFM_STRIKEOUT)
EditorSelect(#Editor, 2, 1, 2, -1) ; select line 2
EditorBackColor(#Editor, RGB(255,200,100))
EditorSelect(#Editor, 0, 0, 0, 0) ; select nothing again
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_Gadget
If EventGadget()=0
FileStreamOut(0, "Temp.rtf", 1)
Delay(200)
If FileSize("Temp.rtf")>0
RunProgram("Temp.rtf")
Else
MessageRequester("", "Проблемы при создании файла!", #MB_OK|#MB_ICONERROR)
EndIf
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
EndIf
End