'https://docs.microsoft.com/de-de/windows/desktop/Controls/rich-edit-controls
$ filename "RicheditUnicode.exe"
'uses RTL32
'uses RTL64
uses WinData
% COLOR_WINDOW = 5
% ES_SAVESEL=0x8000
% SWP_NOZORDER=4
% SS_LEFT=0
% SS_NOTIFY=0x0100
% SF_TEXT=1
% EM_SETTEXTEX=1121
% ST_UNICODE=8
% CP_ACP=0
% CP_UTF8=65001 'codepage UTF8
% WM_CLEAR=771
type SETTEXTEX
dword flags
uint codepage
end type
extern lib "Kernel32.dll"
! GetCommandLine "GetCommandLineW" '0
! GetModuleHandle "GetModuleHandleW" '1
end extern
extern lib "User32.dll"
! CreateWindowEx "CreateWindowExW" '12
! DefWindowProc "DefWindowProcW" '4
! DispatchMessage "DispatchMessageW" '1
! GetClientRect '2
! GetMessage "GetMessageW" '4
! GetSystemMetrics '1
! IsWindowUnicode
! LoadIcon "LoadIconW" '2
! LoadCursor "LoadCursorW" '2
! MessageBox "MessageBoxW" '1
! PostQuitMessage '1
! RegisterClass "RegisterClassW" '1
! SendMessage "SendMessageW" '4
! SetFocus
! SetWindowPos '7
! SetWindowText "SetWindowTextW" '2
! ShowWindow '2
! TranslateMessage '1
! UpdateWindow '1
end extern
extern lib "Comctl32.dll"
! InitCommonControlsEx '1
end extern
#ifndef mode64bit
extern lib "Msvcrt.dll" cdecl
#else
extern lib "Msvcrt.dll"
#endif
! _wfopen
! fclose
! fread
! fseek
! ftell
end extern
function wGetFile(wstring name) as wstring
==========================================
sys f
int e
wstring m="rb"
bstring2 s
f=_wfopen name,m 'open for reading binary
if f=0 then return ""
fseek f,0,2 'end of file
e=ftell f 'get position
fseek f,0,0 'beginning of file
strptr s=getmemory e 'create buffer to fit
fread s,1,e,f 'load buffer
fclose f 'close file
return s
end function
function wGetFile(wstring name) as string
==========================================
sys f
int e
wstring m="rb"
bstring s
f=_wfopen name,m 'open for reading binary
if f=0 then return ""
fseek f,0,2 'end of file
e=ftell f 'get position
fseek f,0,0 'beginning of file
strptr s=getmemory e 'create buffer to fit
fread s,1,e,f 'load buffer
fclose f 'close file
return s
end function
'create a structure of INITCOMMONCONTROLSEX
INITCOMMONCONTROLSEXt iccex
iccex.dwSize=sizeof(iccex)
'Register Common Controls
iccex.dwICC= 0xffff
InitCommonControlsEx(@iccex)
LoadLibrary("RICHED20.DLL")
declare function WinMain(sys inst, prevInst, asciiz2*cmdline, sys show) as sys
'=========
'MAIN CODE
'=========
dim cmdline as wchar ptr, hInstance as sys
@cmdline=GetCommandLine
hInstance=GetModuleHandle 0
sys hButton1, hButton2, hREdit, hEdit, Group
% ID_BUTTON1=1000
% ID_BUTTON2=1001
sys lbl[5]
wstring lblTxt[4]={" Ansi","UTF-16","UTF-8","Text","Open file as: "}
sys radio[4]
sys id_radio[4]={101,102,103,104}
'WINDOWS START
'=============
WinMain hInstance,0,cmdline,SW_NORMAL
end
function WinMain(sys inst, prevInst, asciiz2*cmdline, sys show) as sys
WndClass wc
MSG wm
sys hwnd, Wwd, Wht, Wtx, Wty, Tax
wstring classname="REDemo"
wc.style = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc = @WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance =inst
wc.hIcon=LoadIcon 0, IDI_APPLICATION
wc.hCursor=LoadCursor 0,IDC_ARROW
wc.hbrBackground = COLOR_WINDOW
wc.lpszMenuName =null
wc.lpszClassName = strptr classname
RegisterClass (@wc)
Wwd = 640 : Wht = 400
Tax = GetSystemMetrics SM_CXSCREEN
Wtx = (Tax - Wwd) /2
Tax = GetSystemMetrics SM_CYSCREEN
Wty = (Tax - Wht) /2
'Main Window
hwnd = CreateWindowEx 0,wc.lpszClassName, wstring("OXYGEN BASIC"),WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
'Buttons
hButton1=CreateWindowEx(0,
wstring("Button"), wstring("Open File"),
WS_CHILD | WS_VISIBLE | BS_PUSHBUTTON,
500, 10, 80 ,25,
hwnd,ID_BUTTON1,inst, 0)
hButton2=CreateWindowEx(0,
wstring("Button"), wstring("Clear REdit"),
WS_CHILD | WS_VISIBLE | BS_PUSHBUTTON,
500, 45, 80 ,25,
hwnd,ID_BUTTON2,inst, 0)
'Edit
hEdit=CreateWindowEx(WS_EX_CLIENTEDGE,
wstring("Edit"), wstring(""),
WS_CHILD | WS_VISIBLE | ES_LEFT | WS_BORDER | ES_AUTOHSCROLL,
20, 10, 450 ,25,
hwnd,0,inst,0)
'Labels
int x, lft, wid
lft=130 : wid=50
for x=1 to 5
if x=5 then lft=-340 : wid=90
lbl[x]=CreateWindowEx(0,
wstring("Static"), wstring(""),
WS_CHILD | WS_VISIBLE | SS_LEFT,
lft+((x-1)*90), 45, wid ,25,
hwnd,0,inst,0)
SetWindowText(lbl[x],lblTxt[x])
next x
'Radios
for x=1 to 4
radio[x]=CreateWindowEx(0,
wstring("Button"), wstring(""),
WS_CHILD | WS_VISIBLE | BS_AUTORADIOBUTTON,
180+((x-1)*90), 45, 15 ,15,
hwnd,id_radio[x],inst,0)
next x
SendMessage(radio[1], BM_SETCHECK, true,0)
'Richedit
hREdit=CreateWindowEx(WS_EX_CLIENTEDGE,
wstring("RichEdit20W"), wstring(""),
WS_CHILDWINDOW|WS_VISIBLE | WS_VSCROLL | WS_HSCROLL | ES_AUTOVSCROLL | ES_SAVESEL | ES_MULTILINE | WS_BORDER | ES_WANTRETURN,
20, 60,200,25,
hwnd,0,inst,0)
SetFocus(hEdit)
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd
sys bRet
do while bRet := GetMessage (@wm, 0, 0, 0)
if bRet = -1 then
'show an error message
else
TranslateMessage @wm
DispatchMessage @wm
end if
wend
end function
function WndProc (sys hWnd, uint wMsg, sys wParam, lparam ) as sys callback
SETTEXTEX settext
select wMsg
case WM_COMMAND
select loword(wParam)
case ID_BUTTON1
wstring fName = space 256
SendMessage(hEdit, WM_GETTEXT, len(fName), fName)
fname=ltrim(rtrim(fname))
if len(fname)>0 then
if SendMessage(Radio[1],BM_GETCHECK,0,0)=BST_CHECKED then 'Ansi
string text1
text1 = wgetfile (fName)
if len(text1)=0 then
MessageBox(hWnd, wstring(fName) + " missing or load failure!", wstring("Load File"), MB_OK or MB_ICONASTERISK)
else
'RegisterClassW creates Unicode window, so translate to Unicode
settext.flags=ST_UNICODE
settext.codepage=CP_ACP 'System codepage
SendMessage(hREdit, EM_SETTEXTEX, &settext, text1)
end if
end if
if SendMessage(Radio[2],BM_GETCHECK,0,0)=BST_CHECKED then 'Unicode
wstring text2
text2 = (wstring) wgetfile (fName)
if len(text2)=0 then
MessageBox(hWnd, wstring(fName) + " load failure!", wstring("Load File"), MB_OK or MB_ICONASTERISK)
else
SendMessage(hREdit, WM_SETTEXT, 0, text2)
end if
end if
if SendMessage(Radio[3],BM_GETCHECK,0,0)=BST_CHECKED then 'UTF8
string text3
wstring text3 = (wstring) wgetfile (fName)
if len(text3)=0 then
MessageBox(hWnd, wstring(fName) + " missing or load failure!", wstring("Load File"), MB_OK or MB_ICONASTERISK)
else
'RegisterClassW creates Unicode window, so translate to Unicode
settext.flags=ST_UNICODE
settext.codepage=CP_UTF8 'cp 65001
SendMessage(hREdit, EM_SETTEXTEX, &settext, text3)
end if
end if
if SendMessage(Radio[4],BM_GETCHECK,0,0)=BST_CHECKED then 'Plain Text
string text4
text4 = wgetfile (fName)
if len(text4)=0 then
MessageBox(hWnd, wstring(fName) + " missing or load failure!", wstring("Load File"), MB_OK or MB_ICONASTERISK)
else
'Workaround
text4=chr(32) & text4
SendMessage(hREdit, WM_SETTEXT, SF_TEXT, text4)
end if
end if
end if
case ID_BUTTON2
SendMessage(hREdit, EM_SETSEL, 0, -1)
SendMessage(hREdit, WM_CLEAR, 0, 0)
end select
case WM_SIZE
RECT rcClient
// Calculate remaining height and size edit
GetClientRect(hwnd, &rcClient)
SetWindowPos(hREdit, NULL, 0, rcClient.top+75, rcClient.right, rcClient.bottom-75, SWP_NOZORDER)
case WM_DESTROY
PostQuitMessage 0
case WM_KEYDOWN
Select wParam
Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
End Select
case else
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
end function ' WndProc
