Cantonese Input

Here are the download links to my Cantonese Input Method compiled with Visual Foxpro 6 and 9 respectively. The topmost one is the most recent version. All of them contain canton.dbf the database.

SourceForge: http://sourceforge.net/projects/changscantoneseinput/

GitHub:  https://github.com/changmw/changmw/tree/master/cantonese-input

My Cantonese Input program was intially written in Visual Foxpro 6 (with SP5) for Windows. The program is using Big5 character encoding, NOT Unicode, because Visual Foxpro had never supported Unicode. You will need to set Windows' system locale to Big5 first to run the program.

There are workarounds, but I haven't gotten time to research on them. The best one is VFP dotNet Extender, but it required Visual Foxpro 9. dotNet Extender was supposed to allow you to use dotNet Unicode UI classes in VFP forms. Another method is to switch everything to Micro$oft Access or Visual C#, which would require my aging brain to learn new programming languages.... :)

Micro$oft ActiveX Control Pad (for use of FM20.DLL):

http://download.microsoft.com/download/activexcontrolpad/install/4.0.0.950/win98mexp/en-us/setuppad.exe

Update 16 Oct 2014:

Found a way to make VFP 6 to pass UTF-8 characters properly to MS Form 2.0 ActiveX controls. The trick uses the Unicode clipboard of Windows.

First, the UTF-8 column in canton.dbf were encoded using Base64 algorihtm. To push UTF-8 to an MS Forms 2.0 textbox, the decoded Base64 value (now a UTF-8 character) were FILETOSTR() to a text file temp.txt, CLIP was called to copy the content of temp.txt to clipboard, after calling CHCP 65001 to switch the codepage to UTF-8. With the UTF-8 character in clipboard, textbox.paste() was called.

The above  method involves shelling to Command Prompt to execute those commands as a batch file. To speed things up, a Visual C++ or C# DLL could be developed to do the exact same things.

VFP 6 doesn't support SYS(3101, 65001) and STRCONV(xxx, [6..14]) as in VFP 9. It does have SYS(3005), but executing SYS(3005,65001) doesn't actually work, though VFP 6 still reports a codepage of 65001 when calling SYS(3004).

The above method does NOT work for REPORT FORM, I believe. I couldn't find a way to use ActiveX controls in REPORT FORM. So I still cannot print Unicode characters. Some said VFP 9 could do it. Well.... later!

Update 18 Sep 2014:

Starting September 2014, I was testing Visual Foxpro 9 as a way to add UTF-8 support in the input program. This made it possible to display and copy to clipboard HKSCS-2008 characters (e.g. "埗", "邨", ...)!  You can download the source code of the progrom below and compile it yourself. To execute it, use Visual Foxpro 9's Runtime Installer: http://www.foxpert.com/runtime.htm ! I am finding a way to produce and distribute executables....

Note that Visual Foxpro 9 does NOT support UTF-16 (e.g. "𨋢"), but UTF-8!

The VFP dotNet Extender product had disappeared. So I am now using Micro$oft Forms 2.0 ActiveX controls to display UTF-8 characters. However, VFP 6 automatically convert data from Forms 2.0 controls to english character set whenever data were stored into variables, making it impossible to retrieve raw data (in the form of UTF-8 binary values) from ActiveX controls.

Source Codes

*

* Created by: Chang Man Wai, 2004

* useful sites: http://www.lexiconer.com/

*

* 06SEP2008 : close canton.dbf as soon as possible

* 04NOV2008 : prevent clearing the clipboard when hitting reset

* 30JAN2009 : show touched, use fixed width font in listbox

* 01FEB2009 : Double-click to email, add text1.interactivechange()

* 03APR009 : Change button "NewLine" to "History",  add property buffer to class MyForm,

*       pressing it would recall all outputed Chinese Big5 and then the buffer be cleared

*       hitting cmdReset would also remember the history

* 13APR2009: Make cmdClip to remember history as well (like cmdReset)

* 10MAY2009: handle adnormal shutdown via "ON SHUTDOWN" and ReleaseType

* 24AUG2009: smarter buffer handling for cmdClip, cmdHistory and cmdReset

* 24SEP2009: show all possible keys text1 is empty

* 15OCT2009: bugfix for text1.valid() when handling blank key input

* 11NOV2009: smarter handling in thisform.text1.interactivechange()

* 20NOV2009: highlight text1 when mouse clicked it via gotfocus()

* 15APR2010: use form.BorderStyle to ensure minimum width & height

* 27MAY2010:  thisform.text1 now accepts only letters

* 17DEC2010: add DEFAULT_CLIPTEXT to faciliate Thunderbird message forwarding,

* bugfix for the 3 buttons in response to buffer changes, bugfix to SingleInstance()

* 18DEC2010: bugfix for FirstInstance(), add CloseMutex(), add getGUID()

* 10FEB2011: use sysmetric() to find out Window$ desktop size

* 19APR2011: hide the start-up screen by pushing & popping _screen.top and _screen.windowstate

* 25APR2011: discard _screen.old_top

* 07JUL2011: Add checkbox chkOnTop to control Always On Top

* 03SEP2011: Save clipboard when program starts

* 17OCT2011: Better icons: chang32.ico and chang256.ico using IcoFX-1.6.4

* 22OCT2011: If system clipboard is empty, set it to DEFAULT_CLIPTEXT (to save some clicks)

* bugfix for "WAIT  WINDOW" after  calling  FirstInstance(); clean  up start-up codes

* 23NOV2011: bugfix for Mutex

* 11MAR2012: Add function pastebig5() after nearly 24 hours of using Google and Usenet!

* Remember to Sleep() a while for SetForegroundWindow() to activate the caret

* 14MAR2012: Add chkDirect to control whether to use pastebig5()

* 22JAN2013: Add PageFrame; Beautify interface

* 27JAN2013: Support List1.DblClick(); Add cmdClear next to Text1; Fix bug in text1.Format;

* Re-coded text1.valid() based on text1.interactivechange();

* Add WasHit to MyCommandButton; Coupled Text1,cmdClear,cmdClip,cmdHistory,cmdReset 

* using event sequence and MyCommandButton.WasHit

* 01FEB2013: Various bugfixes and simplification of codes

