Oxygen Basic
Programming => Example Code => User Interface => Topic started by: Charles Pegge on June 05, 2019, 05:55:31 AM
-
The EditBox child window is created with CreateWindowExW, and messages are sent to it with SendMessageW.
Unicode files are loaded like this:
wstring ws=(wstring) getfile "Multilingual.txt"
$ filename "t.exe"
'uses RTL32
'uses RTL64
$ EscapeKeyEnd
uses WinUtil
MainWindow 640,480,WS_OVERLAPPEDWINDOW
% ID_FIRSTCHILD 100
sys hinstance
sys hWndMain
'STANDARD CHILD WINDOWS STYLES
'=============================
'
'Button The class for a button.
'ComboBox The class for a combo box.
'Edit The class for an edit control.
'ListBox The class for a list box.
'MDIClient The class for an MDI client window.
'ScrollBar The class for a scroll bar.
'Static The class for a static control.
dim cRect as rect
dim Paintst as paintstruct
dim hDC as sys
function WndProc(sys hwnd, uMsg, wParam, lParam) as long callback
'================================================================
indexbase 0
RECT rcClient;
sys i,w,px,py,lx,ly,nx,ny,id,idmenu,style
static sys hchw[0x200]
static sys hfont
string s
select umsg
case WM_CREATE
SetWindowText hwnd,"Edit Box"
style=WS_CHILD | WS_BORDER | WS_VISIBLE |
ES_MULTILINE | ES_WANTRETURN | ES_NOHIDESEL |
ES_AUTOHSCROLL | ES_AUTOVSCROLL | WS_HSCROLL | WS_VSCROLL
py=10 : lx=600 : ly=400
id=ID_FIRSTCHILD+i
px=10
hchw[i]=CreateWindowExW(0,l"edit", null, style, px,py,lx,ly, hwnd, id, inst, null)
ShowWindow(hchw[i], SW_SHOW)
wstring ws=(wstring) getfile "Multilingual.txt"
wstring ws=(wstring) getfile "Multilingual.txt"
'ws=mid(ws,2) 'skip bom code
hfont=CreateFont( 30,10,0,0,1,0,0,0,0,0,0,0,0,"Arial")
SendMessageW hchw[i],WM_SETFONT,hfont,0
'SetWindowTextW(hchw[i], ws)
SendMessageW hchw[i] ,WM_SETTEXT,len(ws),strptr(ws)
case WM_COMMAND
id=wparam and 0xffff
int co=wparam >>16
if id>0x100 and id<0x200 then
s="PushButton: " str id
SetWindowText hWnd, s
SetWindowText hchw[id], hex(id)+"h"
SetFocus hwnd
end if
case WM_SIZE: // main window changed size
RECT rc
int wo=10,ho=10, x, y
GetClientRect(hWnd, &rc)
x=rc.right-wo-wo
y=rc.bottom-ho-ho
MoveWindow(hchw[0], wo, ho, x, y, TRUE);
ShowWindow(hchw[0], SW_SHOW);
case WM_DESTROY:
DeleteObject hfont
PostQuitMessage 0
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
'
end function
-
Hi Charles,
Are OxygenBasic functions guaranteed to always return 0 on default in case there is no explicit general return command at the bottom of a function?
-
Hi Charles,
I tried this code with my editor (using Unicode UTF-8 no BOM 65001) which will run with Oxygen.dll of Feb/2019:
$ filename "t.exe"
'uses RTL32
'uses RTL64
uses corewin
wstring ws=(wstring) getfile "Multilingual.txt"
wstring title=left(ws, 10)
MessageboxW(0, ws, title, 0)
MessageboxW(0, ws, L"Բարի լույս ծրագրավորող", 0 )
mbox ws
The first Messagebox works as expected, the second Messagebox does not show the correct title, and mbox is wrong too.
Will these cases work with the next version of Oxygen.dll? I also tried to code in Unicode UTF-16 little endian (1200), but then Oxygen refuses to compile the code at all.
Roland
-
Hi Roland,
I made a few adjustments to the UTF loader, so UTF-8 and UTF-16 little/big endian should all work
I am almost ready to post the o2 update. I'll wait for Brian tonight and see if any more mods are needed :)
-
Hi Mike,
a function with a specified return type, but an unspecified value will return null.
function=...
function is interpreted as a variable initialised to null
-
...I'll wait for Brian tonight and see if any more mods are needed :)...
Thanks Charles. ;D
I havent found any issues right now. I have a request... but that can wait. 8)
-
a function with a specified return type, but an unspecified value will return null.
That is, in terms of 32 bits, with eax guaranteed to have been XOR'ed, and st(0), FSTP'ed?
-
function aka returnvar is loaded to the requisite register before leaving the function.
It's slightly different with a C-style return. The return expression accumulator is used instead of returnvar. If no expression is given, the results are indeterminate.
-
Hi Charles,
The reason I'm asking is, your callback doesn't return the recommended values explicitly from the event Case blocks it hosts. Luckily enough, all of them should return zeros as per MSDN in this particular callback, which however isn't true in the most general case. The only explicit return there is resides in the Case Else block and is ineffective for the other Cases. (BTW why do some Case labels end in a colon while the other ones don't?)
So, the Cases other than Case Else should presumably rely on some default return value that's guaranteed to be zero for the message pump to operate properly with this callback. Judging from what you say, that value resides in returnvar that's initialized with integer zero the moment the callback is invoked. Arguably it will be 0.0f if the function is to return a Single, 0.0d if a Double, etc.
Am I correct in my assumptions?
And finally, why do you invoke DefWindowProc rather than CallWindowProc? Edit box is a control that may rely on some very specific message handlers under the hood while DefWindowProc ensures only the very basic handling of messages common to all window classes in the system.
-
Hi Mike,
My primary focus was on the joys of Unicode 🏴🌐🕉, so my code was not perfection.
The default null return value (in all data types), I trust, is consistent with most BASICs. Even UDTs returned byval are null initialised, though the actual value returned in the RAX register will be a pointer to the UDT.
The colons are of course, not required for multiline case blocks. This is not a pristine example, but derived from earlier code. Is CallWindowProc applicable to all situations where DefWindowProc is traditionally used, even when not subclassing? If so, I can roll out this change across all the Windows examples.
-
Hi Charles,
No, CallWindowProc requires an original proc pointer to pass the execution flow to, so it can't be used outside subclassing contexts.
DefWindowProc is OK to handle general purpose frame windows but may produce weird results when used with highly specialized entities such as Windows common, and especially user, controls.
-
I found two examples in folder \examples\Wingui which apply CallWindowProc for subclassing: ListViewXYWIP.o2bas and UniversalButton.o2bas. Most likely, the remaining examples are not absolutely dependent on CallWindowProc?
-
I've avoided SubClassing so far. Keystroke monitoring for Esc. Ctrl, Shift, and the function keys can be done in the message loop, then encoded and re-messaged to the main window with a WM_COMMAND
-
This is a demo Unicode RichEdit box with line numbering.
It also shows how to color portions of text, in anticipation of a syntax highlighting system.
This code must be saved into a UTF-16 file.
$ filename "t.exe"
'uses RTL32
'uses RTL64
$ EscapeKeyEnd
uses WinUtil
#define CFE_BOLD 1
#define CFE_ITALIC 2
#define CFE_UNDERLINE 4
#define CFE_STRIKEOUT 8
#define CFE_PROTECTED 16
#define CFE_AUTOCOLOR 0x40000000
#define CFE_SUBSCRIPT 0x00010000
#define CFE_SUPERSCRIPT 0x00020000
#define SCF_DEFAULT 0
#define SCF_SELECTION 1
#define SCF_WORD 2
#define SCF_ALL 4
#define SCF_USEUIRULES 8
#define WM_USER 0x0400
#define LF_FACESIZE 32
#define EM_GETCHARFORMAT (WM_USER+58)
#define EM_SETCHARFORMAT (WM_USER+68)
#define EM_EXGETSEL (WM_USER+52)
#define EM_EXSETSEL (WM_USER+55)
#define EM_GETSELTEXT (WM_USER+62)
#define EM_HIDESELECTION (WM_USER+63)
#define EM_GETTEXTRANGE (WM_USER+75)
typedef dword COLORREF ' R G B bytes
typedef dword LCID
typedef sys LPWSTR
'92 bytes
typedef struct _charformatw {
UINT cbSize;
DWORD dwMask;
DWORD dwEffects;
LONG yHeight;
LONG yOffset;
COLORREF crTextColor;
BYTE bCharSet;
BYTE bPitchAndFamily;
WCHAR szFaceName[LF_FACESIZE];
} CHARFORMATW;
typedef struct _charformat2w {
UINT cbSize;
DWORD dwMask;
DWORD dwEffects;
LONG yHeight;
LONG yOffset;
COLORREF crTextColor;
BYTE bCharSet;
BYTE bPitchAndFamily;
WCHAR szFaceName[LF_FACESIZE];
WORD wWeight;
SHORT sSpacing;
COLORREF crBackColor;
LCID lcidv;
DWORD dwReserved;
SHORT sStyle;
WORD wKerning;
BYTE bUnderlineType;
BYTE bAnimation;
BYTE bRevAuthor;
} CHARFORMAT2W;
typedef struct _charrange {
LONG cpMin;
LONG cpMax;
} CHARRANGE;
typedef struct _textrangew {
CHARRANGE chrg;
LPWSTR lpstrText;
} TEXTRANGEW;
==========================================
indexbase 0
sys rt = loadlibraryW(l"MSFTEDIT.DLL")
'print rt
sys hchw[0x200]
sys hFont
wstring ws
int da[100] 'diagnostic
wstring ds 'diagnostic
'ws = (wstring) getfile "Multilingual.txt"
ws= l"早上好计算机程序员。
おはようのコンピュータのプログラマー。
Доброе утро, программист!
Καλή προγραμματιστής ηλεκτρονικών υπολογιστών πρωί.
सुप्रभात कंप्यूटर प्रोग्रामर.
Chào buổi sáng lập trình máy tính.
დილა მშვიდობისა, კომპიუტერული პროგრამისტი.
Добро јутро компјутерски програмер.
Բարի լույս ծրագրավորող.
안녕하세요 컴퓨터 프로그래머.
Good morning, computer programmer.
"
hFont = CreateFontW( 24,8,0,0,1,0,0,0,0,0,0,0,0,l"Arial")
MainWindow 640,480,WS_OVERLAPPEDWINDOW
'print hex(da[0]) cr hex(da[1]) cr hex(da[2]) cr hex(da[3]) cr
'print ds
end
% ID_FIRSTCHILD 100
'STANDARD CHILD WINDOWS STYLES
'=============================
'
'Button The class for a button.
'ComboBox The class for a combo box.
'Edit The class for an edit control.
'ListBox The class for a list box.
'MDIClient The class for an MDI client window.
'ScrollBar The class for a scroll bar.
'Static The class for a static control.
function EdProc(sys hwnd, uMsg, wParam, lParam,uIdSubclass,dwRefData) as int callback
=====================================================================================
indexbase 0
select uMsg
case WM_HSCROLL
DefSubClassProc(hwnd, uMsg, wParam, lParam)
RECT r
r.right = 40 'margin lie number area
GetClientRect(hwnd,r)
InvalidateRect(hwnd,r,0)
case WM_PAINT
point pt
static wchar sz[32]
DWORD lc
RECT crect
sys rgn
int dret
sys hDC
int line
int charidx
int nc
function = DefSubClassProc(hwnd, uMsg, wParam, lParam)
'exit function
lc = SendMessageW(hWnd,EM_GETLINECOUNT,0,0)
if lc
hDC = GetDC(hWnd)
SaveDC(hDC)
GetClientRect(hWnd,&crect)
rgn = CreateRectRgn(crect.left,crect.top,40,crect.bottom)
SelectClipRgn(hDC,rgn)
'SendMessageW(hWnd,WM_SETFONT,hfont,0)
% PATCOPY 0x00F00021
BitBlt(hDC,0,0,40,crect.bottom, hDC,0,0,PATCOPY)
line = SendMessageW(hWnd,EM_GETFIRSTVISIBLELINE,0,0)
static word ss[0x10000]
nc = GetWindowTextW(hWnd, @ss, 0x10000)
while line <= lc
charidx = SendMessageW(hWnd,EM_LINEINDEX,line,0)
exit if charidx == -1
SendMessageW(hWnd,EM_POSFROMCHAR,@pt,charidx)
exit if pt.y >= crect.bottom
'set line number
'wsprintf(&sz,"%lu",10*(line+1))
SetTextColor(hDC,0xff0000) 'blue
sz = STR(10*(line+1))
TextOutW(hDC,4,pt.y+4,sz,len(sz))
line++
wend
RestoreDC(hDC,-1)
DeleteObject(rgn)
ReleaseDC(hWnd,hDC)
endif
return 1
case else
return DefSubClassProc(hwnd, uMsg, wParam, lParam)
end select
end function
function WndProc(sys hwnd, uMsg, wParam, lParam) as int callback
'================================================================
indexbase 0
RECT rcClient;
sys i,w,px,py,lx,ly,nx,ny,id,idmenu,style
string s
select umsg
case WM_CREATE
SetWindowText hwnd,"Edit Box"
style = WS_CHILD | WS_VISIBLE | WS_BORDER |
ES_MULTILINE | ES_WANTRETURN | ES_NOHIDESEL |
ES_AUTOHSCROLL | ES_AUTOVSCROLL | WS_HSCROLL | WS_VSCROLL
px = 10 : py = 10 : lx = 500 : ly = 400
hchw[0] = CreateWindowExW(0,l"RichEdit50W", null, style, px,py,lx,ly, hwnd, id, inst, null)
sys h = hchw[0]
id = ID_FIRSTCHILD+0
% EC_LEFTMARGIN 1
ShowWindow(h, SW_SHOW)
'
'convert each crlf to cr by removing the lf char
'assume little-endian chars
wstring rs = ws
word *r1,*r2
@r1 = strptr(rs)
@r2 = @r1
int re = len(rs)
int lc
int i,j
while i<re
r1 = r2
if r1 = 13
if r2[1] = 10 'remove line feeds
i++
@r2 += 2
lc++ 'diagnostic
endif
endif
i++ : j++
@r1 += 2 : @r2 += 2
wend
ws = left(rs,j)
'
'ws = mid(ws,2) 'skip bom code
SendMessageW h,WM_SETFONT,hfont,0
SendMessage h,WM_SETFONT,hfont,0
SendMessageW(h,EM_SETMARGINS,EC_LEFTMARGIN,40)
'text setting
'SendMessageW h ,WM_SETTEXT,len(ws)+2,ws
SetWindowTextW(h, ws)
'
'color setting example
int se[4] = {4,7} 'color chars 4 to 7
SendMessageW(h,EM_EXGETSEL,0,@se[2]) 'save selection
SendMessageW(h,EM_HIDESELECTION,1,0)
SendMessageW(h,EM_EXSETSEL,0,@se[0])
wchar gs[0x100]
int n=SendMessageW(h,EM_GETSELTEXT,0x100,gs)
ds = gs 'test
CHARFORMATW cf
'CHARFORMAT2W cf
cf.cbsize = sizeof(cf)
SendMessageW(h,EM_GETCHARFORMAT,SCF_SELECTION,@cf)
cf.crTextColor = 0x0080f0 'orange
cf.dweffects and= not(CFE_AUTOCOLOR)
int r = SendMessageW(h,EM_SETCHARFORMAT,SCF_SELECTION,@cf)
'int r = SendMessageW(h,EM_SETCHARFORMAT,SCF_ALL,@cf)
SendMessageW(h,EM_EXSETSEL,0,@se[2]) 'restore prior selection
SendMessageW(h,EM_HIDESELECTION,1,0)
dword scid = id
SetWindowSubClass(h,@EdProc,@scid,0)
case WM_COMMAND
id = wparam and 0xffff
int co = wparam >>16
if id>0x100 and id<0x200 then
s = "PushButton: " str id
SetWindowText hWnd, s
SetWindowText hchw[id], hex(id)+"h"
SetFocus hwnd
end if
case WM_SIZE: // main window changed size
RECT rc
int wo = 40, ho = 40, x, y
GetClientRect(hWnd, &rc)
'resize edit control
x = rc.right-wo-wo
y = rc.bottom-ho-ho
MoveWindow(hchw[0], wo, ho, x, y, TRUE);
ShowWindow(hchw[0], SW_SHOW);
case WM_DESTROY:
DeleteObject hfont
PostQuitMessage 0
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
'
end function
-
Hello Charles
It work well on my win7-32 ;)
-
Hi Charles,
the unicode RE works quite nice with my system. The short cut keys ctrl-a (select all), del (delete), ctrl-c (copy), ctrl-v (paste) work like expected. Did you know that it is possible to paste images into the RE? I did not, but I noticed that you loaded msftedit.dll, so I tried this.
It does not matter in this case, but you included WinUtil, FileDialogs which apply ansi functions. I assume that to get the most benefit it will be necessary to adapt these functions too?
Roland
-
Hi Roland,
In this demo, the main Window is Ansi and the child RE window is Unicode. It doesn't seem to matter :)
Inserting graphics into the RE textbox is intriguing. It is OLE technology, but it is possible to save/load the entire contents in an rtf file using windows messaging and callbacks. It is a little complicated
This could support illustrated source code!
$ filename "t.exe"
'uses RTL32
'uses RTL64
$ EscapeKeyEnd
uses WinUtil
#define CFE_BOLD 1
#define CFE_ITALIC 2
#define CFE_UNDERLINE 4
#define CFE_STRIKEOUT 8
#define CFE_PROTECTED 16
#define CFE_AUTOCOLOR 0x40000000
#define CFE_SUBSCRIPT 0x00010000
#define CFE_SUPERSCRIPT 0x00020000
#define SCF_DEFAULT 0
#define SCF_SELECTION 1
#define SCF_WORD 2
#define SCF_ALL 4
#define SCF_USEUIRULES 8
#define SF_TEXT 1
#define SF_RTF 2
#define SF_RTFNOOBJS 3
#define SF_TEXTIZED 4
#define SF_UNICODE 16
#define SF_USECODEPAGE 32
#define SF_NCRFORNONASCII 64
#define SF_RTFVAL 0x0700
#define SFF_PWD 0x0800
#define SFF_KEEPDOCINFO 0x1000
#define SFF_PERSISTVIEWSCALE 0x2000
#define SFF_PLAINRTF 0x4000
#define SFF_SELECTION 0x8000
#define WM_USER 0x0400
#define LF_FACESIZE 32
#define EM_GETCHARFORMAT (WM_USER+58)
#define EM_SETCHARFORMAT (WM_USER+68)
#define EM_EXGETSEL (WM_USER+52)
#define EM_EXSETSEL (WM_USER+55)
#define EM_GETSELTEXT (WM_USER+62)
#define EM_HIDESELECTION (WM_USER+63)
#define EM_STREAMIN (WM_USER+73)
#define EM_STREAMOUT (WM_USER+74)
#define EM_GETTEXTRANGE (WM_USER+75)
typedef dword COLORREF ' R G B bytes
typedef dword LCID
typedef sys LPWSTR
'92 bytes
typedef struct _charformatw {
UINT cbSize;
DWORD dwMask;
DWORD dwEffects;
LONG yHeight;
LONG yOffset;
COLORREF crTextColor;
BYTE bCharSet;
BYTE bPitchAndFamily;
WCHAR szFaceName[LF_FACESIZE];
} CHARFORMATW;
typedef struct _charformat2w {
UINT cbSize;
DWORD dwMask;
DWORD dwEffects;
LONG yHeight;
LONG yOffset;
COLORREF crTextColor;
BYTE bCharSet;
BYTE bPitchAndFamily;
WCHAR szFaceName[LF_FACESIZE];
WORD wWeight;
SHORT sSpacing;
COLORREF crBackColor;
LCID lcidv;
DWORD dwReserved;
SHORT sStyle;
WORD wKerning;
BYTE bUnderlineType;
BYTE bAnimation;
BYTE bRevAuthor;
} CHARFORMAT2W;
typedef struct _charrange {
LONG cpMin;
LONG cpMax;
} CHARRANGE;
typedef struct _textrangew {
CHARRANGE chrg;
LPWSTR lpstrText;
} TEXTRANGEW;
typedef struct _editstream {
sys dwCookie;
DWORD dwError;
sys pfnCallback;
} EDITSTREAM;
==========================================
indexbase 0
sys rt = loadlibraryW(l"MSFTEDIT.DLL")
'print rt
sys hchw[0x200]
sys hFont
wstring ws
int da[100] 'diagnostic
wstring ds 'diagnostic
'ws = (wstring) getfile "Multilingual.txt"
'test data
==========
ws= l"
goodgood GoodGood Good good gooD good gOod
早上好计算机程序员。
おはようのコンピュータのプログラマー。
Доброе утро, программист!
Καλή προγραμματιστής ηλεκτρονικών υπολογιστών πρωί.
सुप्रभात कंप्यूटर प्रोग्रामर.
Chào buổi sáng lập trình máy tính.
დილა მშვიდობისა, კომპიუტერული პროგრამისტი.
Добро јутро компјутерски програмер.
Բարի լույս ծրագրավորող.
안녕하세요 컴퓨터 프로그래머.
Good morning, computer programmer.
"
string ubuf
sys ubufp, ubufe, ubufl
hFont = CreateFontW( 24,8,0,0,1,0,0,0,0,0,0,0,0,l"Arial")
MainWindow 640,480,WS_OVERLAPPEDWINDOW
'print hex(da[0]) cr hex(da[1]) cr hex(da[2]) cr hex(da[3]) cr
'print da[0] cr da[1]
'print ds
end
% ID_FIRSTCHILD 100
function Editstreamocallback(sys *dwCookie, pbBuff, cb, *pcb) as dword callback
================================================================================
' DWORD_PTR dwCookie,
' LPBYTE pbBuff,
' LONG cb,
' LONG *pcb
'
'ACCUMULATE OUTPUT
if ubufl+cb>ubufe 'stretch buffer
sys obufp
obufp=ubufp
ubufe=ubufe*2+cb+0x1000
ubufp=getmemory ubufe
if obufp
copy ubufp,obufp,ubufl
freememory obufp
endif
endif
copy ubufp+ubufl,pbBuff,cb
ubufl+=cb
pcb=cb
'
return 0 'no errors
end function
function Editstreamicallback(sys *dwCookie, pbBuff, cb, *pcb) as dword callback
===============================================================================
' DWORD_PTR dwCookie,
' LPBYTE pbBuff,
' LONG cb,
' LONG *pcb
'
'PASS INPUT
if ubufl<ubufe
if cb>ubufe-ubufl
cb=ubufe-ubufl
endif
copy pbBuff,ubufp+ubufl,cb
ubufl+=cb
pcb=cb
else
pcb=0
endif
return 0 'no errors
end function
EDITSTREAM StreamIn, StreamOut
'
if ubufp
freememory ubufp
ubufp=0
ubufe=0
endif
'
ubufl=0
'
'bstring fdi=getfile("test.rtf")
'ubufp=strptr(fdi)
'ubufe=len(fdi)
'StreamIn={0,0,@Editstreamicallback}
'SendMessageW(h,EM_STREAMIN,SF_RTF,StreamIn)
'STANDARD CHILD WINDOWS STYLES
'=============================
'
'Button The class for a button.
'ComboBox The class for a combo box.
'Edit The class for an edit control.
'ListBox The class for a list box.
'MDIClient The class for an MDI client window.
'ScrollBar The class for a scroll bar.
'Static The class for a static control.
function EdProc(sys hwnd, uMsg, wParam, lParam,uIdSubclass,dwRefData) as int callback
=====================================================================================
indexbase 0
select uMsg
case WM_HSCROLL
DefSubClassProc(hwnd, uMsg, wParam, lParam)
RECT r
r.right = 40 'margin lie number area
GetClientRect(hwnd,r)
InvalidateRect(hwnd,r,0)
case WM_PAINT
point pt
static wchar sz[32]
DWORD lc
RECT crect
sys rgn
int dret
sys hDC
int line
int charidx
'int nc
function = DefSubClassProc(hwnd, uMsg, wParam, lParam)
'exit function
lc = SendMessageW(hWnd,EM_GETLINECOUNT,0,0)
if lc
hDC = GetDC(hWnd)
SaveDC(hDC)
GetClientRect(hWnd,&crect)
rgn = CreateRectRgn(crect.left,crect.top,40,crect.bottom)
SelectClipRgn(hDC,rgn)
'SendMessageW(hWnd,WM_SETFONT,hfont,0)
% PATCOPY 0x00F00021
BitBlt(hDC,0,0,40,crect.bottom, hDC,0,0,PATCOPY)
line = SendMessageW(hWnd,EM_GETFIRSTVISIBLELINE,0,0)
while line <= lc
charidx = SendMessageW(hWnd,EM_LINEINDEX,line,0)
exit if charidx == -1
SendMessageW(hWnd,EM_POSFROMCHAR,@pt,charidx)
exit if pt.y >= crect.bottom
'set line number
'wsprintf(&sz,"%lu",10*(line+1))
SetTextColor(hDC,0xff0000) 'blue
sz = STR(10*(line+1))
TextOutW(hDC,4,pt.y+4,sz,len(sz))
line++
wend
RestoreDC(hDC,-1)
DeleteObject(rgn)
ReleaseDC(hWnd,hDC)
endif
return 1
case else
return DefSubClassProc(hwnd, uMsg, wParam, lParam)
end select
end function
function WndProc(sys hwnd, uMsg, wParam, lParam) as int callback
'================================================================
indexbase 0
RECT rcClient;
sys i,w,px,py,lx,ly,nx,ny,id,idmenu,style
string s
select umsg
case WM_CREATE
SetWindowText hwnd,"Edit Box"
style = WS_CHILD | WS_VISIBLE | WS_BORDER |
ES_MULTILINE | ES_WANTRETURN | ES_NOHIDESEL |
ES_AUTOHSCROLL | ES_AUTOVSCROLL | WS_HSCROLL | WS_VSCROLL
px = 10 : py = 10 : lx = 500 : ly = 400
hchw[0] = CreateWindowExW(0,l"RichEdit50W", null, style, px,py,lx,ly, hwnd, id, inst, null)
sys h = hchw[0]
id = ID_FIRSTCHILD+0
% EC_LEFTMARGIN 1
ShowWindow(h, SW_SHOW)
'
'convert each crlf to cr by removing the lf char
'assume little-endian chars
wstring rs = ws
word *r1,*r2
@r1 = strptr(rs)
@r2 = @r1
int re = len(rs)
int lc
int i,j
while i<re
r1 = r2
if r1 = 13
if r2[1] = 10 'remove line feeds
i++
@r2 += 2
lc++ 'diagnostic
endif
endif
i++ : j++
@r1 += 2 : @r2 += 2
wend
ws = left(rs,j)
'
'ws = mid(ws,2) 'skip bom code
SendMessageW h,WM_SETFONT,hfont,0
SendMessage h,WM_SETFONT,hfont,0
SendMessageW(h,EM_SETMARGINS,EC_LEFTMARGIN,40)
'text setting
'SendMessageW h ,WM_SETTEXT,len(ws)+2,ws
SetWindowTextW(h, ws)
dword scid = id
SetWindowSubClass(h,@EdProc,@scid,0)
'
int se[4]
'
'color setting example
SendMessageW(h,EM_EXGETSEL,0,@se[2]) 'save selection
SendMessageW(h,EM_HIDESELECTION,1,0)
'
'to extract visible text
int lc
int line
int chx
point pt
GetClientRect(h,&crect)
lc = SendMessageW(h,EM_GETLINECOUNT,0,0)
line = SendMessageW(h,EM_GETFIRSTVISIBLELINE,0,0)
se[0] = SendMessageW(h,EM_LINEINDEX,line,0)
while line <= lc
chx = SendMessageW(h,EM_LINEINDEX,line,0)
exit if chx == -1
SendMessageW(h,EM_POSFROMCHAR,@pt,chx)
exit if pt.y >= crect.bottom
se[1]=chx
line++
wend
SendMessageW(h,EM_EXSETSEL,0,@se) 'select visible text
wchar gs[0x2000]
int n=SendMessageW(h,EM_GETSELTEXT,0x2000,strptr(gs))
'get visible text
'ds = gs 'test
'
'conversion of roman chars: uppercase to lowercase
word c at strptr(gs)
do
exit if c=0
select c
case 0x41 to 0x5a : c or= 0x20
end select
@c+=2
loop
'
CHARFORMATW cf
'CHARFORMAT2W cf
cf.cbsize = sizeof(cf)
'
sys bw,ew
int b,f,m,st,en,tc,w
wstring k,kk
b=se[0]
'
kk=l" good morning computer "
'extract word from list
word c at strptr(kk)
'skip leading space
do
select c
case 0 : exit do
case 1 to 32
case else : exit do
end select
@c+=2
loop
bw=@c
'skip word
do
select c
case 0 to 32 : exit do
end select
@c+=2
loop
ew=@c
int lk=(ew-bw)>>1
int bk=((bw-strptr(kk))>>1)+1
k=mid(kk,bk,lk)
'
w=len(k)
m=1
'color each matching word
do
f=instr(m,gs,k)
if f
st=b+f-1
en=st+w
tc= 0xf00040 : se = {st,en}
SendMessageW(h,EM_EXSETSEL,0,@se[0])
SendMessageW(h,EM_GETCHARFORMAT,SCF_SELECTION,@cf)
cf.dweffects and= not(CFE_AUTOCOLOR)
cf.crTextColor = tc
SendMessageW(h,EM_SETCHARFORMAT,SCF_SELECTION,@cf)
else
exit do
endif
m=f+w
loop
'
SendMessageW(h,EM_EXSETSEL,0,@se[2]) 'restore prior selection
SendMessageW(h,EM_HIDESELECTION,0,0)
exit function
case WM_COMMAND
id = wparam and 0xffff
int co = wparam >>16
if id>0x100 and id<0x200
s = "PushButton: " str id
SetWindowText hWnd, s
SetWindowText hchw[id], hex(id)+"h"
SetFocus hwnd
endif
case WM_SIZE: // main window changed size
RECT rc
int wo = 40, ho = 40, x, y
GetClientRect(hWnd, &rc)
'resize edit control
x = rc.right-wo-wo
y = rc.bottom-ho-ho
MoveWindow(hchw[0], wo, ho, x, y, TRUE);
ShowWindow(hchw[0], SW_SHOW);
case WM_CLOSE:
'save richedit content to file
==============================
int ecookie=0
sys h=hchw[0]
EDITSTREAM Streamout
StreamOut={@ecookie,0,@Editstreamocallback}
SendMessageW(h,EM_STREAMOUT,SF_RTF,@StreamOut)
dim bstring fdo
(sys) fdo = ubufp
fdo=left(fdo,ubufl)
putfile("test.rtf",fdo)
del fdo
ubufp=0
ubufl=0
ubufe=0
SendMessageW (hwnd,WM_DESTROY,0,0)
case WM_DESTROY:
DeleteObject hfont
PostQuitMessage 0
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
'
end function
-
Hi Charles,
commenting out the wstring ws test data and loading a .rtf file with an image into ws works very nicely, saving the file too. EDITSTREAMCALLBACK is a powerful tool.
Are you planning to use the RE control with OxIde? I guess that applying EM_STREAMOUT / EM_STREAMIN with SF_TEXT and/or SF_UNICODE can process as well Ansi as Unicode text files. But as you said it is a bit complicated and I have never really dared to address this issue.
-
Hi Roland,
Yes,I would like to replace Scintilla with RichEdit in Oxide, and support both Ansi and Unicode scripts. I was never comfortable with the Scintilla dependency. But first I need to develop syntax highlighting in RichEdit controls.