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