* 02FEB2013: toquit is now char(1); button.washit was set in button.when()

* 11FEB2013: change TabStyle of PageFrame

* 12FEB2013: add cmdWebsite; re-coded mailto() as BrowseTo()

* 20OCT2013: consider position of taskbar when showing this program

* 10FEB2014: fill in form.tooltiptext

* 10APR2014: Add class MyUnicodeTextBox from Textbox of Micro$oft Forms 2.0 ActiveX objects

*            Disable error when canton.dbf cannot be updated (in Win 7 or above)

* 29AUG2014: add btnReturn to frmQuit, add UnicodeToString() and StringToUnicode()

*            testing M$ Forms textbox controls (setting multiline during init)

*            add Page4 to pageframe, change some BackColors,

*            change class of edit1 from EditBox to MyUnicodeTextbox, 

*            MyUnicodeCodeTextbox has no Valid() event but LostFocus()

* 30AUG2014: database change: THEKEY's lengeth increased

* Add WideCharToMultiByte() and MultiByteToWideChar()

* 08SEP2014: Add CopyUnicode2Clipboard() to replace _cliptext

* Add Page3 to PageFrame1

* 09SEP2014: making progress in handling Unicode and UTF8 via VFP 9

* Unicode using functions: sys(3101), strconv()

* add uncd c(4) to canton.dbf, to store unicode using base64 encoding strconv(13)

*            increase the length of column big5 from 2 to 4

* add recode() which convert big5(dbcs) -> UT8 -> base64 string

* 13SEP2014: make DEFAULT_CLIPTEXT a global variable rather than a #define

* 14SEP2014: Add Unicode characters from CJ-HKSCS-2008.txt, update field Changjie

*            Add functions FromBase64() and ToBase64()

* 15SEP2014: Add tbsave(), tbrest(); ToBase64() output different from strconv(13)

* Add variable _screen.cantondbf and detection logic for canton.dbf

* 16SEP2014: Add index on column THEKEY

* 18SEP2014: Add error-checking in cmdUpdate.click() when modifying canton.dbf

* Move readcanton(), ReadOldCanton() & readchangjei ouf of MyForm

* Add readhkscs2008()

* 12OCT2014: Add VFP6CopyUnicode() as workaround in VFP 6 to 

* pass Unicode characters to ActiveX controls via clipboard

* 16OCT2014: Add VFP6EncodeUTF8() as workaround in VFP6 to Base64-encode UTF8-8

*            Found paste.exe and clip.exe from 

*                   http://www.c3scripts.com/tutorials/msdos/paste.html

*                   http://www.c3scripts.com/tutorials/msdos/clip.html

*            Add chkBig5Only to Page2

* 17OCT2014: Add LaunchExeAndWait() to replace WinExecute()

*            Bugfix for cmdUpdate and cmdTranscode

* 21OCT2014: re-arrange checkboxes in Page2, alert users about clipboard usage in Page4

* 22NOV2014: bugfix for calling .copy(): always set SelStart & SelLength first, and

*            resetted back to zero after .copy()

* 11MAR2015: remove redundant codes in edit1.lostfocus(), 

* bug in page1.text1.lostfocus(), myFrmQuit

* 13MAR2015: add cmdMath instead of using edit1.LostFocus

* add cmdFacebook, cmdOffice in Page4 plus various changes

* add edit1.KeyUp()

* 14MAR2015: Move less used routines into #ifdef..#endif 

* to avoid the 64K file size limit for FXP

* 15MAR2015: Remove all instances of Washit and FormInit

* rename page1.text1 to text01'

* Reworked list1.KeyPress() to avoid a mysterious SetFocus bug 

* on using shortcut key to press a button;

* 16MAR2015: rework Page.activate() and Page.deactivate()

* 18MAR2015: fixed bug in edit1.KeyUp() calling form.KeyPress()

* 24MAR2015: increase the width of edit1; remove text01.LostFocus()

* consolidate building of cursor "matched"

* 25MAR2015: rework the Chinese character selection logic

* 26MAR2015: bugfix for pastebig5(); add _screen.default_cliptext

* Rename CopyUnicodeText2Clipboard() to ClipUTF16Text()

* 27MAR2015: add MyPage4.lblNotice; add MyPage2.cmbMthd

* 31MAR2015: hide screen by setting _screen.left rather than _screen.top

* 22MAY2015: add tooltips for cmdMath

* 29AUG2015: bugfix for checking for FM20.DLL and add error message

* 10SEP2015: add isDLLAvailable()

* 10JAN2016: Page1.cmdReset now always enabled;

* allow ALT+X, ALT+R to exit text0.valid() via reading lastkey()

* bugfix for clearing of edit1 on FIRST picking of list1's valie

* add _screen.cClipText to remember Window$' clipboard before program start

* correct copyright notice (starts with 2004 not 2008)

* add _screen.dbf_error; fix error handling involved with opening canton.dbf

* cleaned up the display of various error messages in Page1

* CANTON.DBF updates since Sep 2015

* 10JAN2016: Move error log to Window$'s temp folders

* fix error handling in addone()

* 11JAN2016: cmdClip now always enabled; correct error handler errhand()

* 23MAR2016: Add SetProcessDPIAware(), ResizeControls(), adjust various size parameters

* 28FEB2017: Add lblChangjei.click() and lblCalculate.click() to copy content to clipboard

*            Modify the result displayed by cmdMath.click()

*            Add class MyFrmViewFile and Page2.cmdLog to show error log

* Fix bug in text01.valid() displaying number of matches and handling of K_DOWN

* Change colors in myLblContainer

* 29DEC2017: Increase the height of MyUnicodeTextbox from 30 to 35

*            table data update ("BOX","SYMBOL","STAR","ARROW")

*            add column html c(5) to table; adjust positions of some UI controls

* separate update screen Page3 into two containers cntPage3C1 and cntPage3C2

* add textbox for column canton.html in both containers

* 17FEB2023: add CmdUrl, dbscs2uncd(), cmdHangHing, facebook.jpg, calculator.jpg;

* move cmdFacebook

* 01MAR2023: add CmdBrowse, allow other buttons in CmdClear

*

* Useful links: 

