Hello Charles
How to preload a RTF file into a rich edit control ?
i have modified the RichEdit2_64.o2bas which is atteched , and i want to have the
rich edit control to load a RTF file automatically.
i would like to load the file "about this program.rtf" when the program opens
how to do this ? please see attechment
note that you need to change the Richedit2_64.bas to Richedit2_64.o2bas
as this forum doesn't allow for o2bas extension
and change extension to the "about the program.doc" file to become "about this program.rtf"
as this forum doesn't allow for rtf extension
> and change extension to the "about the program.doc" file to become "about this program.rtf"
as this forum doesn't allow for rtf extension
It is better to post a zipped file. It also avoids the annoying Windows warning when trying to open unzipped files downloaded from internet.
Thanxx Jose
the zip file is atteched , but upon running the RichEdit2_64.exe it just exit ?
looks like i can't use GetFile command to load the the "about the program.rtf" into a string gTxt
bcos GetFile cannot be used for rtf files ?
Hi Chris,
Could you try: gTxt=Getfile "about the program.rtf"
instead of: Getfile "about the program.rtf" , gTxt
Thanxx Charles
Still didn't work
when i add more functions and when compile i got this error message from the linker
and i can't find where the location of these errors as no line numbers are given
can you please help? as the error messages are not detail enough to pinpoint where it is??
'====================================================================
' Richedit with Menu, PopupMenu and Accelerators, modeless dialog as main.
'====================================================================
' RichEdit2_64.o2bas
$ filename "RichEdit2_64.exe"
use rtl64
uses corewin
'% review
#lookahead
uses dialogs
'namespace
% DS_CENTER=0x0800
% SWP_NOZORDER=4
% ENM_MOUSEEVENTS=0x20000
% EM_SETEVENTMASK=0x445
% EN_MSGFILTER=0x700
% TPM_LEFTALIGN=0
% TPM_TOPALIGN=0
% TPM_RETURNCMD=0x100
% TPM_HORPOSANIMATION=0x0400
%EM_SETBKGNDCOLOR = %WM_USER + 67
%EM_STREAMIN = %WM_USER + 73
%EM_SETOLECALLBACK = %WM_USER + 70
%SF_RTF = &H0002
'Hresults values from
' https://msdn.microsoft.com/en-us/library/windows/desktop/aa378137(v=vs.85).aspx
' Operation successful
%S_OK = 0x00000000
' Not implemented
%E_NOTIMPL = 0x80004001
' https://msdn.microsoft.com/en-us/library/windows/desktop/aa380337(v=vs.85).aspx
%STGM_READ = 0x00000000L
%STGM_READWRITE = 0x00000002L
%STGM_CREATE =0x00001000L
%STGM_SHARE_EXCLUSIVE = 0x00000010L
'Notification messages
type MSGFILTER
NMHDR nmhdr
uint msg
sys wParam
sys lParam
end type
! GetDlgItem lib "user32.dll" (sys hDlg, int nIDDlgItem) as sys
! IsDialogMessage lib "user32.dll" alias"IsDialogMessageA" (sys hDlg, lpMsg) as bool
! ClientToScreen lib "user32.dll" (sys hWnd, LPPOINT lpPoint) as bool
! CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByVal hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
declare sub initMenu(hDlg)
def codeptr @ %1
def varptr @ %1
Global string gTxt
GLOBAL gPos AS LONG, gPtr AS LONG
'============================
' RGB function for O2
function RGB(int rcc, gcc, bcc) as int
return (rcc + gcc*256 + bcc*65536)
end Function
' // Size = 12 bytes 'DWORD
' // User value passed to callback as first parameter
' // Last error
type EDITSTREAM
dwCookie AS sys
dwError AS sys
pfnCallback AS sys
end type
'UDT for the RichEdit callback interface
TYPE ReCbInterface
pIntf AS sys PTR
Refcount AS sys
END TYPE
' // Size = 8 bytes
TYPE CHARRANGE
cpMin AS LONG
cpMax AS LONG
END TYPE
' This function creates a byte array object based on global memory
! FUNCTION CreateILockBytesOnHGlobal2 LIB "OLE32.DLL" ALIAS _
"CreateILockBytesOnHGlobal" _
(BYVAL hGlobal AS sys, _
BYVAL fDeleteOnRelease AS LONG, _
ppLkbyt AS sys) AS sys
' This function creates and opens a new compound file storage
' object on top of a byte array object provided by the caller
! FUNCTION StgCreateDocfileOnILockBytes2 LIB "OLE32.DLL" ALIAS _
"StgCreateDocfileOnILockBytes" _
(plkbyt AS sys, _
BYVAL grfMode AS sys, _
BYVAL reserved AS sys, _
ppstgOpen AS sys) AS sys
' Insert a formatted RTF string into Rich Edit
'------------------------------------------------------------------------------
SUB RichEditSetString (BYVAL hRichEdit AS sys)
LOCAL eStream AS EDITSTREAM
gPos = 1 'position in text to start from
gPtr = STRPTR(gTxt) 'pointer to global text buffer
eStream.pfnCallback = CODEPTR(RichEditStreamInString) 'pointer to RichEdit callback procedure
SendMessage hRichEdit, %EM_STREAMIN, %SF_RTF, VARPTR(eStream) 'stream in text
END SUB
' Rich Edit stream in callback - for streaming in string contents BYTE PTR --> sys PTR
'------------------------------------------------------------------------------
FUNCTION RichEditStreamInString (BYVAL dwCookie AS sys, BYVAL pbBuff AS sys PTR, _
BYVAL cb AS LONG, pcb AS LONG) AS sys
' pcb = MIN&(cb, LEN(gTxt) - (gPos - 1)) 'number of bytes to copy
pcb = LEN(gTxt) - (gPos - 1)
IF pcb > 0 THEN 'copy block from global string directly into Richedit's buffer.
CopyMemory pbBuff, (gPtr + gPos - 1), pcb 'could use POKE$ too, but this is a bit faster
gPos = gPos + pcb 'incr pos for next callback position.
ELSE
FUNCTION = 1 'else break action
END IF
END FUNCTION
' Methods of the IUnknown interface
FUNCTION Reo_QueryInterface (BYVAL pObject AS sys PTR, REFIID AS sys, ppvObj AS sys) AS sys
FUNCTION = %S_OK
END FUNCTION
FUNCTION Reo_AddRef (BYVAL pObject AS sys PTR) AS sys
@pObject[1] ++
FUNCTION = @pObject[1]
END FUNCTION
FUNCTION Reo_Release (BYVAL pObject AS sys PTR) AS sys
IF @pObject[1] > 0 THEN
@pObject[1] --
FUNCTION = @pObject[1]
ELSE
pObject = 0
END IF
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Methods of the IRichEditOleCallback interface
' Provides the application and document level interfaces and information
' required to support in-place activation
FUNCTION Reo_GetInPlaceContext (BYVAL pObject AS sys PTR, lplpFrame AS sys, _
lplpDoc AS sys, lpFrameInfo AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Tells the application whether to display its container user interface
FUNCTION Reo_ShowContainerUI (BYVAL pObject AS sys PTR, fShow AS LONG) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Queries the application as to whether an object should be inserted.
FUNCTION Reo_QueryInsertObject (BYVAL pObject AS sys PTR, lpclsid AS sys, _
BYVAL lpstg AS sys PTR, cp AS LONG) AS sys
FUNCTION = %S_OK ' Yes, we'd love to have this object inserted
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Notification that an object is about to be deleted from a rich edit control
FUNCTION Reo_DeleteObject (BYVAL pObject AS sys PTR, lpoleobj AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Called on a paste or drag to determine if the data pasted/dragged should be accepted
FUNCTION Reo_QueryAcceptData (BYVAL pObject AS sys PTR, lpdataobj AS sys, _
lpcfFormat AS sys, reco AS sys, _
fReally AS LONG, hMetaPict AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Tells the application that it should transition into or out of context sensitive help mode
FUNCTION Reo_ContextSensitiveHelp (BYVAL pObject AS sys PTR, fEnterMode AS LONG) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Allows the client to supply its own clipboard object
FUNCTION Reo_GetClipboardData (BYVAL pObject AS sys PTR, lpchrg AS sys, _
reco AS sys, lplpdataobj AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Allows the client to specify the effects of a drop operation
FUNCTION Reo_GetDragDropEffect (BYVAL pObject AS sys PTR, fDrag AS LONG, _
grfKeyState AS sys, pdwEffect AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Queries the application for a context menu to use on a right mouse down CHARRANGE
FUNCTION Reo_GetContextMenu (BYVAL pObject AS sys PTR, BYVAL seltype AS WORD, _
BYVAL lpoleobj AS sys PTR, BYVAL lpchrg AS sys PTR, _
lphmenu AS sys) AS sys
FUNCTION = %E_NOTIMPL
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Get storage interface for a new object
FUNCTION Reo_GetNewStorage (BYVAL pObject AS sys PTR, lplpstg AS sys) AS sys
LOCAL sc AS sys
LOCAL lpLockBytes AS sys PTR
' Create a byte array in global memory -
sc = CreateILockBytesOnHGlobal2(BYVAL 0, BYVAL 1, lpLockBytes)
IF sc THEN FUNCTION = sc : EXIT FUNCTION
'and a compound file storage object.
sc = StgCreateDocfileOnILockBytes2(@lpLockBytes, BYVAL %STGM_SHARE_EXCLUSIVE OR _
%STGM_READWRITE OR %STGM_CREATE, BYVAL 0, lplpstg)
IF sc THEN
CALL sys @lpLockBytes[2] USING Reo_Release(@lpLockBytes)
end if
FUNCTION = sc
END FUNCTION
' Here starts RichEdit OLE stuff - Initiate RichEdit's COM interface (OLE)
'------------------------------------------------------------------------------
FUNCTION Reo_SetComInterface(BYVAL hEdit AS sys) AS LONG
DIM pObj_RichCom AS sys PTR
DIM pReCbIfc AS ReCbInterface
DIM dwVTable(12) AS sys
'Initialize the OLE part.
dwVTable( 0) = CODEPTR(Reo_QueryInterface)
dwVTable( 1) = CODEPTR(Reo_AddRef)
dwVTable( 2) = CODEPTR(Reo_Release)
dwVTable( 3) = CODEPTR(Reo_GetNewStorage)
dwVTable( 4) = CODEPTR(Reo_GetInPlaceContext)
dwVTable( 5) = CODEPTR(Reo_ShowContainerUI)
dwVTable( 6) = CODEPTR(Reo_QueryInsertObject)
dwVTable( 7) = CODEPTR(Reo_DeleteObject)
dwVTable( 8) = CODEPTR(Reo_QueryAcceptData)
dwVTable( 9) = CODEPTR(Reo_ContextSensitiveHelp)
dwVTable(10) = CODEPTR(Reo_GetClipboardData)
dwVTable(11) = CODEPTR(Reo_GetDragDropEffect)
dwVTable(12) = CODEPTR(Reo_GetContextMenu)
pReCbIfc.pIntf = VARPTR(dwVTable(0))
pReCbIfc.Refcount = 1
FUNCTION = SendMessage(hEdit, %EM_SETOLECALLBACK, 0, VARPTR(pReCbIfc))
END FUNCTION
==============================================
'MAIN CODE
=============================================
'dim nCmdline as asciiz ptr, hInstance as sys
'&nCmdline = GetCommandLine
'hInstance = GetModuleHandle(NULL)
% IDC_RICHEDIT 101
sys hMenu
sys hMenuPopup
sys hAccel
sys hEditR
function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as int callback
POINT pt
select case uMsg
case WM_INITDIALOG
hMenu = initMenu(hDlg)
'Richedit should receive mouse events notifications
SendMessage GetDlgItem(hDlg,IDC_RICHEDIT),EM_SETEVENTMASK,0,ENM_MOUSEEVENTS
' Color the richedit control background with Honey dew
SendMessage GetDlgItem(hDlg,IDC_RICHEDIT), %EM_setBkgndColor, %False, RGB(240,255,240)
gTxt=Getfile "about the program.rtf"
hEditR = GetDlgItem(hDlg,IDC_RICHEDIT)
' Set OLE interface for eventual embedded pictures and objects
Reo_SetComInterface hEditR
'stream in global string
IF LEN(gTxt) THEN
RichEditSetString hEditR
end if
'Create PopupMenu for right click
PopupMENU(hMenuPopup)
BEGIN
MENUITEM "Undo" tab "Ctrl+Z",1200
MENUITEM "Redo" tab "Ctrl+Y",1502
MENUITEM "SEPARATOR"
MENUITEM "Copy " tab " Ctrl+C",1202
MENUITEM "Paste " tab " Ctrl+Vl",1203
MENUITEM "Cut " tab " Ctrl+X",1201
MENUITEM "SEPARATOR"
MENUITEM "Select All " tab " Ctrl+A",1204
ENDMenu
ShowWindow(hDlg, SW_NORMAL)
case WM_COMMAND
select case loword(wParam)
case IDCANCEL, 1180
DestroyWindow( hDlg, null )
case 1909
mbox "Oxgen Menu Template"
case 101 'Richedit
#ifdef review
printl
print loword(wParam) & chr(13) & chr(10) 'id
print hiword(wParam) & chr(13) & chr(10) 'event
#endif
case else
mbox loword(wParam) & " clicked!"
end select
case WM_SIZE
RECT rcClient
// Calculate remaining height and size edit
GetClientRect(hDlg, &rcClient)
sys hRichEdit = GetDlgItem(hDlg, IDC_RICHEDIT)
SetWindowPos(hRichEdit, NULL, 0, rcClient.top, rcClient.right, rcClient.bottom, SWP_NOZORDER)
case WM_NOTIFY
'RightClick in Richedit
NMHDR lpnmhdr at lParam
if lpnmhdr.code=EN_MSGFILTER then
MSGFILTER lpmsgfilter at lParam
if lpmsgfilter.msg=WM_RBUTTONDOWN then
'Get Mouse position
pt.x=loword(lpmsgfilter.lParam)
pt.y=hiword(lpmsgfilter.lParam)
ClientToScreen hDlg, @pt
int i = TrackPopupMenu( hMenuPopup,
TPM_LEFTALIGN or
TPM_RETURNCMD or
TPM_TOPALIGN or
TPM_HORPOSANIMATION,
pt.x,
pt.y,
0,
hDlg,
0 )
MessageBox( hDlg, "Selected ID = "& i, "From TrackPopupMenu", 0 )
endif
endif
case WM_CLOSE
DestroyWindow( hDlg )
case WM_DESTROY
'not assigned to a window
DestroyMenu(hMenuPopup)
DestroyAcceleratorTable( hAccel )
PostQuitMessage( null )
end select
return 0
end function
'===================
sub winmain()
init_common_controls
LoadLibrary("RICHED20.DLL")
sys hDlg, bRet
MSG Msg
sys lpdt
'provide memory for DLGTEMPLATE structure etc
'dyn::init(lpdt, nBytes)
dyn::init(lpdt) '1024
Dialog( 1, 0, 0, 200, 100, "Memory based modeless dialog using OxygenBasic", lpdt,
WS_OVERLAPPEDWINDOW or DS_CENTER )
RichEdit( gTxT, IDC_RICHEDIT, 0, 0, 200, 100, ES_AUTOHSCROLL or WS_HSCROLL )
hDlg = CreateModelessDialog( null, @DlgProc, 0, lpdt )
' gTxt=Getfile "about the program.rtf"
' sys hEditR = GetDlgItem(hDlg,IDC_RICHEDIT)
'stream in global string
' IF LEN(gTxt) THEN
' RichEditSetString hEditR
' end if
while (bRet := GetMessage(&Msg, NULL, 0, 0)) != 0
if bRet = -1 then
'show an error message
print "Error in Message Loop"
end
else
if TranslateAccelerator( hDlg, hAccel, @Msg ) = 0 then
if not IsDialogMessage(hDlg, &Msg) then
TranslateMessage(&Msg)
DispatchMessage(&Msg)
end if
end if
end if
wend
end sub
winmain()
===========================================================
sub initMenu(sys hDlg)
' a la .rc file
MENU(hMenu)
BEGIN
POPUP "&File"
BEGIN
POPUP "&New"
BEGIN
MENUITEM "&Empty file",1100
POPUP "By template &file..."
BEGIN
MENUITEM "Template 1",1102,CHECKED
MENUITEM "Template 2",1103
MENUITEM "Template 3",1104
ENDMenu
MENUITEM "SEPARATOR"
MENUITEM "Empty &window",1105
ENDMenu
MENUITEM "&Open..." tab "Ctrl+O",1110
MENUITEM "&Save" tab "Ctrl+S",1111
MENUITEM "Save &as..." tab "F12",1112
MENUITEM "SEPARATOR"
MENUITEM "E&xit" tab "Alt+F4",1180
ENDMenu
POPUP "&Edit"
BEGIN
MENUITEM "U&ndo" tab "Ctrl+Z",1200,GRAYED
MENUITEM "SEPARATOR"
MENUITEM "&Cut" tab "Ctrl+X",1201,GRAYED
MENUITEM "C&opy" tab "Ctrl+C",1202,GRAYED
MENUITEM "&Paste" tab "Ctrl+V",1203
MENUITEM "SEPARATOR"
MENUITEM "Select &all" tab "Ctrl+A",1204
ENDMenu
MENUITEM "&Compile!",1301
MENUITEM "&Run!",1302
POPUP "&Tools"
BEGIN
MENUITEM "&Compile" tab "F5",1301
MENUITEM "&Run" tab "F6",1302
MENUITEM "SEPARATOR"
MENUITEM "&Edit Resources" tab "F7",1311
MENUITEM "SEPARATOR"
MENUITEM "Code &formatter...",1321
ENDMenu
POPUP "&Options"
BEGIN
MENUITEM "&Font settings...",1401
MENUITEM "&General settings...",1402
MENUITEM "&Project settings...",1403
MENUITEM "SEPARATOR"
MENUITEM "Auto &indent",1411
ENDMenu
POPUP "&Help"
BEGIN
MENUITEM "Help &keyword..." tab "F1",1900
MENUITEM "&Basic help" tab "Shift+F1",1901
MENUITEM "&API help" tab "Alt+F1",1902
MENUITEM "&Editor help" tab "Ctrl+F1",1903
MENUITEM "SEPARATOR"
MENUITEM "Ab&out",1909
ENDMenu
ENDMenu
if SetMenu( hDlg, hMenu ) = 0 then
mbox "SetMenu hMenu failed!"
end if
'Accelerators
indexbase 0
ACCEL accl[9] = {
{FVIRTKEY | FCONTROL, asc("O"), 1110 },
{FVIRTKEY | FCONTROL, asc("S"), 1111 },
{FVIRTKEY , VK_F12, 1112 },
{FVIRTKEY , VK_F5, 1301 },
{FVIRTKEY , VK_F6, 1302 },
{FVIRTKEY , VK_F7, 1311 },
{FVIRTKEY | FSHIFT , VK_F1, 1901 },
{FVIRTKEY | FALT , VK_F1, 1902 },
{FVIRTKEY , VK_F1, 1900 },
{FVIRTKEY | FCONTROL, VK_F1, 1903 }
}
hAccel = CreateAcceleratorTable( @accl, 10 )
end sub