Menu
▾
▴
[Win32forth-cvs] win32forth/apps/ForthForm FORMOBJECT.F,1.9,1.10 FORTHFORM.F,1.12,1.13
|
From: Dirk B. <db...@us...> - 2006-02-01 17:08:40
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17632/apps/ForthForm Modified Files: FORMOBJECT.F FORTHFORM.F Log Message: - New GroupRadioButton class added; and changed ForthForm to use this class. - Some more dexing Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** FORTHFORM.F 11 Jan 2006 17:45:19 -0000 1.12 --- FORTHFORM.F 1 Feb 2006 17:08:24 -0000 1.13 *************** *** 96,103 **** \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance File MergeFile ! File TheFile \ adapted from WinEd ! 20205 constant fform_version# \ 2.02.05 \ Version numbers: v.ww.rr --- 96,103 ---- \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance File MergeFile ! File TheFile \ adapted from WinEd ! 20206 constant fform_version# \ 2.02.06 \ Version numbers: v.ww.rr *************** *** 116,120 **** : ExitOnError ( f -- ) S" A serious error has occurred in ForthForm!" ?TerminateBox ; ! macro ?abort " if abort then" --- 116,120 ---- : ExitOnError ( f -- ) S" A serious error has occurred in ForthForm!" ?TerminateBox ; ! macro ?abort " if abort then" *************** *** 253,257 **** ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! : ChangeControlFont ( -- ) ActiveForm 0= ?exit --- 253,257 ---- ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! : ChangeControlFont ( -- ) ActiveForm 0= ?exit *************** *** 260,264 **** IsModified: ActiveForm then ; ! : ResetControlFont ( -- ) ActiveForm 0= ?exit --- 260,264 ---- IsModified: ActiveForm then ; ! : ResetControlFont ( -- ) ActiveForm 0= ?exit *************** *** 267,271 **** IsModified: ActiveForm then ; ! : #Forms ( -- n ) \ return number of open forms FormList --- 267,271 ---- IsModified: ActiveForm then ; ! : #Forms ( -- n ) \ return number of open forms FormList *************** *** 468,472 **** loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then then ; --- 468,472 ---- loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then then ; *************** *** 549,555 **** Close: TheFile fsize frmdata-size < ?dup ?exit \ must have at least a form header ! fsize frmdata-size - ctrldata-size mod 0<> \ must be evenly divisible ; ! :NoName ( -- ) \ _NewForm AddNewForm --- 549,555 ---- Close: TheFile fsize frmdata-size < ?dup ?exit \ must have at least a form header ! fsize frmdata-size - ctrldata-size mod 0<> \ must be evenly divisible ; ! :NoName ( -- ) \ _NewForm AddNewForm *************** *** 574,578 **** Start: ThisForm fname fcnt SetFileName: ThisForm ! Load: ThisForm Display: ThisForm doupdate ; is (OpenForm) --- 574,578 ---- Start: ThisForm fname fcnt SetFileName: ThisForm ! Load: ThisForm Display: ThisForm doupdate ; is (OpenForm) *************** *** 618,622 **** ActiveForm 0= ?exit s" anew _frm" evaluate ! ChildState: ActiveForm >r \ we want to see the form if it is a child, so we false IsChildState: Activeform \ save the state and change in case it is hidden GetBuffer: ActiveForm 2drop --- 618,622 ---- ActiveForm 0= ?exit s" anew _frm" evaluate ! ChildState: ActiveForm >r \ we want to see the form if it is a child, so we false IsChildState: Activeform \ save the state and change in case it is hidden GetBuffer: ActiveForm 2drop *************** *** 760,764 **** InitScintillaControl \ for the editor ;M ! :M Canvas: ( -- x y w h ) 0 Height: TheRebar dup>r ( -- x y ) --- 760,764 ---- InitScintillaControl \ for the editor ;M ! :M Canvas: ( -- x y w h ) 0 Height: TheRebar dup>r ( -- x y ) *************** *** 993,997 **** ActiveControl: Activeform if UpdatePropertyWindow ! then then UpdateFormPicker #Forms 2 < --- 993,997 ---- ActiveControl: Activeform if UpdatePropertyWindow ! then then UpdateFormPicker #Forms 2 < *************** *** 1048,1052 **** then then ; ! : FForm ( -- ) init-msg-buffer --- 1048,1052 ---- then then ; ! : FForm ( -- ) init-msg-buffer Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** FORMOBJECT.F 4 Nov 2005 06:40:15 -0000 1.9 --- FORMOBJECT.F 1 Feb 2006 17:08:24 -0000 1.10 *************** *** 170,174 **** <object> 0= ControlList 0= or if false exit ! then >FirstLink: ControlList #controls 1+ 1 ?do Data@: ControlList <object> = --- 170,174 ---- <object> 0= ControlList 0= or if false exit ! then >FirstLink: ControlList #controls 1+ 1 ?do Data@: ControlList <object> = *************** *** 198,202 **** else false then ; ! : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup --- 198,202 ---- else false then ; ! : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup *************** *** 456,460 **** UpdateStatus: self UpdatePropertyWindow Paint: self ;M ! create spad 100 allot \ temporary sort pad, 24 controls maximum at a time --- 456,460 ---- UpdateStatus: self UpdatePropertyWindow Paint: self ;M ! create spad 100 allot \ temporary sort pad, 24 controls maximum at a time *************** *** 735,742 **** else DrawNormal: FormBox then release-dc ; ! : drawbox ( -- ) 0 (drawbox) ; ! : drawdottedbox ( -- ) 1 (drawbox) ; --- 735,742 ---- else DrawNormal: FormBox then release-dc ; ! : drawbox ( -- ) 0 (drawbox) ; ! : drawdottedbox ( -- ) 1 (drawbox) ; *************** *** 875,885 **** b t - to h \ height w 0< ! if w +to l then h 0< ! if h +to t then l w abs + to r t h abs + to b l t r b SetRect: FormBox ; ! : unclicked ( -- ) hwnd Call ReleaseCapture drop --- 875,885 ---- b t - to h \ height w 0< ! if w +to l then h 0< ! if h +to t then l w abs + to r t h abs + to b l t r b SetRect: FormBox ; ! : unclicked ( -- ) hwnd Call ReleaseCapture drop *************** *** 1147,1151 **** ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >LastLink: ControlList Link#: ControlList over = if drop exitm then \ already in front --- 1147,1151 ---- ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >LastLink: ControlList Link#: ControlList over = if drop exitm then \ already in front *************** *** 1161,1165 **** ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >FirstLink: ControlList Link#: ControlList over = if drop exitm then \ already at back --- 1161,1165 ---- ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >FirstLink: ControlList Link#: ControlList over = if drop exitm then \ already at back *************** *** 1399,1402 **** --- 1399,1409 ---- \ ****************** Definitions to write form information ******************** + : writeGroupStyle ( -- ) \ write WS_GROUP style if needed + Group?: ThisControl + GetType: ThisControl TypeRadioButton <> and + if +crlf 2tabs s" WS_GROUP +Style: " append + GetName: ThisControl append + then ; + : writecommoncode ( -- ) \ startup code common to all controls +crlf *************** *** 1405,1412 **** Dimensions: ThisControl swap #append #append s" Move: " append GetName: ThisControl append ! Group?: ThisControl ! if +crlf 2tabs s" WS_GROUP +Style: " append ! GetName: ThisControl append ! then ; : writetext ( -- ) \ code to set the text of control --- 1412,1417 ---- Dimensions: ThisControl swap #append #append s" Move: " append GetName: ThisControl append ! ! writeGroupStyle ; : writetext ( -- ) \ code to set the text of control *************** *** 1418,1425 **** +crlf 2tabs append s" +Style: " append GetName: ThisControl append ; ! : fontname ( -- name cnt ) GetName: ThisControl pad place s" -font" pad +place pad count ; ! : writefont ( -- ) +crlf 2tabs --- 1423,1430 ---- +crlf 2tabs append s" +Style: " append GetName: ThisControl append ; ! : fontname ( -- name cnt ) GetName: ThisControl pad place s" -font" pad +place pad count ; ! : writefont ( -- ) +crlf 2tabs *************** *** 1430,1434 **** else s" Handle: Winfont SetFont: " append GetName: ThisControl append then ; ! : write-fontfuncs ( -- ) \ create a definition for each font to be changed #controls 0= ?exit --- 1435,1439 ---- else s" Handle: Winfont SetFont: " append GetName: ThisControl append then ; ! : write-fontfuncs ( -- ) \ create a definition for each font to be changed #controls 0= ?exit *************** *** 1459,1463 **** then loop ; ! : write-delete-fonts ( -- ) #controls 0= ?exit --- 1464,1468 ---- then loop ; ! : write-delete-fonts ( -- ) #controls 0= ?exit *************** *** 1570,1574 **** TypePushButton of s" PushButton " endof TypeCheckBox of s" CheckBox " endof ! TypeRadioButton of s" RadioButton " endof TypeBitmapButton of s" BitmapButton " endof TypeListBox of s" ListBox " endof --- 1575,1579 ---- TypePushButton of s" PushButton " endof TypeCheckBox of s" CheckBox " endof ! TypeRadioButton of Group?: ThisControl if s" GroupRadioButton " else s" RadioButton " then endof TypeBitmapButton of s" BitmapButton " endof TypeListBox of s" ListBox " endof *************** *** 1952,1956 **** TheBuffer ;M ! :M UninitedBuffer: ( -- addr len ) WriteToBuffer TheBuffer ;M --- 1957,1961 ---- TheBuffer ;M ! :M UninitedBuffer: ( -- addr len ) WriteToBuffer TheBuffer ;M |