* http://input.foruto.com/cie/cie_bd.htm

* http://fox.wikis.com/wc.dll?Wiki~SkipValidOnExit

* VFP 9 Runtime installer

* http://www.foxpert.com/runtime.htm

* fm20.dll: http://support.microsoft.com/en-us/kb/224305

*

#undef debug_caret

#define GW_HWNDNEXT 2

#DEFINE GUITHREADINFO_SIZE  48

#DEFINE GUI_CARETBLINKING  1

#DEFINE GUI_INMOVESIZE     2

#DEFINE GUI_INMENUMODE     4

#DEFINE GUI_SYSTEMMENUMODE 8

#DEFINE GUI_POPUPMENUMODE  16

#define KEYEVENTF_KEYUP  0x0002 

#define WM_CHAR 0x0102

#define WM_SETTEXT 0x000C

#define WM_PASTE 0x0302

#define WM_COPYDATA 0x004A

#define EM_REPLACESEL 0x00C2

#define EM_SETSEL 0x00B1

#DEFINE CRYPT_STRING_BASE64 0x0001

#DEFINE CRYPT_STRING_NOCRLF 0x40000000

#DEFINE CRYPT_STRING_NOCR 0x80000000

#define VK_CONTROL   0x11

*

* WinExecute() from http://www.news2news.com/vfp/?example=2

*

#DEFINE SW_HIDE 0

#DEFINE SW_SHOWNORMAL 1

#DEFINE SW_SHOWMINIMIZED 2

#DEFINE SW_SHOWMAXIMIZED 3

#DEFINE SW_SHOWNOACTIVATE 4

#DEFINE SW_SHOW 5

#DEFINE SW_MINIMIZE 6

#DEFINE SW_SHOWMINNOACTIVE 7

#DEFINE SW_SHOWNA 8

#DEFINE SW_RESTORE 9

#DEFINE SW_SHOWDEFAULT 10

#Define K_F1 28

#Define K_ESC 27

#Define K_ENTER 13

#define K_LF 10

#define K_TAB 9

#define K_DOWN 24

#define K_ALT_R 19

#define K_ALT_X 45

#define K_ALT_C 46

#define MUTEX_NAME "chang_canton"

#define APP_NAME  "Chang's Cantonese Input"

#define ERROR_MUTEX_EXISTS 183

parameters m.p1, m.p2

clear all

close all

set resource off

public g_Form

*

* https://kevinragsdale.net/is-your-app-dpi-aware/

*

DECLARE INTEGER SetProcessDPIAware IN WIN32API

SetProcessDPIAware()

Clear DLLS

with _screen

.AddProperty("old_left", .left)

.AddProperty("old_winstate", .WindowState)

.AddProperty("StartUpFolder", fullpath(curdir()))

.AddProperty("cantondbf",.StartupFolder+"data\canton.dbf")

.AddProperty("clipbatname",UniqueFname("bat"))

.AddProperty("encdbatname",UniqueFname("bat"))

.AddProperty("txtname", UniqueFname("txt"))

.AddProperty("outname", UniqueFname("txt"))

.AddProperty("Quit", .f.)

.AddProperty("MutexHandle", -1)

.AddProperty("min_height", 265)

.AddProperty("min_width", 445)

.AddProperty("default_cliptext","")

.AddProperty("cCliptext", _cliptext)

.AddProperty("dbf_error",.f.)

* hide screen

.left=-2*sysmetric(21)

endwith

_screen.Caption=APP_NAME

* set codepage to Unicode

if left(version(4),2)>"06"

* Visual Foxpro 7,9

Sys(3101,65001)

sys(987,.f.)

else

sys(3005,65001)

endif

* check existence of canton.dbf, abort if missing

do case

case file(_screen.cantondbf)

* data folder under current directory (preferred)

case file(fullpath(curdir())+"canton.dbf")

* current directory

_screen.cantondbf=fullpath(curdir())+"canton.dbf"

otherwise

messagebox("missing "+_screen.cantondbf, 16)

return

endcase

tbsave()

_screen.ShowTips=.t.

_screen.Enabled=.f.

if left(version(4),2)>"06"

_screen.themes=.f.

endif

Set Exact On

Set Escape Off

set help off

Set Talk Off

Set Notify Off

Set Safety Off

if _vfp.StartMode=4

set debug off

endif

ON ERROR DO errhand WITH ;

ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( )

set console off

* prepare external batch file in %TEMP%

set alternate to (_screen.clipbatname)

set alternate on

?? "echo off"

?

?? "chcp 65001"

?

?? "clip < "+_screen.txtname

set alternate off

set alternate to

set alternate to (_screen.encdbatname)

set alternate on

?? "echo off"

?

?? "chcp 65001"

?

?? "paste | b64 -e > "+_screen.outname

set alternate off

set alternate to

set console on

if FirstInstance(MUTEX_NAME)

on shutdown do myquit

_screen.quit=.f.

g_form=Createobject("myform")

DO case

CASE Type("g_form")="O"

Set Sysmenu To _Msm_edit

g_form.Show()

Read Events

Set Sysmenu To Default

CASE _screen.dbf_error=.t.

MESSAGEBOX("Unable to open CANTON.DBF!")

otherwise

MESSAGEBOX("FM20.DLL not found!"+CHR(10) ;

+"Install Micro$oft Office or ActiveX Control Pad!", ;

16, APP_NAME ;

)

endcase

CloseMutex()

on shutdown

else

messagebox("Program already running!!",16)

endif

_screen.left=_screen.old_left

_screen.WindowState=_screen.old_winstate

_screen.enabled=.t.

delete file (_screen.clipbatname)

delete file (_screen.encdbatname)

delete file (_screen.txtname)

delete file (_screen.outname)

Set Escape On

Set Talk On

Set Notify On

Set Safety On

set debug on

set help on

* must be executed before CLEAR ALL

tbrest()

clear all

release all

If _screen.quit

Quit

Endif

on error *

set resource on

on error

Return

PROCEDURE errhand

LPARAMETER merror, mess1, mess2, mprog, mlineno

local m.errhand

* disable all errors when writing error log

m.errhand=ON("error")

on error *

set console off

