NB. built from project: ~Source\main\formedit\formedit
NB. init

script_z_ '~system\packages\graphics\bmp.ijs'
script_z_ '~system\main\gl2.ijs'
script_z_ '~system\main\regex.ijs'
script_z_ '~system\main\strings.ijs'

coclass 'jformedit'


coextend 'jgl2 jijs'
create=: 3 : 0

copybuffer=: ''
if. GSCALE=0 do.
  wd 'pc gscale;xywh 0 0 200 200;cc g isigraph'
  s=. 2 { 0 ". wd 'qchildxywh g'
  x=. 2 { 0 ". wd 'qchildxywhx g'
  wd 'pclose'
  GSCALE_jformedit_=: x % s
  GWHX_jformedit_=: 2 {. 0 ". wd 'qm' 
  XYWH_jformedit_=: '0 0 ',": GWHX % GSCALE 
end.

if. isempty y. do.
  id=. qsmact ''
  FNAME=: id2name id
  if. '.ijx' -: _4 {. FNAME do.
    info 'Open a script window before running Form Edit'
    destroy''
    return.
  end.
  smsel id
  smsave ''
else.
  FNAME=: y.
  smopen FNAME
end.
if. 0 = file_init'' do. destroy'' end.
)
create_show=: 3 : 0

wd DESIGN
wd 'pn "Design - ',PID,'"'
wdfit''
nd=. 'undo redo center minus plus size space touch'
wd 3 |. ; ' 0;setenable '&, each ;: nd
selectdesign=: wd bind ('psel ',wd 'qhwndp')

drawform''
wd 'ptop'
selectdesign''
wd 'ptop'
wd 'pshow'

getformsizes''
bufsnap ''
)
destroy=: 3 : 0
try.
  selectform''
  wd 'pclose'
catch. end.
try.
  selectdesign''
  wd 'pclose'
catch. end.
codestroy''
)
addLF=: , & LF
addDQuote=: '"'&, @ (,&'"')
deb=: #~ (+. 1: |. (> </\))@(' '&~:)
index=: #@[ (| - =) i.
isempty=: 0: e. $
roundint=: <. @ +&0.5
sessiontime=: 6!:1
tolist=: }. @ ; @: (LF&, @ , @ ": each)
towords=: ;: ^: _1
capture=: 3 : 0
CAPTURE=: {. y.
glcapture y.
)
cursor=: 3 : 0
glcursor CURSOR=: y.
)
deletecc=: 3 : 0
if. #SELECT do.
  ndx=. <<<SELECT
  CCS=: ndx { CCS
  CLS=: ndx { CLS
  CPS=: ndx { CPS
  IDS=: ndx { IDS
  STY=: ndx { STY
  SELECT=: $0
  drawform ''
  bufsnap''
end.
)
deldblquote=: 3 : 0
nd0=. 1 + y. index '"'
nd1=. y. i: '"'
nd0 }. nd1 {. y.
)
dblquote=: '"'&, @ (,&'"')
delprefix=: 3 : 0
ndx=. 1 + y. i. &> '_'
towords ndx }. each y.
)
flipypos=: 3 : 0
ry=. $y.
(ry $ 0, GHX) + y. * ry $ 1 _1
)
flipypos1=: 3 : 0
({. y.), GHX - {:y.
)
flipyrect=: 3 : 0
c=. GHX - +/"1 [ 1 3{"1 y
($y.) $ ,c 1}"0 1 y
)
flerase=: (1!:55&< :: _1: ) &>
flread=: (1!:1 :: _1:) @ boxopen
flstamp=: (1: >@{ ,@(1!:0)) ::(_1:)
flwrite=: (1!:2 :: _1:) boxopen
flreads=: 3 : 0
dat=. (1!:1) :: _1: boxopen y.
if. (dat -: _1) +. 0=#dat do. return. end.
dat,LF -. {:dat=. toJ dat
)
flwrites=: 4 : 0
dat=. x.
if. -. 0 e. $dat do.
  if. 1>:#$dat do.
    dat=. toHOST dat
    dat=. dat,(LF ~: {:dat)#CRLF
  else. dat=. dat,"1 CRLF
  end.
end.
dat flwritenew y.
)
flwritenew=: 4 : 0
dat=. ,x.
new=. -. dat -: flread y.
if. new do. dat flwrite y. end.
new
)
getformsizes=: 3 : 0
FORMSIZES=: roundint GSCALE * FORMSIZES_j_
)
getoleocx=: 3 : 0
if. 0 = # OLEOCX do.
  j=. _2 [\ <;._2 wd 'oleocx'
  OLEOCX=: j /: tolower each {."1 j
end.
)
getwhx=: 3 : 0
selectform''
2 3 { 0 ". wd 'qchildxywhx g'
)
globals=: 3 : 0
rx=. rxcomp '([[:alpha:]][[:alnum:]_]*|x\.|y\.|m\.|n\.|u\.|v\.) *=:'
nms=. rx rxall y.
rxfree rx
nms=. _2 }. each ~. nms
hdr=. PID, '_'
len=. # hdr
len }. each ((<hdr) = len {. each nms) # nms
)
ifshiftkey=: 3 : '''1'' e. sysmodifiers'
ifctrlkey=: 3 : '''2'' e. sysmodifiers'
ifctrlshiftkey=: 3 : '''3'' e. sysmodifiers'
info=: 3 : 0
wdinfo 'Form Edit';y.
)
query=: 4 : 0
x. wdquery 'Form Edit';y.
)
mousepos=: 3 : 0
'x y w h'=. 4 {. 0 ". sysdata
x, h - y
)
selectcode=: 3 : 0
smopen FNAME
dat=. smread ''
sel=. {. SELECT
id=. sel pick IDS
ndx=. ({."1 CONTROLS) i. sel { CLS
evt=. > {. 6 pick ndx { CONTROLS
if. 0 = #evt do. return. end.
fn=. PID,'_',id,'_',evt
ndx=. 1 i.~ ((fn,'=:') E. dat) +. (fn,' =:') E. dat
if. ndx = #dat do.
  new=. LF,fn,'=: 3 : 0',LF
  dat=. dat,new,')',LF
  smwrite dat
  ndx=. ndx + #new
else.
  ndx=. ndx + 1 + (ndx }. dat) i. LF
end.
smsetselect ndx,ndx,0
smfocus''
)
state=: 3 : 0
nms=. 'cc';'caption';'id';'class';'style'
dat=. > each CCS ; CPS ; IDS ; CLS ; <STY
nms ,: dat
)
tocoords=: 3 : 0
'x y w h'=. |: y.
s=. x + w - 1
t=. y + h - 1
x=. <. x % GSCALE
y=. <. y % GSCALE
w=. 1 + (<. s % GSCALE) - x
h=. 1 + (<. t % GSCALE) - y
x,.y,.w,.h
)

topixels=: 3 : 0
'x y w h'=. |: y.
s=. x + w - 1
t=. y + h - 1
x=. roundint x * GSCALE
y=. roundint y * GSCALE
w=. 1 + (roundint s * GSCALE) - x
h=. 1 + (roundint t * GSCALE) - y
x,.y,.w,.h
)

tocoords1=: , @ tocoords @ ,:
topixels1=: , @ topixels @ ,:
ws_add=: 3 : 0
dat=. ;: ^: (L.=0:) y.
towords (<'ws_group') (I. dat = <'group') } dat
)
ws_del=: 3 : 0
dat=. ;: ^: (L.=0:) y.
(<'group') (I. dat = <'ws_group') } dat
)

BLACK=: 0 0 0
RED=: 255 0 0
BLUE=: 0 0 255

off=. (IFWINCE) * 16b40000000
f=. ". @ wd @ ('qcolor '&,) @ ": @ (off&+)
'WIND TEXT BORD HIGH HTXT GRAY'=: f &> 5 8 10 13 14 15
WIND=: (IFUNIX) pick WIND;255 255 255

PID=: ''     
PST=: ''     
PCN=: ''     
PAS=: 6 6    
POP=: ''     
PMV=: ''     
PFE=: ''     
CCS=: 0 4$0  
CLS=: ''     
CPS=: ''     
IDS=: ''     
STY=: ''     
BUF=: ''     
MNU=: ''     
RFE=: 'rem form end;'
SBR=: ''     
TBR=: ''     
TBFN=: jpath '~system\examples\data\isitbar8.bmp'
MOUSEIGNORE=: 0
MOUSETIME=: sessiontime''

GSCALE=: 0
GWHX=: 0 0 
XYWH=: '' 

HFORM=: 0  
BOX=: '' 
CURSOR=: 0
DOWN=: '' 
UP=: ''   
ORDER=: 0 
PDF=: ''  
SELECT=: $0 
STEP=: 1  
TESTLOC=: ''  
TESTHWNDP=: '' 
WINDIR=: 0 
GFONT=: PROFONT
OLEOCX=: ''   
sysevent=: ''
sysmodifiers=: ,'0'
CAPNONE=: 0
CAPMOVE=: 7
CAPSIZE=: 8
CAPSELECT=: 3
CAPTURE=: CAPNONE
GSCALE=: 0 
GRID=: 16 
FNAME=: '' 
PID=: '' 

j=. 0 : 0
button
bs
group
defpushbutton ownerdraw
0 1
1
button
checkbox
bs
group
lefttext
2 4
1
button
combobox
cbs
group vscroll
autohscroll sort
2 2
0
button select
combodrop
cbs
group vscroll
autohscroll sort
2 2
0
button select
combolist
cbs
group vscroll
sort
2 2
0
button select
edit
es
group thickframe
autohscroll lowercase nohidesel password readonly right uppercase
2 3
0
button
editm
es
group hscroll thickframe vscroll
autohscroll autovscroll center lowercase nohidesel readonly right uppercase
2 2
0

editijs
es
group hscroll thickframe vscroll
autohscroll autovscroll center lowercase nohidesel readonly right uppercase
2 2
0

editijx
es
group hscroll thickframe vscroll
autohscroll autovscroll center lowercase nohidesel readonly right uppercase
2 2
0

groupbox
-
group
-
2 2
1

isigraph
-
group
-
2 2
0
char copy cut mbldbl mbldown mblup mbrdbl mbrdown mbrup mmove paint paste size undo
listbox
lbs
group hscroll vscroll
extendedsel multicolumn multiplesel ownerdrawfixed sort
2 2
0
button select
progress
-
group
-
2 3
0
button
radiobutton
bs
-
lefttext
2 4
1
button
richedit
es
group thickframe
autohscroll nohidesel readonly sunken
2 3
0
button
richeditm
es
group hscroll thickframe vscroll
autohscroll autovscroll center nohidesel readonly right sunken
2 4
0

scrollbar
sbs
group
-
2 3
0
button
scrollbarv
sbs
group
-
3 2
0
button
spin

group
-
1 1
0
button
spinv

group
-
1 1
0
button
static
ss
group
center leftnowordwrap noprefix right simple
2 4
1

staticbox
ss
group
blackframe blackrect etchedframe etchedhorz etchedvert grayframe grayrect sunken whiteframe whiterect
2 2
0

tab
tcs
group
buttons multiline
2 2
0
button
trackbar
tbs
group
autoticks both enableselrange nothumb noticks top
2 3
0
button
trackbarv
tbs
group
autoticks both enableselrange left nothumb noticks
3 2
0
button
ocx
ocx
group

2 2
0
button
)

j=. _7 [\ <;._2 j -. '-'
s=. 'border clipchildren clipsiblings disabled '
std=. ([: 'ws_'&, each [: ;: s&,) each 2 {"1 j
sty=. (1 {"1 j) ,each '_'
cls=. (< each sty) ,each each ;: each 3 {"1 j
siz=. 0 ". each 4 {"1 j
cap=. 0 ". each 5 {"1 j
evt=. ;: each 6 {"1 j
CONTROLS=: (2 {."1 j) ,. std ,. cls ,. siz ,. cap ,. evt
JAVASTYLES=: cutopen 0 : 0
bs_defpushbutton
bs_lefttext
bs_ownerdraw
cbs_autohscroll
cbs_sort
es_autohscroll
es_autovscroll
es_center
es_lowercase
es_nohidesel
es_password
es_readonly
es_right
es_sunken
es_uppercase
lbs_extendedsel
lbs_multicolumn
lbs_multiplesel
lbs_ownerdrawfixed
lbs_sort
sbs_vert
ss_blackframe
ss_blackrect
ss_center
ss_etchedframe
ss_etchedhorz
ss_etchedvert
ss_grayframe
ss_grayrect
ss_leftnowordwrap
ss_noprefix
ss_right
ss_simple
ss_sunken
ss_whiteframe
ss_whiterect
tbs_autoticks
tbs_both
tbs_enableselrange
tbs_left
tbs_nothumb
tbs_noticks
tbs_top
tcs_buttons
tcs_multiline
ws_border
ws_clipchildren
ws_clipsiblings
ws_disabled
ws_group
ws_hscroll
ws_thickframe
ws_vscroll
)
3 : 0''
std=. 2 {"1 CONTROLS
cls=. 3 {"1 CONTROLS
if. IFJAVA do.
  std=. std (e. # [) each <JAVASTYLES
  cls=. cls (e. # [) each <JAVASTYLES
end.
CONTROLS=: (std ,. cls) 2 3 }"1 CONTROLS
)

FORMEVENTS=: <;._2 (0 : 0)
break
cancel
close
default
enter
handler
run
)
WCODE=: 0 : 0
pc wcode owner;
xywh 4 7 45 64;cc g0 groupbox;cn "Event type";
xywh 9 18 38 9;cc wccontrol radiobutton;cn "control";
xywh 9 30 38 9;cc wcfkey radiobutton group;cn "fkey";
xywh 9 42 38 9;cc wcform radiobutton group;cn "form";
xywh 9 54 38 9;cc wcorphan radiobutton group;cn "orphan";
xywh 56 7 90 66;cc wclist listbox ws_vscroll;
xywh 151 9 36 12;cc wcclose button;cn "Close";
xywh 151 24 36 12;cc wccode button;cn "Code...";
xywh 151 39 36 12;cc wchelp button;cn "Help";
pas 3 4;pcenter;
rem form end;
)
wcode_run=: 3 : 0
wd WCODE
HCODE=: wd 'qhwndp'
wd 'set wccontrol 1'
'wccontrol wcfkey wcform wcorphan'=: ": each 1 0 0 0
wclist=: ''
wcode_show 0
wd 'pn "Code - ',PID,'"'
wd 'pshow;'
)
wcode_wccode_button=: 3 : 0
smopen FNAME
dat=. smread''
if. '1' e. wccontrol,wcfkey,wcform do.
  dat=. dat, LF, PID,'_',(wclist -. ' '),'=: 3 : 0',LF,')',LF
  smwrite dat
  wcode_show''
  smfocus''
elseif. # j=. wclist -. ' ' do.
  ndx=. 1 i.~ (PID,'_', j) E. dat
  smsetselect ndx,ndx,0
  smfocus
end.
)
wcode_close=: 3 : 0
wd 'pclose'
)
wcode_show=: 3 : 0
smopen FNAME
GLOBALS=: globals smread ''
wd 'psel ',HCODE
select. (wccontrol,wcfkey,wcform,wcorphan) i. '1'
case. 0 do.
  wcodelist controlevents''
case. 1 do.
  wcodelist fkeyevents''
case. 2 do.
  wcodelist FORMEVENTS
case. 3 do.
  inc=. FORMEVENTS,(controlevents''),fkeyevents''
  nms=. /:~ GLOBALS -. inc -. each ' '
  wd 'set wclist ',towords dblquote each nms
end.
)
wcode_wchelp_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
wcodelist=: 3 : 0
nms=. y. -. each ' '
ndx=. nms index <wclist -. ' '
msk=. nms e. GLOBALS
nms=. msk /:~ (msk { '  ';'') ,each y.
wd 'set wclist ',towords dblquote each nms
wd 'setselect wclist ',":ndx
)
wcode_wccontrol_button=: wcode_show
wcode_wcfkey_button=: wcode_show
wcode_wcform_button=: wcode_show
wcode_wcorphan_button=: wcode_show
wcode_wcclose_button=: wcode_cancel=: wcode_close
wcode_wclist_button=: wcode_enter=: wcode_wccode_button
controlevents=: 3 : 0
evt=. (({."1 CONTROLS) i. CLS) { 6{"1 CONTROLS
ctl=. ; (IDS ,each '_') (<@[ ,each ]) each evt
mnu=. <;._2 MNU
msk=. (<'menu ') = 5 {. each mnu
mnu=. 5 }. each msk # mnu
mnu=. (mnu i. &> ' ') {. each mnu
mnu=. mnu ,each <'_button'
~. ctl, mnu
)
fkeyevents=: 3 : 0
f=. 'f' ,each ": each 1 + i.12
r=. f
r=. r, f ,each <' ctrl'
r=. r, f ,each <' shift'
r=. r, f ,each <' ctrlshift'
a=. a. {~ ; (a. i. 'a0') + each i. each 26 10
r=. r, a ,each <' ctrl'
r=. r, a ,each <' ctrlshift'
r=. r -. 'c ctrl';'v ctrl';'x ctrl';'z ctrl'
r ,each <'_fkey'
)

FMSTYLE=: , ; each { (;<;:'left top right bottom') ; <;:'move scale'
WCONTROL=: 0 : 0
pc wcontrol nomax nomin nosize owner;pn "Control";
xywh 4 7 21 9;cc s0 static;cn "Class:";
xywh 28 7 55 9;cc sclass static;
xywh 4 18 24 9;cc s1 static;cn "Id:";
xywh 29 17 55 10;cc id edit ws_border es_autohscroll;
xywh 4 29 24 9;cc scaption static;cn "Caption:";
xywh 29 28 55 10;cc caption edit ws_border es_autohscroll;
xywh 5 42 79 38;cc g0 groupbox;cn "Size rules";
xywh 10 58 22 10;cc wz button;cn "Fix";
xywh 33 52 22 10;cc nz button;cn "Fix";
xywh 56 58 22 10;cc ez button;cn "Fix";
xywh 33 64 22 10;cc sz button;cn "Fix";
xywh 88 7 40 9;cc s3 static;cn "Styles:";
xywh 88 16 45 65;cc style listbox lbs_multiplesel lbs_sort;
xywh 137 7 40 9;cc s4 static;cn "Class Styles:";
xywh 137 17 45 65;cc class listbox lbs_multiplesel lbs_sort;
xywh 186 7 36 12;cc ok button;cn "OK";
xywh 186 19 36 12;cc cancel button;cn "Cancel";
xywh 186 33 36 12;cc apply button;cn "&Apply";
xywh 186 47 36 12;cc code button;cn "&Code...";
xywh 186 61 36 12;cc help button;cn "&Help";
pas 3 3;pcenter;
rem form end;
)
wcontrol_run=: 3 : 0
if. 0 = #SELECT do.
  info 'First select a control' return.
end.
if. 1 < #SELECT do.
  info 'Select a single control' return.
end.

sel=. {. SELECT
class=. sel pick CLS
styles=. ;: sel pick STY
ndx=. ({."1 CONTROLS) i. < class
'sty cst cap evt'=. 2 3 5 6 { ndx { CONTROLS
evt=. > {. evt
ocx=. class-:'ocx'
cap=. cap +. ocx

design_enable ''
wd WCONTROL
wd 'pn "Control - ',PID,'"'
wd 'setcaption sclass ',class
wd 'set id *',sel pick IDS
wd 'set caption *',sel pick CPS
wd 'setshow scaption ',":cap
wd 'setshow caption ',":cap
wd 'setenable code ',":0 < #evt
wd 'setcaption scaption ',ocx pick 'Caption:';'ocx:'
FMS=: (_2 [\ FMSTYLE e. styles) i."1 [ 1
wcontrol_setmoves''

wd 'set style ',delprefix sty
for_n. I. sty e. styles do.
  wd 'setselect style ',":n
end.
wd 'set class ',delprefix cst
for_n. I. cst e. styles do.
  wd 'setselect class ',":n
end.

wd 'pshow;'
MOUSEIGNORE=: 1
)
wcontrol_close=: 3 : 0
wcontrol_read''
wcontrol_cancel''
drawform''
)
wcontrol_cancel=: 3 : 0
MOUSEIGNORE=: 0
wd'pclose'
)
wcontrol_read=: 3 : 0
sel=. {. SELECT
cls=. sel pick CLS
ndx=. ({."1 CONTROLS) i. <cls
pfx=. 1 pick ndx { CONTROLS
fms=. FMSTYLE {~ (FMS < 2) # FMS + 0 2 4 6
s=. 'ws_'&, each cutopen style
s=. s, (pfx,'_')&, each cutopen class
s=. towords s,fms
STY=: (<s) sel } STY
IDS=: (<id) sel } IDS
CPS=: (<caption) sel } CPS
)
wcontrol_setmoves=: 3 : 0
if. #y. do.
  FMS=: 3 | FMS + y. = i. 4
end.
dat=. FMS { ;: 'Move Scale Fix'
wd 'setcaption wz ', 0 pick dat
wd 'setcaption nz ', 1 pick dat
wd 'setcaption ez ', 2 pick dat
wd 'setcaption sz ', 3 pick dat
)

wcontrol_wz_button=: wcontrol_setmoves bind 0
wcontrol_nz_button=: wcontrol_setmoves bind 1
wcontrol_ez_button=: wcontrol_setmoves bind 2
wcontrol_sz_button=: wcontrol_setmoves bind 3

wcontrol_ok_button=: wcontrol_close
wcontrol_cancel_button=: wcontrol_cancel
wcontrol_apply_button=: 3 : 0
wcontrol_read''
drawform''
)
wcontrol_code_button=: 3 : 0
wcontrol_apply_button''
selectcode ''
)
wcontrol_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)

bufsnap=: 3 : 0
if. #BUF do.
  BUF=: (1 + POS) {. BUF
end.
BUF=: BUF, (<CCS;CLS;CPS;IDS;STY;SELECT) -. _1 {. BUF
POS=: <: # BUF
selectdesign''
wd 'setenable undo ',": * POS
wd 'setenable redo 0'
)
bufredo=: 3 : 0
if. POS < <: # BUF do.
  old=. IDS
  POS=: POS + 1
  'CCS CLS CPS IDS STY SELECT'=: POS pick BUF
  drawform ''
  design_enable''
  selectdesign''
  wd 'setenable undo 1'
  wd 'setenable redo ', ": POS < <: # BUF
end.
)
bufundo=: 3 : 0
if. POS > 0 do.
  old=. IDS
  POS=: POS - 1
  'CCS CLS CPS IDS STY SELECT'=: POS pick BUF
  drawform ''
  design_enable''
  selectdesign''
  wd 'setenable redo 1'
  wd 'setenable undo ', ": POS > 0
end.
)

DESIGN=: 0 : 0
pc design nomax nomin nosize;
menupop "File";
menu save "Save" "" "" "";
menusep ;
menu exit "Exit" "" "" "";
menupopz;
menupop "Window";
menu winnew "New  Control" "" "" "";
menu wincontrol "Control" "" "" "";
menu winparent "Parent" "" "" "";
menusep ;
menu windel "Delete Control"  "" "" "";
menusep ;
menu winmenu "Menu" "" "" "";
menu wintoolbar "Toolbar" "" "" "";
menu winstatus "Statusbar" "" "" "";
menusep ;
menu wincode "Code" "" "" "";
menu winscript "Script" "" "" "";
menupopz;
menupop "Help";
menu helpformedit "Form Edit" "" "" "";
menupopz;
xywh 13 4 10 10;cc n button;cn "";
xywh 3 14 10 10;cc w button;cn "";
xywh 13 14 10 10;cc c button;cn "1";
xywh 23 14 10 10;cc e button;cn "";
xywh 13 24 10 10;cc s button;cn "";
xywh 37 4 26 10;cc new button;cn "New...";
xywh 37 14 26 10;cc view button;cn "View";
xywh 37 24 26 10;cc script button;cn "Script";
xywh 65 4 26 10;cc undo button;cn "Undo";
xywh 65 14 26 10;cc redo button;cn "Redo";
xywh 91 4 26 10;cc center button;cn "Center";
xywh 91 14 26 10;cc size button;cn "Size";
xywh 117 4 26 10;cc space button;cn "Space";
xywh 117 14 26 10;cc touch button;cn "Touch";
xywh 143 4 26 10;cc minus button;cn "Minus";
xywh 143 14 26 10;cc plus button;cn "Plus";
xywh 171 4 36 12;cc ok button;cn "OK";
xywh 171 18 36 12;cc cancel button;cn "Cancel";
xywh 66 26 46 9;cc id static;cn "";
xywh 112 26 47 9;cc pos static ss_center;cn "";
pas 3 2;pcenter;
rem form end;
)
design_align=: 3 : 0
if. 2 > #SELECT do. return. end.
anc=. {. SELECT
bal=. }. SELECT
select. y.
case. 'w' do.
  CCS=: ((<anc;0) { CCS) (<bal;0) } CCS
case. 'n' do.
  CCS=: ((<anc;1) { CCS) (<bal;1) } CCS
case. 'e' do.
  lef=. 0 >. (+/ (<anc;0 2) { CCS) - (<bal;2) { CCS
  CCS=: lef (<bal;0) } CCS
case. 's' do.
  top=. 0 >. (+/ (<anc;1 3) { CCS) - (<bal;3) { CCS
  CCS=: top (<bal;1) } CCS
end.
drawform ''
bufsnap''
)
design_close=: 3 : 0
saveform''
smfocus''
destroy''
)
design_c_button=: 3 : 0
STEP=: (STEP = 1) { 1 4
wd 'setcaption c ',": STEP
)
design_cancel_button=: 3 : 0
smfocus''
destroy''
)
design_center_button=: 3 : 0
if. isempty SELECT do. return. end.
pas=. roundint GSCALE * PAS
if. ifshiftkey '' do.
  hit=. (1 { pas) + >./ +/"1 (<(<SELECT);1 3) { CCS
  top=. roundint -: hit - (<SELECT;3) { CCS
  CCS=: top (<SELECT;1) } CCS
else.
  wid=. (0 { pas) + >./ +/"1 (<(<SELECT);0 2) { CCS
  lef=. roundint -: wid - (<SELECT;2) { CCS
  CCS=: lef (<SELECT;0) } CCS
end.
drawform ''
bufsnap''
)
design_enable=: 3 : 0
selectdesign''
select. # SELECT
case. 0 do.
  cmd=. '/center 0/minus 0/plus 0/size 0/space 0/touch 0'
case. 1 do.
  cmd=. '/center 1/minus 0/plus 0/size 0/space 0/touch 0'
case. 2 do.
  cmd=. '/center 1/minus 1/plus 1/size 1/space 0/touch 1'
case. do.
  cmd=. '/center 1/minus 1/plus 1/size 1/space 1/touch 1'
end.
wd ;'setenable '&, each (<;._1 cmd) ,each ';'
)
design_helpformedit_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
design_move=: 3 : 0
if. ifshiftkey'' do.
  design_align y.
else.
  design_move1 y.
end.
)
design_move1=: 3 : 0
if. # SELECT do.
  c=. tocoords SELECT { CCS
  c=. c +"1 [ 0 0 ,~ STEP * (y. = 'es') - y. = 'wn'
  c=. topixels 0 >. c
  CCS=: c SELECT } CCS
  drawform ''
  bufsnap''
end.
)
design_save_button=: 3 : 0
saveform''
)
design_script_button=: 3 : 0
smopen FNAME
smfocus''
)
design_size_button=: 3 : 0
if. 2 > #SELECT do. return. end.
anc=. {. SELECT
bal=. }. SELECT
if. ifshiftkey '' do.
  h=. (<anc;3) { CCS
  CCS=: h (<bal;3) } CCS
else.
  w=. (<anc;2) { CCS
  CCS=: w (<bal;2) } CCS
end.
drawform ''
bufsnap''
)
design_space_button=: 3 : 0
if. 3 > len=. #SELECT do. return. end.
if. ifshiftkey '' do.
  ndx=. SELECT /: (<SELECT;1) { CCS
  top=. (<ndx;1) { CCS
  hit=. (<ndx;3) { CCS
  spc=. ({:top) - ({.top) + +/ }: hit
  dif=. 0 >. roundint spc % <: len
  new=. ({.top) + }: +/\ hit + dif
  CCS=: new (<(}.ndx);1) } CCS
else.
  ndx=. SELECT /: (<SELECT;0) { CCS
  lef=. (<ndx;0) { CCS
  wid=. (<ndx;2) { CCS
  spc=. ({:lef) - ({.lef) + +/ }: wid
  dif=. 0 >. roundint spc % <: len
  new=. ({.lef) + }: +/\ wid + dif
  CCS=: new (<(}.ndx);0) } CCS
end.
drawform ''
bufsnap''
)
design_spread=: 3 : 0
if. 2 > #SELECT do. return. end.
bal=. }. SELECT
if. ifshiftkey '' do.
  bal=. bal /: (<bal;1) { CCS
  y=. (y. * 1 + i.#bal) + (<bal;1) { CCS
  CCS=: y (<bal;1) } CCS
else.
  bal=. bal /: (<bal;0) { CCS
  x=. (y. * 1 + i.#bal) + (<bal;0) { CCS
  CCS=: x (<bal;0) } CCS
end.
drawform ''
bufsnap''
)
design_view_button=: 3 : 0
if. #TESTLOC do.
  open=. wd :: 0: 'psel ',TESTHWNDP,';pclose'
  coerase :: ] TESTLOC
  TESTLOC=: TESTHWNP=: ''
  if. open do. return. end.
end.
TESTLOC=: cocreate ''
a=. form_create 1
try. wd__TESTLOC a
catch.
  err=. wd 'qer'
  ndx=. >: err i. ':'
  msg=. ndx {. err
  pos=. {.". ndx }. err
  cmd=. (>:j i.';') {. j=. pos}. a
  if. 50 < #cmd do.
    cmd=. (47{.cmd),'...' end.
  info 'wd error ',msg,LF,cmd
  coerase :: ] TESTLOC
  TESTLOC=: ''
  return.
end.
wd 'pshow'
TESTHWNDP=: wd 'qhwndp'
selectdesign''
)
design_touch_button=: 3 : 0
if. 2 > #SELECT do. return. end.
anc=. {. SELECT
bal=. }. SELECT
if. ifshiftkey '' do.
  top=. (<anc;1) { CCS
  bal=. bal /: (<bal;1) { CCS
  y=. top + 0, +/\ (<(anc,}:bal);3) { CCS
  CCS=: y (<(anc,bal);1) } CCS
else.
  lef=. (<anc;0) { CCS
  bal=. bal /: (<bal;0) { CCS
  x=. lef + 0, +/\ (<(anc,}:bal);2) { CCS
  CCS=: x (<(anc,bal);0) } CCS
end.
drawform ''
bufsnap''
)
design_ok_button=: design_close

design_e_button=: design_move bind 'e'
design_n_button=: design_move bind 'n'
design_s_button=: design_move bind 's'
design_w_button=: design_move bind 'w'

design_minus_button=: design_spread bind _1
design_plus_button=: design_spread bind 1

design_new_button=: newcc_run
design_exit_button=: design_close
design_redo_button=: bufredo
design_undo_button=: bufundo
design_wincode_button=: wcode_run
design_wincontrol_button=: wcontrol_run
design_windel_button=: deletecc
design_winmenu_button=: wmenu_run
design_winnew_button=: newcc_run
design_winparent_button=: wparent_run
design_winscript_button=: design_script_button
design_winstatus_button=: wstatus_run
design_wintoolbar_button=: wtbar_run


cc_isigraph=: 3 : 0
wd 'xywh ',XYWH
wd 'cc ',y.,' isigraph nopas;setpclip ',y.,' 0'
glnoerasebkgnd 1
glnodblbuf 1
glmap MM_RAW
)
drawform=: 3 : 0

oldform=. HFORM
if. oldform do.
  wd 'psel ',oldform
  xywh=. wd 'qformx'
  wd 'pc form'
  wd 'pmovex ',xywh
else.
  wd 'pc form'
end.

HFORM=: wd 'qhwndp'
cap=. (*#PCN) pick PID;PCN
wd 'pn "',cap,'"'
wd MNU
wd SBR
wd TBR
if. 'jwin32'-:wd 'qwd' do.
  cc_isigraph 'g'
end.
cc_isigraph 'gd'
glbrush glrgb GRAY
glrect 0 0, GWHX
glrgb 0 0 0
if. -. IFJAVA do.
  glpixel GRID * > ,{ i. each >. GWHX % GRID
end.
glshow''
wd formcc_create 0
cc_isigraph 'gf'
drawforeground ''
if. 'jjava'-:wd 'qwd' do.
  cc_isigraph 'g'
end.
if. # SELECT do.
  selectdesign''
  wd 'set id *', ({.SELECT) pick IDS
  wd 'set pos *',": tocoords1 ({.SELECT) { CCS
end.
wd 'psel ',HFORM
wd 'pas 6 6;pshow'

glsel :: ] 'g'
if. oldform do.
  wd 'psel ',oldform
  wd 'pclose'
  wd 'psel ',HFORM
end.

1
)
drawforeground=: 3 : 0

wd 'psel ',HFORM
glsel 'gf'
glclear ''
glnoerasebkgnd 1
glnodblbuf 1
glmap MM_RAW

colors=. RED,:BLUE
if. #SELECT do.
  ccs=. SELECT { CCS
  for_i. SELECT do.
    clr=. i ~: {. SELECT
    glrgb clr { colors
    glpen 3 0
    glbrushnull''
    glrect i_index { ccs
  end.
end.
if. #BOX do.
  glrgb {. colors
  glpen 2 0
  glbrushnull''
  glrect BOX
end.
if. ORDER do.
  glrgb 0 0 0
  glpen 1 0
  glbrushnull''
  for_i. CCS do.
    'x y w h'=. i
    gltextxy 3 1 + x, y
    gltextalign TA_LEFT
    gltext ": i_index
  end.
end.

glshow''
if. y. do.
  glsel :: ] 'g'
end.

)

file_init=: 3 : 0
dat=. file_read FNAME
if. dat -: 0 do. 0 return. end.
nms=. a: -.~ {."1 dat
select. #nms
case. 0 do. newform ''
case. 1 do. openform 0 pick nms
case. do. pickform nms
end.
1
)
file_read=: 3 : 0
smsel y.
smsave ''
dat=. flreads y.
if. dat -: _1 do.
  info 'Unable to read: ',>y.
  0 return.
end.
file_read1 dat
)
file_read1=: 3 : 0
dat=. y.
if. 0 = # dat do. i.0 2 return. end.
msk=. (LF,RFE,LF) E. dat
if. 0 = +/ msk do. ,: '';<dat return. end.
hdr=. msk i. 1
f=. [: </\ (LF,')',LF)&E.
msk=. f each msk <;.1 dat
msk=. _2 |. (hdr#0),;msk
ndx=. 1 + msk i: 1
ftr=. ndx }. dat
dax=. msk <;.2 dat
(; pairform each dax), '';ftr
)
openform=: 3 : 0
PID=: y.
fdata=. file_read FNAME
ndx=. ({."1 fdata) i. <PID
dat=. (<ndx;1) pick fdata
txt=. {:"1 fdata
dat=. a: -.~ <;._2 dat
ndx=. 1 i.~ dat = <RFE
PFE=: tolist ndx }. dat
dat=. ndx {. dat
PDF=: deb (i.&'=' {. ]) 0 pick dat
dat=. }. dat
dat=. (, ';'"_ -. {:) each dat

msk=. (<'menu') = 4 {. each dat
MNU=: readmenudef getmenudef ; (msk # dat) ,each LF
dat=. (-. msk) # dat

msk=. (<'sbar') = 4 {. each dat
SBR=: readstatusdef getstatusdef ; (msk # dat) ,each LF
dat=. (-. msk) # dat

msk=. (<'tbar') = 4 {. each dat
TBR=: readtoolbardef gettoolbardef ; (msk # dat) ,each LF
dat=. (-. msk) # dat

msk=. (<'xywh') = 4 {. each dat
dat=. <;._2 each dat
child=. msk # dat
parent=. (-. msk) # dat
pdf=. 0 pick parent
PST=: (1 + # 'pc ',PID) }. 0 pick pdf
PCN=: deldblquote 3 }. 1 pick pdf, a:
pop=. ';' cutopen 1 pick parent, a:
ndx=. I. (<'pas ') = 4 {. each pop
if. #ndx do.
  PAS=: 2 {. 0 ". 4 }. ({.ndx) pick pop
  pop=. (<<<ndx) { pop
else.
  PAS=: 6 6
end.
POP=: pop
cx=. 0 pick each child
cc=. 1 pick each child
cn=. 2 pick each child ,each <<''

msk=. (3 {. each cc) e. <'cc '
msk=. msk *. (3 {. each cn) e. 'cn ';'   '

if. 0 e. msk do.
  msg=. tolist ([: ; ,&';' each) each msk # child
  info 'Ignoring invalid child definition: ', msg
  cc=. msk # cc
  cn=. msk # cn
  cx=. msk # cx
end.

if. #cc do.
  CCS=: 0 ". &> 5 }. each cx 
  cc=. 3 }. each cc
  ndx=. cc i. &> ' '
  IDS=: ndx {. each cc
  cc=. (ndx + 1) }.each cc
  ndx=. cc i. &> ' '
  CLS=: ndx {. each cc
  STY=: ws_add each (ndx + 1) }.each cc
  CPS=: deldblquote each 3 }. each cn
  
  ndx=. I. 'ocx:'&-: &> 4 {.each CLS
  if. #ndx do.
    txt=. 4 }.each ndx { CLS
    CPS=: txt ndx } CPS
    CLS=: (<'ocx') ndx } CLS
  end.
end.
CCS=: topixels CCS

create_show ''
)
pairform=: 3 : 0
dat=. <;.2 y.
msk=. 1 |. (<'pc ') = 3 {.each dat
msk=. msk *. (1: e. '0 : 0'&E.) &> dat
if. 0 = +/msk do.
  (<''),.y.;''
else.
  ndx=. msk i: 1
  hdr=. ndx {. dat
  ftr=. ndx }. dat
  nam=. 1 pick ;: 1 pick ftr
  ('';;hdr) ,: nam;;ftr
end.
)
saveform=: 3 : 0
fdata=. file_read FNAME
frm=. form_read''
ndx=. ({."1 fdata) i. <PID
if. ndx = #fdata do.
  fdata=. fdata, PID;frm
else.
  fdata=. (<frm) (<ndx;1) } fdata
end.
dat=. ; {:"1 fdata
smopen FNAME
old=. smread''
if. -. old -: dat do.
  smwrite dat
  smsave ''
end.
)

DELKEY=: 174
FORMISIGRAPHS=: 'gd';'gf';,'g'
form_cancel=: 3 : 0
destroy''
)
form_close=: 3 : 0
saveform''
smfocus''
destroy''
)
form_g_char=: 3 : 0
if. IFJAVA >: IFWIN32 do. return. end.
if. DELKEY = a.i.{.sysdata do.
  deletecc''
end.
)
form_newcc_button=: newcc_run
form_parent_button=: 3 : 0
wd 'mb parent *set parent styles etc'
)
form_read=: 3 : 0
r=. PDF,'=: 0 : 0',LF
r=. r, form_create 0
r,LF,PFE,LF
)
form_create=: 3 : 0
view=. {. y., 0
pst=. PST , view # ' closeok'
r=. deb 'pc ',PID,' ',pst
r=. r,';',(*#PCN) # 'pn "',PCN,'";'
r=. r,LF
r=. r,MNU
r=. r,SBR
r=. r,TBR
cns=. (CPS ~: IDS) # each CPS
cap=. (({."1 CONTROLS) i. CLS) { (5 {"1 CONTROLS),<0
dat=. IDS,.CLS,.STY,.cns,.cap
ccs=. tocoords CCS
grp=. 0
r=. r, formcc_create 1
r=. r,'pas ',(":PAS),';'
r=. r, ; ,&';' each ~. POP, view # <'ptop'
r=. r,(*#PMV) # 'pmove ',(":PMV),';'
)
formcc_create=: 3 : 0
final=. y.
cns=. (CPS ~: IDS) # each CPS
cap=. (({."1 CONTROLS) i. CLS) { (5 {"1 CONTROLS),<0
ids=. IDS
if. -. final do.
  if. #ndx=. I. ids e. FORMISIGRAPHS do.
    new=. ndx { ids
    whilst. 1 e. new e. ids do.
      new=. new ,each '0'
    end.
    ids=. new ndx } ids
  end.
end.
dat=. ids,.CLS,.STY,.cns,.cap
ccs=. tocoords CCS
grp=. 0
r=. ''
for_i. i.#ids do.
  'd c s n p'=. i { dat
  s=. ws_del s
  select. c
  case. 'button' do.
    s=. s -. (-.final) # <'bs_ownerdraw'
  case. 'radiobutton' do.
    if. grp do.
      s=. s, (<'group') -. s
    else.
      s=. s -. <'group'
    end.
  case. 'isigraph' do.
    c=. final pick 'editm';'isigraph'
  case. 'tab' do.
    c=. final pick 'groupbox';'tab'
  case. 'ocx' do.
    c=. final pick 'editm';'ocx:',n
    n=. ''
  end.
  grp=. c -: 'radiobutton'
  s=. towords s
  s=. (* # s) # ' ',s
  if. p do.
    n=. 'cn "',n,'";'
  else.
    n=. ''
  end.
  r=. r,'xywh ',": i { ccs
  r=. r,';cc ',d,' ',c,s,';',n,LF
end.
)
form_g_copy=: copyselect
form_g_paste=: pasteselect

form_nctrl_fkey=: form_newcc_button
form_pctrl_fkey=: form_parent_button
form_sctrl_fkey=: saveform
form_tctrl_fkey=: order
selectform=: 3 : 0
wd 'psel ',HFORM
)
copyselect=: 3 : 0
copybuffer=: SELECT
)
pasteselect=: 3 : 0
if. 0=#copybuffer do. return. end.
for_cp. copybuffer do.
  pastecontrol (cp{CLS),(cp{IDS),(cp{CPS),(<cp{CCS),(cp{STY)
end.
SELECT=: copybuffer=: (-#copybuffer){.i.#IDS
drawform''
bufsnap''
1
)
pastecontrol=: 3 : 0
'class id caption ccs sty'=. y.
if. 0 = #class do.
  info 'First select a class'
  0 return.
end.
if. 0 = #id do.
  id=. 'cc', class
end.
CCS=: CCS, 6 6 0 0 + ccs
IDS=: IDS, <id
CPS=: CPS, <caption
CLS=: CLS, <class
STY=: STY, <sty
drawform''
bufsnap''
1
)


boxtest=: 3 : 0
if. isempty CCS do. '' return. end.
bb=. 2 {. y.
be=. bb + 1 + 2 }. y.
bc=. 2 {."1 CCS
ec=. bc + 2 }."1 CCS
ndx=. I. *./"1 (bb <: "1 bc) ,. be >: "1 ec
ndx /: (ndx { CLS) = <'groupbox'
)
hittest=: 3 : 0
best=. ''
for_i. i.#CCS do.
  if. y. rtest i{CCS do.
    if. #best do.
      old=. 2{.best{CCS
      new=. 2{.i{CCS
      old=. +/y.-old
      new=. +/y.-new
      if. new<old do. best=. i end.
    else.
      best=. i
    end.
  end.
end.
, best
)
rtest=: 4 : 0
xy=. 2{.y.
wh=. xy+2}.y.
*./(x.>:xy),x.<:wh
)

WMENU=: 0 : 0
pc wmenu owner;
xywh 1 20 158 11;cc s0 static rightmove;cn "Definition: id caption _  shortcut _ tooltip _ statushelp";
xywh 0 33 253 150;cc menudef editm ws_vscroll rightmove bottommove;
xywh 170 3 40 12;cc apply button leftmove rightmove;cn "&Apply";
xywh 170 17 40 12;cc help button leftmove rightmove;cn "&Help";
xywh 211 3 40 12;cc ok button leftmove rightmove;cn "OK";
xywh 211 17 40 12;cc cancel button leftmove rightmove;cn "Cancel";
pas 0 0;pcenter;
rem form end;
)
wmenu_run=: 3 : 0
wd WMENU
wd 'pn "Menu - ',PID,'"'
selectmenu=: wd bind ('psel ',wd 'qhwndp')
wd 'set menudef *',getmenudef MNU
wd 'pshow;'
)
wmenu_apply_button=: 3 : 0
applymenudef ''
wd 'set menudef *',getmenudef MNU
wd 'setfocus menudef'
)
wmenu_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
wmenu_close=: 3 : 0
applymenudef ''
wd 'pclose'
)
wmenu_cancel_button=: 3 : 0
wd'pclose'
)
wmenu_ok_button=: wmenu_close
wmenu_cancel=: wmenu_cancel_button
applymenudef=: 3 : 0
new=. readmenudef menudef
if. MNU -: new do. return. end.
MNU=: new
drawform''
selectmenu ''
)
getmenudef=: 3 : 0
if. 0 = # y. do. '' return. end.
ind=. ''
r=. ''
mnu=. cutopen y.
mnu=. (mnu i.&> ';') {. each mnu
for_m. mnu do.
  m=. > m
  x=. m i. ' '
  select. x {. m
  case. 'menu' do.
    txt=. ' ', deb x }. m
    sep=. (txt = ' ') > ~:/\ txt = '"'
    'id cp sc tt sh'=. 5 {. (sep <;._1 txt) -. each '"'
    sel=. id,' ',cp,' _ ',sc,' _ ',tt,' _ ',sh
    sel=. (-. *./\. sel e. ' _') # sel
    r=. r, addLF ind, sel
  case. 'menupop' do.
    r=. r, addLF ind , (x }. m) -. ' "'
    ind=. ind, '  '
  case. 'menupopz' do.
    r=. r, addLF ind, '+'
    ind=. 2 }. ind
  case. 'menusep' do.
    r=. r, addLF ind, '-'
  case. do.
    info 'Unrecognized menu command: ',m
  end.
end.
r
)
readmenudef=: 3 : 0
def=. y.
if. 0 = # def do. '' return. end.
ind=. ''
r=. ''
mnu=. a: -.~ deb each cutopen def
for_m. mnu do.
  m=. > m
  if. '+' = {. m do.
    r=. r, <'menupopz'
  elseif. '-' = {. m do.
    r=. r, <'menusep'
  elseif. do.
    x=. m i. ' '
    id=. x {. m
    bal=. deb x }. m
    if. #bal do.
      bal=. 4 {. <;._1 '_', bal
      bal=. dblquote each deb each bal
      r=. r, <'menu ',id,' ',towords bal
    else.
      r=. r,<'menupop ',dblquote id
    end.
  end.
end.
; r ,each (<';',LF)
)

form_g_mbldbl=: 3 : 0
if. MOUSEIGNORE do. return. end.
if. ORDER do. return. end.
SELECT=: hittest mousepos''
if. #SELECT do.
  SELECT=: , {. SELECT
  drawform''
  if. ifctrlkey'' do.
    selectcode''
  else.
    wcontrol_run''
  end.
else.
  wparent_run''
end.
design_enable ''
)
form_g_mbldown=: 3 : 0
if. MOUSEIGNORE do. return. end.
if. ORDER do. order_select'' return. end.
pos=. mousepos''
tim=. sessiontime''
if. (DOWN -: pos) *. 0.5 > tim - MOUSETIME do.
  form_g_mbldbl'' return.
end.
MOUSETIME=: tim
DOWN=: pos
sel=. hittest DOWN
if. isempty sel do.
  SELECT=: $0
  capture CAPSELECT
else.
  if. ifctrlkey'' do.
    SELECT=: sel
    selectcode''
    return.
  end.
  if. #SELECT do.
    if. sel e. SELECT do.
      if. ifshiftkey'' do.
        SELECT=: SELECT -. sel
      else.
        SELECT=: SELECT /: SELECT ~: {. sel
      end.
    else.
      if. ifshiftkey'' do.
        SELECT=: SELECT, sel
      else.
        SELECT=: sel
      end.
    end.
  else.
    SELECT=: sel
  end.
  if. #SELECT do.
    cap=. (CURSOR=IDC_SIZENWSE) { CAPMOVE,CAPSIZE
    capture cap, ,SELECT { CCS
  end.
end.
design_enable ''
)
form_g_mblup=: 3 : 0
if. MOUSEIGNORE do. return. end.
if. ORDER do. return. end.
UP=: mousepos ''
dif=. UP - DOWN
cap=. CAPTURE
capture CAPNONE
select. cap
case. CAPNONE do.
case. CAPSELECT do.
  box=. (UP <. DOWN), | dif
  SELECT=: boxtest box
case. CAPMOVE do.
  c=. SELECT { CCS
  c=. c +"1 [ dif, 0 0
  CCS=: c SELECT } CCS
case. CAPSIZE do.
  c=. SELECT { CCS
  c=. c +"1 [ 0 0, dif
  CCS=: c SELECT } CCS
end.
drawform''
design_enable ''
bufsnap''
)
form_g_mmove=: 3 : 0
if. MOUSEIGNORE do. return. end.
if. ORDER do. return. end.
if. CAPTURE *. # SELECT do.
  pos=. mousepos''
  ccs=. ({.SELECT) { CCS
  select. CAPTURE
  case. CAPMOVE do.
    c=. ccs + (pos-DOWN), 0 0
  case. CAPSIZE do.
    c=. ccs + 0 0, pos-DOWN
  end.
  selectdesign''
  wd 'set pos *',": tocoords1 c
  wd 'setupdate pos'
  selectform''
  glsel 'g' 
  return.
end.
if. #SELECT do.
  hit=. mousepos ''
  c=. ({.SELECT) { CCS
  c=. _6 + (2{.c) + 2}.c
  if. hit rtest c,6 6 do.
    cursor IDC_SIZENWSE
  elseif. CURSOR = IDC_SIZENWSE do.
    cursor IDC_ARROW
  end.
end.
)

NEWCC=: 0 : 0
pc newcc nomax nomin nosize owner;pn "New Control";
xywh 4 6 171 143;cc g0 groupbox;cn "Class";
xywh 12 17 47 11;cc standard radiobutton;cn "Standard";
xywh 60 17 33 11;cc ocx radiobutton group;cn "OCX";
xywh 9 30 160 112;cc class listbox ws_vscroll;
xywh 180 13 31 11;cc s0 static;cn "Id:";
xywh 212 12 56 12;cc id edit;
xywh 180 26 31 11;cc label static;cn "Caption:";
xywh 212 25 56 12;cc caption edit es_autohscroll;
xywh 274 7 42 12;cc ok button;cn "OK";
xywh 274 19 42 12;cc cancel button;cn "Cancel";
xywh 274 35 42 12;cc apply button;cn "Apply";
xywh 274 49 42 12;cc help button;cn "Help";
pas 5 5;pcenter;
rem form end;
)
newcc_run=: 3 : 0
wd NEWCC
if. IFJAVA do.
  wd 'setenable ocx 0'
end.
selectnewcc=: wd bind ('psel ',wd 'qhwndp')
newcc_standard_button ''
wd 'pshow'
MOUSEIGNORE=: 1
)

toEAV=: [: ; (EAV&, @ (,&EAV)) each
newcc_standard_button=: 3 : 0
OCX=: 0
wd 'set standard 1'
wd 'set ocx 0'
wd 'setenable caption 1'
wd 'set class ', toEAV {."1 CONTROLS
)
newcc_ocx_button=: 3 : 0
OCX=: 1
getoleocx''
wd 'set standard 0'
wd 'set ocx 1'
wd 'set caption'
wd 'setenable caption 0'
wd 'set class ', toEAV {."1 OLEOCX
)
newcc_apply_button=: 3 : 0
if. 0 = #class do.
  info 'First select a class'
  0 return.
end.
if. 0 = #id do.
  id=. 'cc', class
end.
if. _2 = 4!:0 <id do.
  info 'Invalid control id: ',id
  0 return.
end.
if. 0 = #caption do.
  caption=. id
end.
if. OCX do.
  caption=. (({."1 OLEOCX) i. <class) pick {:"1 OLEOCX
  class=. 'ocx'
end.
ndx=. ({."1 CONTROLS) i. <class
siz=. ((<ndx;4) pick CONTROLS) { FORMSIZES
CCS=: CCS, 0 0,siz
IDS=: IDS, <id
CPS=: CPS, <caption
CLS=: CLS, <class
STY=: STY, <''
drawform ''
bufsnap''
1
)
newcc_cancel=: 3 : 0
MOUSEIGNORE=: 0
wd 'pclose'
)
newcc_close=: 3 : 0
if. newcc_apply_button'' do.
  selectnewcc''
  newcc_cancel''
end.
)
newcc_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
newcc_ok_button=: newcc_close
newcc_cancel_button=: newcc_cancel

NEWFORM=: 0 : 0
pc newform nomax nomin nosize owner;pn "Form Edit - Id";
xywh 120 7 40 12;cc ok button;cn "OK";
xywh 120 21 40 12;cc cancel button;cn "Cancel";
xywh 8 10 38 10;cc label static;cn "Form Id:";
xywh 52 10 60 12;cc formid edit ws_border es_autohscroll;
xywh 8 25 38 10;cc label static;cn "Form Type:";
xywh 52 25 60 42;cc formtype listbox ws_vscroll;
pas 4 2;pcenter;
rem form end;
)
newform_run=: 3 : 0
frm=. {."1 [ 1!:0 jpath '~system\packages\forms\*.ijs'
wd NEWFORM
NEWFORMHWNDP=: wd 'qhwndp'
wd 'set formtype ', ; frm ,each LF
wd 'setfocus formid'
wd 'pshow;'
)
newform_ok_button=: 3 : 0
if. 0 = #formid do.
  info 'First enter the Form Id'
  wd 'setfocus formid'
  return.
end.
if. 0 = #formtype do.
  info 'First select the Form Type'
  wd 'setfocus formtype'
  return.
end.
dat=. flreads jpath '~system\packages\forms\',formtype
ndx=. 1 i.~ (LF,'pc ') E. dat
j=. (ndx + 4) }. dat
formname=. deb (j i. ';') {. j
if. formid -: toupper formid do.
  formid=. tolower formid
end.
dat=. dat rplc ('pc ',formname) ; 'pc ',formid
dat=. dat rplc (toupper formname) ; toupper formid
dat=. dat rplc (formname,'_') ; formid,'_'
txt=. flreads FNAME
if. #txt do.
  dat=. txt, LF, dat
end.
fdata=. file_read1 dat
nms=. a: -.~ {."1 fdata
newform_close ''
smopen FNAME
smwrite dat
openform _1 pick nms
)
newform_close=: 3 : 0
wd 'psel ',NEWFORMHWNDP
wd 'pclose'
)
newform_cancel=: newform_cancel_button=: newform_close
newform=: newform_run
newform_enter=: newform_ok_button

order=: 3 : 0
if. 0 = #CCS do.
  ORDER=: 0
else.
  ORDER=: -. ORDER
end.
SELECT=: $0
drawform ''
)
order_select=: 3 : 0
sel=. hittest mousepos ''
if. isempty sel do. return. end.
msk=. (i.#CCS) ~: {. sel
if. ifctrlkey'' do.
  sortccs /: msk
  SELECT=: ,0
elseif. (#SELECT) *. ifshiftkey'' do.
  if. sel -: SELECT do. return. end.
  if. SELECT = <: #CCS do. return. end.
  new=. {. SELECT + 1
  sortccs /: (i.new), new + new }. msk
  SELECT=: , new
elseif. 1 do. return.
end.
drawform ''
)
sortccs=: 3 : 0
ndx=. y.
CCS=: ndx { CCS
CLS=: ndx { CLS
CPS=: ndx { CPS
IDS=: ndx { IDS
STY=: ndx { STY
SELECT=: ndx i. SELECT
)

WPARENT=: 0 : 0
pc wparent owner;pn "Parent";
xywh 5 10 31 12;cc label static;cn "Id:";
xywh 38 10 69 11;cc id static rightmove;
xywh 5 25 31 12;cc label static;cn "Caption:";
xywh 38 24 69 12;cc caption edit ws_border es_autohscroll;
xywh 5 43 40 11;cc label static;cn "Styles:";
xywh 4 54 60 89;cc styles listbox lbs_multiplesel rightscale;
xywh 68 43 40 11;cc label static leftmove rightmove;cn "Options:";
xywh 67 54 60 89;cc options listbox lbs_multiplesel leftscale rightscale;
xywh 111 10 51 11;cc label static;cn "Right margin:";
xywh 111 25 51 11;cc label static;cn "Bottom margin:";
xywh 164 10 25 80;cc rmargin combodrop ws_vscroll;
xywh 164 24 25 80;cc bmargin combodrop ws_vscroll;
xywh 143 50 36 12;cc bpmove button leftmove rightmove;cn "pmove";
xywh 138 63 45 13;cc pmove static ss_center leftmove rightmove;
xywh 196 10 36 12;cc ok button leftmove rightmove;cn "OK";
xywh 196 26 36 12;cc cancel button leftmove rightmove;cn "Cancel";
xywh 196 50 36 12;cc apply button leftmove rightmove;cn "&Apply";
xywh 196 65 36 12;cc help button leftmove rightmove;cn "&Help";
pas 3 3;pcenter;ptop;
rem form end;
)
wparent_run=: 3 : 0
sty=. 'closeok dialog nomax nomenu nomin nosize owner'
opt=. 'pcenter ptop'
Wpmv=: PMV
wd WPARENT
selectparent=: wd bind ('psel ',wd 'qhwndp')
wd 'set styles ',sty
for_n. I. (;:sty) e. ;: PST do.
  wd 'setselect styles ',":n
end.
wd 'set options ',opt
for_n. I. (;:opt) e. POP do.
  wd 'setselect options ',":n
end.
wd 'setcaption id *',PID
wd 'set caption *',PCN
wd 'set rmargin ',": i.21
wd 'setselect rmargin ',": 0 { PAS
wd 'set bmargin ',": i.21
wd 'setselect bmargin ',": 1 { PAS
wd 'setcaption pmove *',":Wpmv
wd 'pshow;'
MOUSEIGNORE=: 1
)
wparent_apply_button=: 3 : 0
wparent_read''
drawform ''
)
wparent_bpmove_button=: 3 : 0
if. #Wpmv do.
  Wpmv=: ''
else.
  selectform''
  Wpmv=: roundint (0 ". wd 'qformx') % GSCALE
end.
selectparent''
wd 'setcaption pmove *',": Wpmv
)
wparent_close=: 3 : 0
wparent_read ''
wparent_cancel ''
selectform''
cap=. (*#PCN) pick PID;PCN
wd 'pn "',cap,'"'
)
wparent_cancel=: 3 : 0
MOUSEIGNORE=: 0
wd 'pclose'
)
wparent_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
wparent_cancel_button=: wparent_cancel
wparent_ok_button=: wparent_close
wparent_read=: 3 : 0
PAS=: (0 ". rmargin), 0 ". bmargin
PCN=: caption
PMV=: Wpmv
POP=: cutopen options
PST=: towords cutopen styles
)

WSELECT=: 0 : 0
pc wselect nomax nomenu nosize owner;
xywh 4 5 72 58;cc slist listbox ws_vscroll;
xywh 84 6 36 12;cc ok button bs_defpushbutton;cn "OK";
xywh 84 20 36 12;cc cancel button;cn "Cancel";
xywh 84 36 36 12;cc new button;cn "New...";
pas 4 4;pcenter;
rem form end;
)
wselect_run=: 3 : 0
wd WSELECT
wd 'set slist ', ; y. ,each LF
wd 'setselect slist 0'
wd 'pshow'
)
wselect_new_button=: 3 : 0
wd 'pclose'
newform''
)
wselect_ok_button=: 3 : 0
wd 'pclose'
openform slist
)
wselect_cancel=: 3 : 0
wd 'pclose'
destroy''
)
wselect_cancel_button=: wselect_close=: wselect_cancel
wselect_slist_button=: wselect_enter=: wselect_ok_button
pickform=: wselect_run

WSTATUS=: 0 : 0
pc wstatus nosize owner;
xywh 1 20 128 9;cc s0 static;cn "Definition: id width text";
xywh 0 31 200 100;cc statusdef editm ws_vscroll;
xywh 140 3 36 12;cc apply button;cn "&Apply";
xywh 140 17 36 12;cc help button;cn "&Help";
xywh 171 3 36 12;cc ok button;cn "OK";
xywh 171 17 36 12;cc cancel button;cn "Cancel";
pas 0 0;pcenter;
rem form end;
)
wstatus_run=: 3 : 0
wd WSTATUS
wd 'pn "Status - ',PID,'"'
selectstatus=: wd bind ('psel ',wd 'qhwndp')
wd 'set statusdef *',getstatusdef SBR
wd 'pshow;'
)
wstatus_apply_button=: 3 : 0
applystatusdef ''
wd 'set statusdef *',getstatusdef SBR
wd 'setfocus statusdef'
)
wstatus_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
wstatus_close=: 3 : 0
applystatusdef ''
wd 'pclose'
)
wstatus_cancel_button=: 3 : 0
wd 'pclose'
)
wstatus_ok_button=: wstatus_close
wstatus_cancel=: wstatus_cancel_button
applystatusdef=: 3 : 0
new=. readstatusdef statusdef
if. SBR -: new do. return. end.
SBR=: new
drawform''
selectstatus ''
)
getstatusdef=: 3 : 0
r=. ''
if. 0 = # y. do. return. end.
sbr=. cutopen y.
sbr=. deb each (sbr i.&> ';') {. each sbr
msk=. (<'sbarset') = 7 {. each sbr
sbr=. 7 }. each msk # sbr
for_s. sbr do.
  txt=. > s
  sep=. (txt = ' ') > ~:/\ txt = '"'
  'id wd tx'=. 3 {. (sep <;._1 txt) -. each '"'
  wd=. ": {. 0 ". wd
  r=. r, addLF id,' ',wd,' ',tx
end.
r
)
readstatusdef=: 3 : 0
sbr=. a: -.~ deb each LF cutopen y.
r=. ''
if. 0 = # sbr do. return. end.
r=. <'sbar ',": # sbr
for_s. sbr do.
  txt=. > s
  x=. txt i. ' '
  id=. x {. txt
  txt=. (x + 1) }. txt
  x=. txt i. ' '
  wd=. ": {. 0 ". x {. txt
  txt=. (x + 1) }. txt
  r=. r , <'sbarset ',id,' ',wd,' "',txt,'"'
end.
r=. r, <'sbarshow'
; r ,each (<';',LF)
)

WTBAR=: 0 : 0
pc wtbar owner;
xywh 0 0 270 15;cc tbbmp isigraph rightmove;
xywh 0 16 270 12;cc tbids isigraph rightmove;
xywh 4 31 36 12;cc tbfile button;cn "File...";
xywh 42 32 218 11;cc tbname static;cn "";
xywh 4 46 89 11;cc tbflat checkbox;cn "Flat Toolbar (Jwdw)";
xywh 4 66 175 11;cc sdef static;cn "";
xywh 0 79 270 150;cc toolbardef editm es_autovscroll rightmove bottommove;
xywh 192 50 36 12;cc apply button leftmove rightmove;cn "&Apply";
xywh 192 64 36 12;cc help button leftmove rightmove;cn "&Help";
xywh 230 50 36 12;cc ok button leftmove rightmove;cn "OK";
xywh 230 64 36 12;cc cancel button leftmove rightmove;cn "Cancel";
pas 0 0;pcenter;
rem form end;
)
wtbar_run=: 3 : 0
rerun=. 1 = {. y.
if. rerun do.
  xywh=. wd 'qformx'
  wd 'psel wtbar;pclose'
end.
wd WTBAR
wd 'pn "Toolbar - ',PID,'"'
selecttoolbar=: wd bind ('psel ',wd 'qhwndp')
wd 'setcaption sdef *Definition: id  index  tooltip  _  statushelp'
wtbar_showdef''
glshow''
if. rerun do.
  wd 'pmovex ',xywh
end.
wd 'pshow;'
)
wtbar_showdef=: 3 : 0
'f s d'=. gettoolbardef TBR
if. # f do.
  TBFN=: f
end.
TBDS=: s
TBDF=: d
wtbar_showtoolbar''
)
wtbar_showtoolbar=: 3 : 0
try.
  dat=. 1!:1 < TBFN
catch.
  wdinfo 'Toolbar';'file read error: ',":>TBFN return.
end.
if. -. '.bmp' -: tolower _4 {. TBFN do.
  msg=. 'The Form Editor only supports bitmap toolbar files with extension .bmp.'
  wdinfo 'Toolbar';msg return.
end.

bits=. 0 pick getbmphdr dat
if. -. bits e. 4 8 24 do.
  wdinfo 'Toolbar';'Only 4, 8 or 24 bit bitmaps supported by Toolbar' return.
end.
BMP=: readbmp TBFN
'rws cls'=. $ BMP
cnt=. cls % 16
if. cnt ~: <.cnt do.
  wdinfo 'Toolbar';'Bitmaps should have a width of 16 pixels' return.
end.

wtbar_showbar''
wd 'set tbflat ',":1 e. 'tbstyle_flat' E. TBDS
wd 'setcaption tbname *',TBFN
wd 'set toolbardef *',TBDF
wd 'pas 0 0'
)
wtbar_showbar=: 3 : 0

'rws cls'=. $ BMP
cnt=. cls % 16
wh=. _2 {. 0 ". wd 'qchildxywhx tbbmp'
scl=. <./ wh % cls,rws
'w h'=. <. scl * cls,rws
exp=. (- 0: , }:) <. 0.5 + +/\ rws $ h % rws
bmp=. exp # BMP
exp=. (- 0: , }:) <. 0.5 + +/\ cls $ w % cls
bmp=. exp #"1 bmp

glsel 'tbbmp'
glclear''
glwantresize ''
glbkmode 1
glnoerasebkgnd 1
glmap MM_RAW
glrgb 0 ". wd 'qcolor 15'
glpen 0 0
glbrush''
glrect 0 0,wh
glpixels (0 0, |.$bmp), ,bmp
glshow''
wh=. _2 {. 0 ". wd 'qchildxywhx tbids'
glsel 'tbids'
glclear''
glmap MM_RAW
glbkmode 1
glrgb 0 ". wd 'qcolor 15'
glpen 0 0
glbrush''
glrect 0 0,wh
glrgb 0 0 0
glfont GFONT
gltextalign TA_CENTER
pos=. <. (({.scl) * 8 + 16 * i. cnt) ,. 2
for_i. i. cnt do.
  gltextxy i { pos
  gltext ": i
end.
glshow''

)
getbmphdr=: 3 : 0
toi=. 256&#.@(a.&i.)@(|."1)
dat=. y.
bits=. toi 28 29 {dat
if. toi 30 31 32 33{dat do.
  wdinfo 'Toolbar';'Compressed format not supported'
  0 return.
end.
'off shdr cls rws'=. toi (10+i.4 4){dat
bits,rws,cls
)
wtbar_apply_button=: 3 : 0
applytoolbardef ''
wtbar_showdef''
wd 'setfocus toolbardef'
)
wtbar_help_button=: 3 : 0
htmlhelp_j_ 'user\form_editor_overview.htm'
)
wtbar_close=: 3 : 0
applytoolbardef ''
wd 'pclose'
)
wtbar_cancel_button=: 3 : 0
wd'pclose'
)
wtbar_tbfile_button=: 3 : 0
while. 1 do.
  j=. '"Bitmap Files(*.bmp)|*.bmp" ofn_filemustexist ofn_nochangedir'
  d=. jpath '~system'
  f=. wd 'mbopen "Select Bitmap File" "',d,'" "" ',j
  break.
end.
if. isempty f do. return. end.
if. TBFN -: f do. return. end.
TBFN=: f
TBR=: readtoolbardef TBFN;TBDS;toolbardef
wtbar_run 1
)
wtbar_tbflat_button=: 3 : 0
TBDS=: ('1'={. tbflat) # 'tbstyle_flat'
)
wtbar_ok_button=: wtbar_close
wtbar_cancel=: wtbar_cancel_button
wtbar_tbbmp_size=: wtbar_showbar
applytoolbardef=: 3 : 0
TBR=: readtoolbardef TBFN;TBDS;toolbardef
drawform''
selecttoolbar ''
)
gettoolbardef=: 3 : 0
if. 0 = # y. do. 3 $ <'' return. end.
ind=. ''
txt=. ''
tbr=. cutopen y.
tbr=. (tbr i.&> ';') {. each tbr
tbr=. deb each tbr
tbr=. (0 < # &> tbr) # tbr
sty=. ''
for_m. tbr do.
  m=. > m
  x=. m i. ' '
  select. x {. m
  case. 'tbar' do.
    val=. deb 5 }. m
    if. '"' = {.val do.
      val=. }. val
      ndx=. val i. '"'
    else.
      ndx=. val i. ' '
    end.
    file=. ndx {. val
    val=. deb (ndx + 1) }. val
    sty=. deb (val i. ' ') }. val
  case. 'tbarset' do.
    sel=. ' ', deb x }. m
    sep=. (sel = ' ') > ~:/\ sel = '"'
    'id cp sc tt sh'=. 5 {. (sep <;._1 sel) -. each '"'
    if. #id do.
      txt=. txt, addLF id,'  ',sc,'  ',tt,'  _  ',sh
    else.
      txt=. txt, addLF sc
    end.
  case. 'tbarshow' do.
  case. do.
    info 'Unrecognized toolbar command: ',m
  end.
end.
file;sty;txt
)
readtoolbardef=: 3 : 0
'file sty txt'=. y.
if. 0 = # txt do. '' return. end.
tbr=. a: -.~ deb each <;._2 txt,LF
if. #sty do.
  sty=. ' ',(":#tbr),' ',sty
end.
r=. <'tbar ',(addDQuote deb file),sty
for_m. tbr do.
  ind=. ": m_index
  m=. > m
  x=. m i. ' '
  id=. x {. m
  if. _1 ~: _1 ". id do.
    r=. r, <'tbarset "" ',ind, ' ',id
  else.
    m=. deb x }. m
    x=. m i. ' '
    cp=. x {. m
    m=. deb x }. m
    x=. m i. '_'
    tt=. addDQuote deb x {. m
    sh=. addDQuote deb (1 + x) }. m
    r=. r, < 'tbarset', ; ' ',each id;ind;cp;tt;sh
  end.
end.
r=. r , <'tbarshow'
; r ,each (<';',LF)
)