Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE FORMOBJECT.F, 1.5, 1.6
|
From: Ezra B. <ezr...@us...> - 2009-04-10 16:44:43
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv16590/apps/Win32ForthIDE Modified Files: FORMOBJECT.F Log Message: IDE Enhancements. Bug Fixes. Doc Updates. Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMOBJECT.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** FORMOBJECT.F 16 Sep 2008 05:16:36 -0000 1.5 --- FORMOBJECT.F 10 Apr 2009 16:44:39 -0000 1.6 *************** *** 27,31 **** MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; MenuSeparator ! MenuItem "Add/Edit Code" IDM_FORM_ADDCODE DoCommand ; MenuItem "Change Tab Order" IDM_FORM_TabOrder DoCommand ; MenuItem "Add To Project" ActiveForm IDM_FORM_AddToProject DoCommand ; --- 27,31 ---- MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; MenuSeparator ! MenuItem "Add/Edit Code" ShowCodeEditorTab ; MenuItem "Change Tab Order" IDM_FORM_TabOrder DoCommand ; MenuItem "Add To Project" ActiveForm IDM_FORM_AddToProject DoCommand ; *************** *** 52,56 **** MenuItem "Delete" DeleteControl ; \ delete control! MenuItem "Change type" ChangeControl ; ! MenuItem "Add/Edit Code" IDM_FORM_ADDCODE DoCommand ; MenuSeparator :MenuItem mnu_font "Change Font" ChangeControlFont ; --- 52,56 ---- MenuItem "Delete" DeleteControl ; \ delete control! MenuItem "Change type" ChangeControl ; ! MenuItem "Add/Edit Code" ShowCodeEditorTab ; MenuSeparator :MenuItem mnu_font "Change Font" ChangeControlFont ; *************** *** 109,114 **** int LocalCode int OnInitCode ! \ int LocalCursorPos ! \ int GlobalCursorPos 32 constant array-size \ holds count of each control type created for naming --- 109,115 ---- int LocalCode int OnInitCode ! int LocalCursorPos ! int GlobalCursorPos ! int OnInitCursorPos 32 constant array-size \ holds count of each control type created for naming *************** *** 233,258 **** (AddNewControl) ; - - : fonttype? ( ctrltype -- f ) - dup 0= ?exit - | TypePushbutton - TypeGroupBox - TypeCheckBox - TypeRadioButton - TypeLabel - TypeTextBox - TypeMultiLineBox - TypeListBox - TypeComboBox - TypeComboListBox - TypeMultiListBox - TypeGeneric \ in case we just want a font - |if true - else false - then ; - : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup ! if GetType: [ ] fonttype? then dup Enable: mnu_font Enable: mnu_dfont ; --- 234,240 ---- (AddNewControl) ; : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup ! if GetType: [ ] font-type? then dup Enable: mnu_font Enable: mnu_dfont ; *************** *** 1040,1058 **** max-codesize malloc to OnInitCode OnInitCode max-codesize erase ! \ 0 to LocalCursorPos ! \ 0 to GlobalCursorPos ; ! \ :M GetLocalCursorPos: ( -- n ) ! \ localcursorpos ;M ! \ ! \ :M SetLocalCursorPos: ( n -- ) ! \ to localcursorpos ;M ! \ ! \ :M GetGlobalCursorPos: ( -- n ) ! \ globalcursorpos ;M ! \ ! \ :M SetGlobalCursorPos: ( n -- ) ! \ to globalcursorpos ;M :M GlobalCode: ( -- addr ) --- 1022,1047 ---- max-codesize malloc to OnInitCode OnInitCode max-codesize erase ! 0 to LocalCursorPos ! 0 to GlobalCursorPos ! 0 to OnInitCursorPos ; ! :M GetLocalCursorPos: ( -- n ) ! localcursorpos ;M ! ! :M SetLocalCursorPos: ( n -- ) ! to localcursorpos ;M ! ! :M GetGlobalCursorPos: ( -- n ) ! globalcursorpos ;M ! ! :M SetGlobalCursorPos: ( n -- ) ! to globalcursorpos ;M ! ! :M GetOnInitCursorPos: ( -- n ) ! oninitcursorpos ;M ! ! :M SetOnInitCursorPos: ( n -- ) ! to oninitcursorpos ;M :M GlobalCode: ( -- addr ) *************** *** 1080,1086 **** :M Init: ( -- ) - ?init-position to frmYPos to frmXPos 350 to frmWidth 200 to frmHeight 0 to controlcount s" Form" frmTitle place --- 1069,1075 ---- :M Init: ( -- ) 350 to frmWidth 200 to frmHeight + ?init-position to frmYPos to frmXPos 0 to controlcount s" Form" frmTitle place *************** *** 1145,1149 **** Update: self else SetFocus: self ! then AutoProperty? if IDM_FORM_FORMPROPERTY DoCommand then ;M --- 1134,1138 ---- Update: self else SetFocus: self ! then AutoProperty? if IDM_FORM_FORMPROPERTY DoCommand then ;M *************** *** 1220,1224 **** NoActiveControl Paint: self ! modified ;M :M ChangeControl: ( -- ) --- 1209,1214 ---- NoActiveControl Paint: self ! modified ! doUpdate ;M :M ChangeControl: ( -- ) *************** *** 1247,1251 **** r> >Link#: ControlList \ as we were ThisControl IsActiveControl ! ShowHandles modified ;M :M MoveToFront: ( -- ) \ position control in list so it will be found first --- 1237,1242 ---- r> >Link#: ControlList \ as we were ThisControl IsActiveControl ! ShowHandles modified ! doUpdate ;M :M MoveToFront: ( -- ) \ position control in list so it will be found first *************** *** 1368,1372 **** Close: FormFile ; ! : ReadCodeFIle ( -- ) code-filename file-status nip ?exit code-filename LoadFile: FormFile 0= ?exit --- 1359,1363 ---- Close: FormFile ; ! : ReadCodeFile ( -- ) code-filename file-status nip ?exit code-filename LoadFile: FormFile 0= ?exit *************** *** 1384,1390 **** 2dup ControlCode: ThisControl swap cmove + lcount ! loop 2drop ReleaseBuffer: FormFile else drop true s" Incompatible code file!" ?MessageBox \ msg for now ! then ; : SaveForm ( -- ) --- 1375,1381 ---- 2dup ControlCode: ThisControl swap cmove + lcount ! loop 2drop else drop true s" Incompatible code file!" ?MessageBox \ msg for now ! then ReleaseBuffer: FormFile ; : SaveForm ( -- ) *************** *** 1400,1404 **** #controls SetCount: self GetData: self Write: FormFile \ save header first ! if Close: FormFile exit \ exit if error then #Controls 1+ 1 ?do i SetThisControl --- 1391,1395 ---- #controls SetCount: self GetData: self Write: FormFile \ save header first ! if Close: FormFile exit \ exit if errorl then #Controls 1+ 1 ?do i SetThisControl *************** *** 1514,1517 **** --- 1505,1512 ---- ;M + :M Modified?: ( -- f ) + modified? + ;M + :M FormName: ( -- addr ) frmName *************** *** 1587,1591 **** : writecommoncode ( -- ) \ startup code common to all controls ! +crlf 2tabs s" self Start: " append GetName: ThisControl append&crlf 2tabs Origin: ThisControl swap #append #append --- 1582,1589 ---- : writecommoncode ( -- ) \ startup code common to all controls ! ID: ThisControl check-id ?dup ! if +crlf ! 2tabs GetId$ append s" SetID: " append GetName: ThisControl append ! then +crlf 2tabs s" self Start: " append GetName: ThisControl append&crlf 2tabs Origin: ThisControl swap #append #append *************** *** 1696,1700 **** ThisControl code-type? ThisControl have-code? and if +crlf ! s" : " append function-name append s" ( h m w l -- )" append&crlf ControlCode: ThisControl zcount append&crlf s" ; " append&crlf --- 1694,1699 ---- ThisControl code-type? ThisControl have-code? and if +crlf ! s" : " append function-name append s" ( h m w l -- )" append ! s" \ what to do when " append GetName: ThisControl append s" control has been clicked" append&crlf ControlCode: ThisControl zcount append&crlf s" ; " append&crlf *************** *** 1712,1717 **** ThisControl code-type? ThisControl have-code? and if 2tabs 4 +spaces ! s" GetID: " append GetName: ThisControl 20 append.l ! s" of " append function-name 20 append.l s" endof" append&crlf --- 1711,1718 ---- ThisControl code-type? ThisControl have-code? and if 2tabs 4 +spaces ! ID: ThisControl check-id ?dup ! if GetID$ 27 append.l ! else s" GetID: " append GetName: ThisControl 20 append.l ! then s" of " append function-name 20 append.l s" endof" append&crlf *************** *** 1722,1726 **** OnInitCode zcount -trailing ?dup if +crlf ! s" : OnInitFunction ( -- )" append&crlf append&crlf s" ; " append&crlf +crlf --- 1723,1727 ---- OnInitCode zcount -trailing ?dup if +crlf ! s" : OnInitFunction ( -- ) \ executed after form and all controls have been created" append&crlf append&crlf s" ; " append&crlf +crlf |