set alternate to (GETENV("TEMP")+"\chang_canton_err.txt") additive

set alternate on

? repl("*",10), date(), time()

? 'Error number: ' + LTRIM(STR(merror))

? 'Error message: ' + mess1

? 'Line of code with error: ' + mess2

? 'Line number of error: ' + LTRIM(STR(mlineno))

? 'Program with error: ' + mprog

? repl("*",10)

set alternate off

set alternate to

set console on

on error &errhand

return

procedure myquit

local xx

on error *

on shutdown

close all

xx=sys(2023)+"\*.tmp"

if _screen.quit

delete files &xx

endif

on error

quit

return

Define Class MyLabel As Label

AutoSize=.t.

FontName="Courier New"

FontSize=14

BackStyle=0

IntegralHeight=.t.

Caption=""

Enddefine

Define Class MyCommandButton As CommandButton

Height=30

Width=110

FontSize=12

FontName="Arial Bold"

Cancel=.f.

Enddefine

Define class MyPage2 as MyPage

caption="\<Settings"

Add Object chkOnTop As checkbox with ;

top=30, Left=15, FontSize=14, AutoSize=.t., ;

Caption="Always On Top", value=.f.

Add Object chkBig5Only As checkbox with ;

top=70, Left=15, FontSize=14, AutoSize=.t., ;

Caption="Big5 Characters Only", value=.f.

Add Object chkDirect As checkbox with ;

top=110, Left=15, Fontsize=14, AutoSize=.t., ;

Caption="Send Key Directly:", Value=.f.

ADD OBJECT cmbMthd as ComboBox WITH ;

top=110, Left=165, Width=160, FontSize=14, Style=2, ;

RowSourceType=1

ADD OBJECT cmdLog as MyCommandButton WITH ;

top=150, Left=15, Width=100, Caption="\<Error Log"

PROCEDURE cmbMthd.Init

this.List(1)='EM_REPLACESEL'

this.List(2)='WM_PASTE'

this.List(3)='Sendkey(CTRL+V)'

this.List(4)='SendKey(Big5)'

this.value=1

EndProc

Function chkOnTop.interactivechange()

ThisForm.AlwaysOnTop=this.value

Return .t.

Procedure chkOnTop.Init

this.Value=ThisForm.AlwaysOnTop

EndProc

PROCEDURE cmdLog.click()

* View program error log

* MODIFY FILE GETENV("TEMP")+"\chang_canton_err.txt" NOEDIT SAME

Local lnRetval, lcFile, lcOperation

lcRetval = Filetostr(GETENV("TEMP")+"\chang_canton_err.txt")

Create Cursor MYCURSOR (text1 m)

Insert Into MYCURSOR (text1) Values (lcRetval)

oForm1=Createobject("MyFrmViewFile")

oForm1.Show()

USE IN MYCURSOR

EndProc

EndDefine

Define class MyPage3 as MyPage

caption="\<Update"

enabled=left(version(4),2)="09" or .t.

add object Page3C2 as cntPage3C2 with top=10, left=10

Add object Page3C1 as cntPage3C1 with top=135, left=10

Add object lblMessage as MyLabel with ;

top=200, left=5, AutoSize=.t., ;

Forecolor=rgb(255,0,0), fontsize=12, fontbold=.t.

EndDefine

Define class cntPage3C2 as container

height=120

width=415

backcolor=rgb(225,225,225)

* update data

Add object lblText21 as MyLabel with ;

top=10, left=5, caption="UTF-8", fontsize=9

Add object lblText22 as MyLabel with ;

top=10, left=55, caption="Big5", fontsize=9

Add object lblText23 as MyLabel with ;

top=10, left=125, caption="THEKEY", fontsize=9

Add object lblText24 as MYLabel with ;

top=10, left=230, caption="Changjei", fontsize=9

Add object lblText25 as MyLabel with ;

top=10, left=330, caption="Touched", fontsize=9

Add object lblText26 as MyLabel with ;

top=65, left=330, caption="HTML", fontsize=9

Add Object text21 as MyUnicodeTextbox with ;

top=27, left=5, ;

Height=35, width=40, Autosize=.t.

Add Object text22 as MyTextbox with ;

top=27, left=55, ;

Height=30, width=60, value="", format=""

Add Object text23 as MyTextbox with ;

top=27, left=125, ;

Height=30, width=100, value="", format="@"

Add Object text24 as MyTextbox with ;

top=27, left=230, ;

Height=30, width=95, value="", format="@"

Add Object text25 as MyTextbox with ;

top=27, left=330, ;

Height=30, width=80, value="", format=""

Add Object text26 as MyTextbox with ;

top=80, left=330, ;

Height=30, width=80, value="", format=""

Add Object cmdSearch as MyCommandButton with ;

top=80, left=5, caption="\<Search"

Add Object cmdUpdate as MyCommandButton with ;

top=80, left=120, caption="\<Add", visible=.f.

Add Object cmdBrowse as MyCommandButton with ;

top=80, left=250, width=75, caption="\<Browse", visible=.f.

procedure cmdBrowse.click()

select 0

m.errhand=on("error")

on error *

use (_screen.cantondbf) noupdate

on error &errhand

locate for uncd=this.parent.parent.Page3C1.text12.value

browse

use

return

procedure cmdSearch.click()

local m.uncd

this.parent.parent.lblMessage.caption=""

if this.caption="\<Cancel"

this.caption="\<Search"

with this.parent

.text21.text=""

.text22.value=""

.text23.value=""

.text24.value=""

.text25.value=0

.cmdUpdate.visible=.f.

.cmdBrowse.visible=.f.

with .parent.Page3C1

.text11.text=""

.text12.value=""

endwith

endwith

else

with this.parent

if len(.text21.text)=0

.parent.lblMessage.caption="No UTF-8 character to search!"

return

endif

if left(version(4),2)>"06"

* convert Unicode to base64

m.uncd=strconv(.text21.text,13)

* MESSAGEBOX("*"+m.uncd+"*")

else

* m.uncd=ToBase64(alltrim(.text21.text))

with .text21

.selStart=0

.selLength=len(.text)

.copy()

.selLength=0

endwith

m.uncd=VFP6EncodeUTF8()

endif

