

  $ 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

