Code: Select all
#PD_ALLPAGES = $00000000
#PD_COLLATE = $10
#PD_DISABLEPRINTTOFILE = $80000
#PD_ENABLEPRINTHOOK = $1000
#PD_ENABLEPRINTTEMPLATE = $4000
#PD_ENABLEPRINTTEMPLATEHANDLE = $10000
#PD_ENABLESETUPHOOK = $2000
#PD_ENABLESETUPTEMPLATE = $8000
#PD_ENABLESETUPTEMPLATEHANDLE = $20000
#PD_HIDEPRINTTOFILE = $100000
#PD_NONETWORKBUTTON = $200000
#PD_NOPAGENUMS = $8
#PD_NOSELECTION = $4
#PD_NOWARNING = $80
#PD_PAGENUMS = $2
#PD_PRINTSETUP = $40
#PD_PRINTTOFILE = $20
#PD_RETURNDC = $100
#PD_RETURNDEFAULT = $400
#PD_RETURNIC = $200
#PD_SELECTION = $1
#PD_SHOWHELP = $800
#PD_USEDEVMODECOPIES = $40000
#PD_USEDEVMODECOPIESANDCOLLATE = $40000
Global HwndEditText,PrinterDC,EStream.EDITSTREAM
Procedure Sel_Text(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
sel.CHARRANGE
sel\cpMin = SendMessage_(HwndEditText, #EM_LINEINDEX, LineStart, 0) + CharStart - 1
If LineEnd = -1
LineEnd = SendMessage_(HwndEditText, #EM_GETLINECOUNT, 0, 0)-1
EndIf
sel\cpMax = SendMessage_(HwndEditText, #EM_LINEINDEX, LineEnd, 0)
If CharEnd = -1
sel\cpMax + SendMessage_(HwndEditText, #EM_LINELENGTH, sel\cpMax, 0)
Else
sel\cpMax + CharEnd - 1
EndIf
SendMessage_(HwndEditText, #EM_EXSETSEL, 0, @sel)
EndProcedure
Procedure Sel_FontName(Gadget, FontName.s)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_FACE
PokeS(@format\szFaceName, FontName)
SendMessage_(HwndEditText, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure Sel_FontColor(Gadget, Color)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_COLOR
format\crTextColor = Color
SendMessage_(HwndEditText, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure Sel_FontSize(Gadget, Fontsize)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_SIZE
format\yHeight = FontSize*20
SendMessage_(HwndEditText, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure Sel_CharFormat(Gadget, Flags)
format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
format\dwEffects = Flags
SendMessage_(HwndEditText, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure SetMargin(Gad, PageW,PageH, LM, TM, RM, BM)
r.RECT
r\left = LM
r\top = TM
r\right = PageW - RM
r\bottom = PageH - BM
SendMessage_(HwndEditText, #EM_SETRECTNP, 0, r)
EndProcedure
Procedure StartPrint(Doc.s)
d.DOCINFO
d\cbSize = SizeOf(d)
d\lpszDocName = @Doc
d\lpszOutput = 0
StartDoc_(PrinterDC,d)
EndProcedure
Procedure PrintRichText(hWnd, hInst, rtfEdit, LM, TM, RM, BM)
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_HIDEPRINTTOFILE | #PD_NONETWORKBUTTON |#PD_RETURNDC | #PD_PRINTSETUP
pd\lpfnSetupHook = 0
pd\lpSetupTemplateName = 0
pd\lpfnPrintHook = 0
pd\lpPrintTemplateName = 0
If PrintDlg_(pd)
PrinterDC = pd\hDC
Else
ProcedureReturn 1
EndIf
If PrinterDC
cxPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETX)
cyPhysOffset = GetDeviceCaps_(PrinterDC, #PHYSICALOFFSETY)
cxPhys = GetDeviceCaps_(PrinterDC, #PHYSICALWIDTH)
cyPhys = GetDeviceCaps_(PrinterDC, #PHYSICALHEIGHT)
SendMessage_(rtfEdit, #EM_SETTARGETDEVICE, PrinterDC, cxPhys*20)
fr.FORMATRANGE
fr\hdc = PrinterDC
fr\hdcTarget = PrinterDC
fr\chrg\cpMin = 0
fr\chrg\cpMax = -1
fr\rcPage\left = 0
fr\rcPage\top = 0
fr\rcpage\right = 0
fr\rcPage\bottom = 0
fr\rc\left = LM*20
fr\rc\top = TM*20
fr\rc\right = cxPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSX)- RM*20
fr\rc\Bottom = cyPhys * 1440/ GetDeviceCaps_(PrinterDC, #LOGPIXELSY)- BM*20
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, 0, 0)
EndPage_(PrinterDC)
EndDoc_(PrinterDC)
DeleteDC_(PrinterDC)
EndIf
EndProcedure
Procedure StreamInCallback(hFile, pbBuff, cb, pcb)
ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure
Procedure loadFile(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 = @StreamInCallback()
SendMessage_(HwndEditText, #EM_STREAMIN, uFormat, edstr)
CloseFile(0)
Else
MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok)
EndIf
EndProcedure
;
Procedure StreamOutCallback(dwCookie, *pbBuff, cb, *pcb.Long)
WriteData(dwCookie, *pbBuff, cb)
*pcb\l = cb
ProcedureReturn 0
EndProcedure
Procedure SaveRTF( gad,FileName.s)
Protected.EDITSTREAM stream
With stream
\dwCookie = CreateFile(#PB_Any, FileName)
If \dwCookie
\pfnCallback = @StreamOutCallback()
SendMessage_(HwndEditText, #EM_STREAMOUT, #SF_RTF, @stream)
CloseFile(\dwCookie)
SendMessage_(HwndEditText, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
Procedure SaveText(gad, FileName.s)
Protected.EDITSTREAM stream
Protected Flag.l = #SF_TEXT
CompilerIf #PB_Compiler_Unicode : Flag | #SF_UNICODE : CompilerEndIf
With stream
\dwCookie = CreateFile(#PB_Any, FileName)
If \dwCookie
\pfnCallback = @StreamOutCallback()
SendMessage_(HwndEditText, #EM_STREAMOUT, Flag, @stream)
CloseFile(\dwCookie)
SendMessage_(HwndEditText, #EM_EMPTYUNDOBUFFER, 0, 0)
EndIf
EndWith
EndProcedure
Procedure WndProc(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_SIZE
MoveWindow_( HwndEditText,10,10,WindowWidth(0)-20,WindowHeight(0)-50,1)
MoveWindow_( GadgetID(1),10,WindowHeight(0)-30,80,20,1)
EndSelect
ProcedureReturn result
EndProcedure
Procedure CreateRTFEdit(x,y,w,h)
hInstance = GetModuleHandle_(0)
If OpenLibrary(0,"msftedit.dll")
Class_Name$ = "RichEdit50W"
ElseIf OpenLibrary(0,"Riched20.dll") And Class_Name$ = ""
Class_Name$ = "RichEdit20W"
ElseIf OpenLibrary(0,"Riched32.dll") And Class_Name$ = ""
Class_Name$ = "RichEdit"
Else
MessageRequester("Error","Sorry ,RichEdit Can not be created",#MB_ICONWARNING)
EndIf
HwndEditText = CreateWindowEx_(#WS_EX_STATICEDGE,Class_Name$,"", #WS_VISIBLE | #WS_CHILDWINDOW | #WS_HSCROLL | #WS_VSCROLL | #ES_MULTILINE | #ES_NOHIDESEL | #ES_WANTRETURN, x,y,w,h,WindowID(0),300,hInstance,0)
SendMessage_(HwndEditText,#EM_SETLIMITTEXT,$7FFFFFFE,0)
EndProcedure
OpenWindow(0, 200, 50, 640, 400,"RTF Load,Save & Print", #PB_Window_SystemMenu|#PB_Window_ScreenCentered | #PB_Window_SizeGadget)
CreatePopupImageMenu(0,#PB_Menu_ModernLook)
MenuItem(0, "&Open")
OpenSubMenu("&Save As..")
MenuItem( 1, "RTF File")
MenuItem( 2, "Plain Text")
CloseSubMenu()
MenuBar()
MenuItem(3, "&Cut")
MenuItem(4, "&Copy")
MenuItem(5, "&Paste")
MenuBar()
MenuItem(6, "&Print")
MenuBar()
MenuItem(7, "&Quit")
CreateRTFEdit(10, 10, 620,350)
;EditorGadget(0, 10, 10, 620,350)
ButtonGadget(1,10,370,80,20,"Add Text")
;SendMessage_(HwndEditText, #EM_LIMITTEXT, -1, 0)
a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
a=a+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
*MemoryBuffer = AllocateMemory(Len(a.s)+1)
PokeS(*MemoryBuffer, a.s, Len(a.s)+1,#PB_Ascii)
SendMessage_(HwndEditText,#EM_REPLACESEL,0,PeekS(*MemoryBuffer ,Len(a.s)+1,#PB_Unicode))
SetWindowCallback(@WndProc())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #PB_Event_Menu
Select EventMenu()
Case 0
FileName$ = OpenFileRequester("", "", "RTF (*.rtf|*.rtf|Text (*.txt)|*.txt;*.bat|All files (*.*)|*.*", 0)
If FileName$
loadFile(FileName$)
EndIf
Case 1
FileName$ = SaveFileRequester("", "", "RTF (*.rtf|*.rtf|All files (*.*)|*.*", 0)
If FileName$
SaveRTF( HwndEditText, FileName$)
EndIf
Case 2
FileName$ = SaveFileRequester("", "", "Text (*.txt)|*.txt|All files (*.*)|*.*", 0)
If FileName$
SaveText(HwndEditText, FileName$)
EndIf
Case 3
SendMessage_(HwndEditText,#WM_CUT,0,0)
Case 4
ClearClipboard()
SendMessage_(HwndEditText,#WM_COPY,0,0)
Case 5
While WindowEvent(): Wend
SendMessage_(HwndEditText,#WM_PASTE,0,0)
Case 6
PrintRichText(WindowID(0), GetModuleHandle_(0), HwndEditText, 10, 10, 20, 20)
Case 7
Quit = 1
EndSelect
Case #WM_RBUTTONDOWN
DisplayPopupMenu(0, WindowID(0))
Case #PB_Event_Gadget
Select EventGadget()
Case 1
EndSelect
EndSelect
Until Quit = 1
DestroyWindow_(HwndEditText)
CloseLibrary(0)
End