.parent.Page3C1.text12.value=m.uncd

select 0

m.errhand=on("error")

on error *

use (_screen.cantondbf) noupdate

on error &errhand

if used()

IF EMPTY(m.uncd)

  locate for EMPTY(uncd) AND !EMPTY(changjei)

else

  locate for uncd=m.uncd

endif

if found()

.text22.value=canton.big5

.text23.value=canton.thekey

.text24.value=canton.changjei

.text25.value=canton.touched

if left(version(4),2)>"06"

.parent.Page3C1.text11.text=.text21.text

else

with .parent.Page3C1.text11

.text=""

.Paste()

endwith

endif

.cmdUpdate.caption="\<Update"

else

.text22.value=.text21.text

.parent.lblMessage.caption="Unicode character ("+m.uncd+") not found!"

.cmdUpdate.caption="\<Add"

endif

.cmdUpdate.visible=.t.

.cmdBrowse.visible=.t.

use

else

.parent.lblMessage.caption="Unable to open CANTON.DBF!"

endif

endwith

this.caption="\<Cancel"

endif

return

procedure cmdUpdate.click()

local m.big5, m.uncd, m.thekey, m.changjei, m.touched

local m.errhand

this.parent.parent.lblMessage.caption=""

with this.parent

if left(version(4),2)>"06"

* convert Unicode to base64

m.uncd=strconv(alltrim(.text21.text),13)

else

with .text21

.selStart=0

.selLength=len(.text)

.copy()

.selLength=0

endwith

m.uncd=VFP6EncodeUTF8()

endif

m.big5=.text22.value

m.thekey=alltrim(.text23.value)

m.changjei=alltrim(.text24.value)

m.touched=.text25.value

m.errhand=on("error")

on error *

select 0

use (_screen.cantondbf) shared

on error &errhand

if used()

locate for uncd=m.uncd

if found()

replace big5 with m.big5

replace thekey with m.thekey

replace changjei with m.changjei

replace touched with m.touched

.parent.lblMessage.caption="UTF-8 character ("+m.uncd+") updated!"

else

insert into canton ( ;

uncd, thekey, big5, changjei, touched ;

) values ( ;

m.uncd, m.thekey, m.big5, m.changjei, m.touched ;

)

.parent.lblMessage.caption="UTF-8 character ("+m.uncd+") added!"

endif

use

else

.parent.lblMessage.caption="Unable to open CANTON.DBF!"

endif

.text21.text=""

.text22.value=""

.text24.value=""

.text25.value=0

.cmdUpdate.visible=.f.

.cmdBrowse.visible=.f.

.cmdUpdate.caption="\<Add"

.cmdSearch.caption="\<Search"

with .parent.Page3C1

.text11.text=""

.text12.value=""

endwith

endwith

endproc

Enddefine

Define class cntPage3C1 as container 

height=60

width=415

backcolor=rgb(225,225,225)

* Transcode

Add object lblText11 as MyLabel with ;

top=1, left=5, caption="UTF-8", fontsize=9

Add Object text11 as MyUnicodeTextbox with ;

top=18, left=5, ;

Height=35, width=40, Autosize=.t.

Add Object cmdTranscode as MyCommandButton with ;

top=18, left=50, caption="\<Transcode"

Add object lblText12 as MyLabel with ;

top=1, left=180, caption="Base64", fontsize=9

Add Object text12 as MyTextbox with ;

top=18, left=180, ;

Height=30, width=100, value="", format="K"

Add object lblText13 as MyLabel with ;

top=1, left=300, caption="HTML", fontsize=9

Add Object text13 as MyTextbox with ;

top=18, left=300, ;

Height=30, width=100, value="", format="K"

procedure cmdTranscode.click()

this.parent.parent.lblMessage.caption=""

with this.parent

do case

case empty(.text11.text) and empty(.text12.value) and empty(.text13.value)

.parent.lblMessage.caption="Fill in UTF-8 or Base64 to transcode!"

case !empty(.text11.text)

if left(version(4),2)>"06"

* VFP 6

* convert Unicode to base64

.text12.value=strconv(.text11.text,13)

.parent.Page3C2.text21.text=.text11.text

else

* .text12.value=ToBase64(.text11.text)

with .text11

.selStart=0

.selLength=len(.text)

.copy()

.selLength=0

endwith

.text12.value=VFP6EncodeUTF8()

with .parent.Page3C2

.text21.text=""

.text21.paste()

endwith

endif

case !empty(.text12.value)

if left(version(4),2)>"06"

* VFP 6

* convert base64 to Unicode

.text11.text=strconv(.text12.value,14)

.parent.Page3C2.text21.text=.text11.text

else

VFP6CopyUnicode(FromBase64(.text12.value))

.text11.paste()

with .parent.Page3C2

.text21.text=""

.text21.paste()

endwith

endif

case !empty(.text13.text)

.parent.lblMessage.caption="HTML Not yet available!"

otherwise

.text11.text=""

.text12.value=""

endcase

endwith

return

EndDefine

Define class MyPage4 as MyPage

caption="\<About"

* BackColor=RGB(199,157,83)

Add Object cmdHangHing as Image with ;

top=10, Left=10, Width=90, Height=90, ;

picture="hanghing.jpg", Stretch=2, ToolTipText="Hang Hing Metal Mfgr, Facebook"

Add Object lblNotice As Label With ;

top=10, Left=120, Height=50, Width=300, FontSize=10, FontItalic=.t., FontBold=.t., WordWrap=.t.,;

AutoSize=.t., ForeColor=rgb(255,64,64), ;

Caption="This program needs Microsoft Office (FM20.DLL) to display Unicode, ";

+ "needs system locale set to Traditional Chinese and " ;

+ "uses the Window$ clipboard extensively!"

Add Object cmdSrcFrg as MyCommandButton with ;

top=75, Left=120, Width=210, Height=20, FontSize=8, FontItalic=.t., ForeColor=rgb(128,64,0), ;

Caption="https://sourceforge.net/projects/changscantoneseinput/"

Add Object cmdGitHub as MyCommandButton with ;

top=75, Left=120+210+10, Width=25, Height=25, FontSize=8, FontItalic=.t., ForeColor=rgb(128,64,0), ;

Caption="", Picture="github.jpg", ToolTipText="GitHub"

Add Object lblCantonDBF As EditBox With ;

top=110, Left=15, Fontsize=10, Width=400, Height=50, ;

Scrollbars=0, Fontname="Courier New", Enabled=.f., ;

Value="Data: "+_screen.cantondbf

Add Object lblFreeware As Label With ;

top=165, Left=15, FontSize=8, FontBold=.t., AutoSize=.t., ;

Caption="Freeware and open source (2004-2023)", ForeColor=rgb(128,64,0)

Add Object cmdWebsite as MyCommandButton with ;

top=160, Left=210, Width=210, Height=20, FontSize=8, FontItalic=.t., ForeColor=rgb(128,64,0), ;

Caption="http://sites.google.com/site/changmw"

Add Object cmdEmail as MyCommandButton with ;

top=180, Left=190, Width=190, Height=20, FontSize=8, FontItalic=.t., ForeColor=rgb(128,64,0), ;

Caption="Email: toylet.toylet@gmail.com"

Add Object cmdFacebook as MyCommandButton with ;

top=180, Left=190+190+10, Width=20, Height=20, FontSize=8, FontItalic=.t., ForeColor=rgb(128,64,0), ;

Caption="", Picture="facebook.jpg", ToolTipText="Facebook"

Add Object lblEmailA As Label With ;

top=185, Left=15, FontSize=8, AutoSize=.t., Caption="Programmed by"

Add Object lblEmailB As Label With ;

top=185, Left=100, FontSize=8, FontBold=.t., AutoSize=.t., ForeColor=rgb(128,64,0), ;

Caption="Man-wai Chang"

Add Object lblCopyRightA As Label With ;

top=205, Left=15, FontSize=8, AutoSize=.t., Caption="Powered by"

Add Object lblCopyRightB As Label With ;

top=205, Left=90, FontSize=8, FontBold=.t., AutoSize=.t., ForeColor=rgb(128,64,0), ;

Caption="Micro$oft Visual Foxpro ";

+iif(left(version(4),2)=="06","6","9") ;

+" (SP" ;

+iif(left(version(4),2)=="06","5","2") ;

+")"

Function cmdSrcFrg.Click()

local m.lcTarget

m.lcTarget = this.caption

BrowseTo(m.lcTarget)

return .t.

Function cmdGitHub.Click()

local m.lcTarget

m.lcTarget = "https://github.com/changmw/master/tree/master/cantonese-input"

BrowseTo(m.lcTarget)

return .t.

Function cmdEmail.Click()

local m.lcTarget

m.lcTarget = "mailto:toylet.toylet@gmail.com"+ ;

  "?CC=&Subject= About Chang's Cantonese Input"+ ;

  "&Body= "

BrowseTo(m.lcTarget)

return .t.

Function cmdWebsite.Click()

local m.lcTarget

m.lcTarget="https://sites.google.com/site/changmw/foxpro/cantonese-input"

BrowseTo(m.lcTarget)

return

Function cmdHangHing.click()

local m.lcTarget

m.lcTarget="https://www.facebook.com/groups/156886187680074/"

BrowseTo(m.lcTarget)

return

Function cmdFacebook.click()

local m.lcTarget

m.lcTarget="https://www.facebook.com/changmanwai"

BrowseTo(m.lcTarget)

return

EndDefine

Define Class MyTextBox As TextBox

FontSize=16

Format="!K"

IntegralHeight=.t.

lastvalue=""

Enddefine

Define class MyAnimation as OleControl 

OLEClass="ComCtl2.Animation.1"

Procedure Init

this.Open("hanghing.avi")

this.Play()

EndProc

EndDefine

Define class MyUnicodeEdit As MyUnicodeTextBox 

Width=255

Height=120

ToolTipText="Enter a maths. equation here"

Procedure Init

dodefault()

* run "command /c echo "44CQ6L2J6LK844CR" | b64 -d | clip"

*

* http://www.foxite.com/archives/vfp-unicode-0000233480.htm

* this.text=strconv(STRCONV("rpt3gmlfcoJnUW5/b5g6eU9c",14),10)

*

this.top=this.parent.my_top+60

this.Left=this.parent.my_left+170

this.multiline=.T.

EndProc

EndDefine

Define class MyUnicodeTextbox as OleControl 

*!* http://www.foxite.com/archives/vfp-unicode-0000233480.htm

*!*

*!* http://support.microsoft.com/kb/171673

*!*

*!* Microsoft ActiveX Control Pad

*!* http://msdn.microsoft.com/en-us/library/ms968493.aspx

OleClass="Forms.TextBox.1"

default_text=""

procedure init

this.multiline=.F.

this.font.size=14

this.IntegralHeight=.t.

this.selectionmargin=.f.

this.text=""

*!* this.scrollbars=3

*!* this.textAlign=3 

*!* this.IMEmode=0 

this.font.name="Courier New"

*!* this.forecolor=rgb(0,0,255)*

*!* =COMPROP(this,"UTF8",1)

return .t.

Function keyup

lparameters keycode, shift

*** activex control event ***

* http://weblogs.foxite.com/ammarhadi/2009/07/12/activex-keypress-chaos/

do case

case keycode.value=K_ESC

nodefault

thisform.KeyPress(keycode.value, shift)

case keycode.value=K_TAB

nodefault

this.parent.text01.SetFocus()

endcase

return

EndDefine

Define class MyUnicodeLabel as OleControl

OleClass="Forms.TextBox.1"

procedure init

this.IntegralHeight=.t.

with this.font

.name="Courier"

.size=13

.bold=.t.

endwith

this.SpecialEffect=0

this.BackColor=this.parent.BackColor

this.SelectionMargin=.f.

this.Enabled=.f.

this.text=""

return .t.

Function When

this.parent.text01.Setfocus()

return .f.

EndDefine

Define class MyLblContainer as Container

height=50

width=255

BorderWidth=0

BackColor=RGB(197,156,60)

Add Object lblUncd As MyUnicodeLabel With ;

top=3, Left=5, width=30, Height=25

Add Object lblChangjei As MyLabel With ;

top=5, Left=37, width=80, Height=25, ;

ForeColor=RGB(0,255,255), FontBold=.t., ToolTipText="倉頡碼 Click to copy"

Add Object lblMatches As myLabel With ;

top=3, Left=105, width=this.width-10-100, ;

AutoSize=.f., Alignment=1, FontBold=.t., ForeColor=RGB(255,255,255)

Add Object lblCalculate As myLabel With ;

top=25, Left=5, width=this.width-10, height=30, ;

Autosize=.f., Alignment=1, FontBold=.t., ForeColor=RGB(0,255,0)

PROCEDURE lblChangJei.click()

with thisform.PageFrame1.Page1.Edit1

m.yy=dbcs2uncd("倉頡:")

.Text=m.yy+this.caption

endwith

EndProc

PROCEDURE lblCalculate.click()

with thisform.PageFrame1.Page1.Edit1

.Text=this.caption

endwith

EndProc

EndDefine

Define class MyPage1 as MyPage

caption="\<Main"

my_top=5

my_left=5

Add Object CntLabels as MyLblContainer with ;

top=this.my_top+3, left=this.my_left+170

Add Object text01 As MyTextbox With ;

top=this.my_top+8,Left=this.my_left+5,Height=29, Width=125, ;

FontName="Courier New", Format="@!",Value="", SelectOnEntry=.t.

Add Object list1 As ListBox With ;

top=this.my_top+50,Left=this.my_left,Width=165,Height=165, ;

FontName="Courier New", FontSize=14, ;

rowsourcetype=6, ;

columncount=2, ;

columnlines=.f., ;

IntegralHeight=.t., ;

rowsource="left(matched.big5,7), kissed"

Add Object cmdClear as MyCommandButton with ;

top=this.my_top+8,Left=this.my_left+5+130+5, ;

Width=20,Caption="\<X", enable=.t., TabStop=.f.

* Add Object edit1 As MyUnicodeEdit

Add Object cmdClip As MyCommandButton with ;

top=this.my_top+182,Left=this.my_left+175, Width=70, Caption="\<Copy", enabled=.t.

Add Object cmdHistory As MyCommandButton with ;

top=this.my_top+182,Left=this.my_left+175+75, Width=70,Caption="\<History", enabled=.f.

Add Object cmdReset As MyCommandButton With ;

top=this.my_top+182,Left=this.my_left+175+75+75, Width=70,Caption="\<Reset", enabled=.t.

Add Object cmdMath As Image With ;

top=this.my_top+182,Left=this.my_left+175+75+75+15+60, Width=24, Height=30, ;

Stretch=2, Picture="calculator.jpg", BackStyle=0, ToolTipText="Do Maths in EditBox"

Function cmdClear.Click()

with this.parent.text01

.Value=""

.InteractiveChange()

.SetFocus()

endwith

return

Procedure text01.valid()

local m.loObj

if lastkey()=K_ESC

return .t.

ENDIF

* 2017FEB28

IF INLIST(LASTKEY(),K_ALT_R, K_ALT_X, K_ALT_C, K_DOWN)

* ALT+R(cmdReset), ALT+X(cmdClear), ALT+C(cmdClip), Down Arrow

RETURN .t.

ENDIF

m.loObj=sys(1270)

if type("loObj")="O"

if INLIST(upper(loObj.name),"CMDCLEAR","CMDURL","CMDCLIP")

return .t.

ENDIF

endif

if !used("matched") or reccount("matched")=0

this.SelStart=0

this.SelLength=len(alltrim(this.Value))

return .f.

ENDIF

if matched.big5=this.value

with this.parent.CntLabels

IF BuildMatched(this.value,.t.)

* 2017FEB28

.lblMatches.Caption=alltrim(str(reccount("matched")))+" matches"

ELSE

.lblCalculate.caption=""

.lblMatches.caption=""

RETURN .f.

endif

endwith

endif

return .t.

Function text01.interactivechange()

LOCAL m.dbferr

with this.parent.CntLabels

.lblCalculate.caption=""

.lblMatches.caption=""

endwith

m.dbferr=.f.

do case

case !BuildMatched(this.value, .f.)

m.dbferr=.t.

case reccount("matched")==0

* no syllable match, search remap

Select modified From remap ;

where original=This.Value ;

into Cursor t_dummy

If !empty(t_dummy.modified)

This.Value=t_dummy.modified

m.dbferr=!BuildMatched(this.Value, .f.)

Endif

Use In t_dummy

case reccount("matched")=1

m.dbferr=!BuildMatched(this.value, .t.)

ENDCASE

with this.parent

with .list1

.requery()

.listindex=1

endwith

IF m.dbferr

.CntLabels.lblCalculate.caption="Can't open CANTON.DBF!"

ELSE

.CntLabels.lblMatches.Caption=alltrim(str(reccount("matched")))+" matches"

endif

endwith

return m.dbferr

Function cmdMath.Click()

local m.aa, m.bb, m.errhand, m.xx, m.ii

with this.parent

if empty(.edit1.text)

.cntLabels.lblCalculate.caption="No maths expression!"

return

ENDIF

* remove right-hand side including the equal sign

m.xx=.Edit1.Text

m.aa=RAT("=",m.xx)

IF m.aa>0

m.bb=SUBSTR(.Edit1.Text, m.aa)

m.xx=STRTRAN(m.xx,m.bb,"")

.Edit1.Text=m.xx

.cntLabels.lblCalculate.caption="Equal sign removed!"

return

endif

* remove CR, LF from math expression

m.aa=alltrim(.Edit1.Text)

m.aa=strtran(m.aa,space(1),"")

m.aa=strtran(m.aa,chr(K_ENTER),"")

m.aa=strtran(m.aa,chr(K_LF),"")

* simple filter to remove characters that are not numbers nor math signs

for m.ii=asc("a") to asc("z")

m.aa=strtran(m.aa,chr(m.ii),"")

endfor

for m.ii=asc("A") to asc("Z")

m.aa=strtran(m.aa,chr(m.ii),"")

endfor

* compute the math expression

m.errhand=on("error")

on error *

m.bb=eval(m.aa)

on error &errhand

* display result or error message

if type("m.bb")="N"

m.bb=LTRIM(floatpnt(m.bb,15,4))

.cntLabels.lblCalculate.caption=m.bb

.Edit1.Text=m.aa+"="+m.bb

else

.cntLabels.lblCalculate.caption="Bad math expression!"

endif

endwith

return

Function list1.DblClick()

keyboard chr(K_ENTER)

nodefault

return .t.

Procedure list1.KeyPress

lparameter nKeyCode, nsac

Local m.thekey, m.tempbuffer, m.xx

with this.parent

do case

case between(nKeyCode,asc("A"),asc("Z")) or between(nKeyCode,asc("a"),asc("z"))

nodefault

this.parent.text01.SetFocus()

keyboard chr(nKeyCode)

case nKeyCode=K_TAB

nodefault

.text01.SetFocus()

case nkeycode=K_ENTER

nodefault

if this.parent.edit1.text==this.parent.edit1.default_text

thisform.buffer=this.parent.edit1.text

this.parent.edit1.text=""

endif

If matched.leaf

.cntLabels.lblUncd.text=""

.cntLabels.lblChangjei.caption=""

* leaf, no need to drill further, user chose the chinese character

thisform.addone(matched.big5)

do case

case thisform.PageFrame1.Page2.chkBig5Only.value

m.xx=alltrim(matched.big5)

.edit1.text=.edit1.text+m.xx

.cntLabels.lblUncd.text=m.xx

case left(version(4),2)>"06"

* convert base64 to Unicode

m.xx=strconv(alltrim(matched.uncd),14)

.edit1.text=.edit1.text+m.xx

.cntLabels.lblUncd.text=m.xx

otherwise

m.xx=FromBase64(alltrim(matched.uncd))

VFP6CopyUnicode(m.xx)

.edit1.paste()

with .cntLabels.lblUncd

.text=""

.Paste()

endwith

ENDCASE

WITH thisform.PageFrame1.Page2

if .chkDirect.value

pastebig5(.cmbMthd.value, m.xx, matched.big5)

ENDIF

endwith

with thisform.PageFrame1.Page3.Page3C2.text21

if left(version(4),2)>"06"

.text=m.xx

else

.text=""

.paste()

endif

endwith

.cntLabels.lblChangjei.caption=ALLTRIM(matched.changjei)

Else

* NOT leaf, load the chinese characters of the branch

m.thekey=alltrim(matched.big5)

with .text01

.Value=m.thekey

.lastValue=m.thekey

endwith

IF BuildMatched(m.thekey, .t.)

.list1.Requery()

.cntLabels.lblMatches.Caption=Alltrim(Str(Reccount("matched")))+" Matches"

ELSE

.cntLabels.lblMatches.Caption=""

endif

Endif

Endcase

endwith

Endproc

Procedure cmdClip.Click

* copy to windows clipboard

with this.parent

if !empty(.edit1.text)

with .edit1

.selStart=0

.selLength=len(.text)

.copy()

.selLength=0

endwith

thisform.buffer=thisform.buffer ;

+iif(empty(thisform.buffer),"",CHR(K_LF)) ;

+.edit1.text

.cmdHistory.enabled=!empty(thisform.buffer)

endif

.text01.SetFocus()

endwith

Endproc

Procedure cmdHistory.Click

with this.parent

.edit1.text=Thisform.buffer

thisform.buffer=""

this.enabled=.f.

.text01.SetFocus()

endwith

Endproc

Procedure cmdReset.Click

local m.lastline, m.xx

with this.parent

m.xx=.edit1.text

if thisform.lastclip()<>m.xx

thisform.buffer=thisform.buffer ;

+iif(empty(thisform.buffer),"",chr(K_ENTER)) ;

+m.xx

endif

.edit1.text=""

.cmdHistory.enabled=!empty(thisform.buffer)

.text01.SetFocus()

endwith

Endproc

Procedure Activate

this.text01.setfocus()

dodefault()

Endproc

EndDefine

Function BuildMatched

LParameter m.thekey, m.leaf

LOCAL m.errhand

m.errhand=ON("error")

ON ERROR *

select 0

use (_screen.cantondbf) noupdate alias cantonha

ON ERROR &errhand

IF !USED("cantonha")

return .f.

endif

if used("matched")

use in matched

endif

if m.leaf

Select big5, uncd, changjei, ;

m.leaf As leaf, kissed_mask(touched) as kissed;

from cantonha ;

where thekey=m.thekey ;

order by touched descending ;

into Cursor matched

else

m.thekey=alltrim(m.thekey)

Select distinct thekey As big5, "" as uncd, Space(1) As changjei, ;

m.leaf As leaf, "" as kissed ;

from cantonha ;

where !empty(thekey) ;

and left(thekey,len(m.thekey))=m.thekey ;

order by thekey ;

into Cursor matched

endif

use in cantonha

return .t.

Define class MyPage as Page

Fontsize=11

FontName="Tahoma"

Function Activate

this.FontBold=.t.

this.refresh()

return

Function Deactivate

this.FontBold=.f.

this.refresh()

return

Enddefine

Define class MyPageFrame as PageFrame 

TabStyle=1

    top=5

    Left=5

    width=_screen.min_width-6

    height=_screen.min_height-6

Add object Page1 as MyPage1

Add object Page2 as MyPage2

Add object Page3 as MyPage3

Add object Page4 as MyPage4

EndDefine

Define Class MyForm As Form

icon="chang256.ico"

ToolTipText=APP_NAME

ShowWindow=2

ShowTips=.t.

AlwaysOnTop=.t.

Desktop=.t.

Caption=APP_NAME

KeyPreview=.T.

AutoCenter=.f.

MaxButton=.f.

Visible=.f.

Width=_screen.min_width

Height=_screen.min_height

BorderStyle=1

oToolbar=.F.

Buffer=""

WidthRatio = 0

HeightRatio = 0

Add Object PageFrame1 as MyPageFrame

Add Object cmdUrl as MyCommandButton with ;

top=5, Left=_screen.min_width-6-40, Tooltiptext="[Title/URL]", ;

Width=40,Caption="", enable=.t., TabStop=.f., Picture="newspaper.jpg"

Procedure Load

IF !BuildMatched("", .f.)

_screen.dbf_error=.t.

NODEFAULT