Menu
▾
▴
[Win32forth-cvs] win32forth/apps/ForthForm CreatePropertyForm.f,NONE,1.1 CreatePropertyForm.ff,NONE,1.1 EXFONT.F,NONE,1.1 CONTROLPROPERTYII.ff,1.2,1.3 CreateToolBar.f,1.3,1.4 FORMCONTROLS.F,1.3,1.4 FORMOBJECT.F,1.7,1.8 FORMPROPERTY.F,1.3,1.4 FORMTOOLBAR.F,1.1,1.2 FORTHFORM.F,1.8,1.9 FormHelp.f,1.1,1.2 FormMenu.f,1.1,1.2 Forms.frm,1.3,1.4 PREFERENCES.ff,1.2,1.3 RECT.F,1.2,1.3
|
From: Ezra B. <ezr...@us...> - 2005-11-01 23:14:17
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25341/apps/ForthForm Modified Files: CONTROLPROPERTYII.ff CreateToolBar.f FORMCONTROLS.F FORMOBJECT.F FORMPROPERTY.F FORMTOOLBAR.F FORTHFORM.F FormHelp.f FormMenu.f Forms.frm PREFERENCES.ff RECT.F Added Files: CreatePropertyForm.f CreatePropertyForm.ff EXFONT.F Log Message: ForthForm update 2.02.05 Index: RECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/RECT.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** RECT.F 21 Aug 2005 06:22:00 -0000 1.2 --- RECT.F 1 Nov 2005 23:14:04 -0000 1.3 *************** *** 12,16 **** simple. ! Comment; anew -rect.f --- 12,16 ---- simple. ! Comment; anew -rect.f *************** *** 30,34 **** BLACK to drawcolor R2_NOT to drawmode \ inverse drawing by default ! Color: RED NewColor: DotColor PS_DOT Put: DotColor.PenStyle InitColor: DotColor --- 30,34 ---- BLACK to drawcolor R2_NOT to drawmode \ inverse drawing by default ! Color: BLACK NewColor: DotColor PS_DOT Put: DotColor.PenStyle InitColor: DotColor *************** *** 70,99 **** Addr: DotColor to drawcolor DrawNormal: self ! to drawmode to drawcolor ;M ! /* ! \ Works better on hi-color systems ! : XorPixel { x y -- } ! x y GetPixel: thedc ! 0x00FFFFFF xor ! y x GetHandle: thedc Call SetPixel drop ; ! ! : XorDrawRectangle ( -- ) ! right left - 1+ 0max 0 ! ?do left i + top XorPixel \ top horizontal ! loop bottom top - 1+ 0max 0 ! ?do left top i + XorPixel \ left and right ! right top i + XorPixel \ vertical ! loop right left - 1+ 0max 0 ! ?do left i + bottom XorPixel \ bottom horizontal ! loop ; ! ! :M XorDraw: ( -- ) ! thedc ! if XorDrawRectangle ! then ;M - :M XorErase: ( -- ) - XorDraw: self ;M - */ :M Sunken: { color1 color2 -- } thedc --- 70,76 ---- Addr: DotColor to drawcolor DrawNormal: self ! to drawmode to drawcolor ! ;M :M Sunken: { color1 color2 -- } thedc Index: CreateToolBar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CreateToolBar.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** CreateToolBar.f 25 Sep 2005 20:00:35 -0000 1.3 --- CreateToolBar.f 1 Nov 2005 23:14:04 -0000 1.4 *************** *** 2,5 **** --- 2,6 ---- \ needs CreateToolBarForm.frm + 0 value DesignToolBar :Object PreviewWindow <Super Window *************** *** 11,14 **** --- 12,18 ---- dint dimensions create title$ ," Bitmap Preview Window" 0 , + Rect bitmapbox + 0 value savex + 0 value savey : NoBitmap ( -- ) *************** *** 26,30 **** hwnd 0= if Start: self ! then BitmapFile count addr cnt caps-compare 0= ?exitm &bitmap ?dup if release 0 to &bitmap --- 30,34 ---- hwnd 0= if Start: self ! then BitmapFile count addr cnt istr= ?exitm &bitmap ?dup if release 0 to &bitmap *************** *** 48,55 **** dimensions ;M :M On_Paint: ( -- ) BitmapFile c@ 0<> &Bitmap 0<> and if &bitmap SetBitmap: TheBitmap ! 0 0 dc.hdc ShowBitmap: TheBitmap else 0 0 width height WHITE FillArea: dc then ;M --- 52,75 ---- dimensions ;M + : drawBox ( -- ) + get-dc + addr: dc + SetDC: BitmapBox + DrawNormal: BitmapBox + release-dc ; + + : eraseBox ( -- ) \ really same as drawbox + drawBox ; + + : ShowBox ( -- ) + erasebox + mousex mousey 2dup BitmapDimensions: DesignToolbar d+ SetRect: BitmapBox + drawbox ; + :M On_Paint: ( -- ) BitmapFile c@ 0<> &Bitmap 0<> and if &bitmap SetBitmap: TheBitmap ! \ width height dc.hdc ShowFittedBitmap: TheBitmap ! 0 0 dc.hdc ShowBitmap: TheBitmap else 0 0 width height WHITE FillArea: dc then ;M *************** *** 74,78 **** --- 94,103 ---- Title$ 1+ ;M + : savemouse ( -- ) + mousex to savex + mousey to savey ; + : showposition ( -- ) + ShowBox title$ count pad place s" (" pad +place *************** *** 86,91 **** On_Init: super ['] showposition settrackfunc: self ! ['] showposition setclickfunc: self ;M ! :M SetPos: ( x y -- ) 2to xypos ;M --- 111,124 ---- On_Init: super ['] showposition settrackfunc: self ! ['] showposition setclickfunc: self ! ['] savemouse setunclickfunc: self ! ;M ! /* ! :M WM_MOUSEMOVE ( h m w l -- ) ! \ over MK_LBUTTON and to mousedown \ mouse left button pressed? ! WM_MOUSEMOVE WM: Super ! showposition ! ;M ! */ :M SetPos: ( x y -- ) 2to xypos ;M *************** *** 205,208 **** --- 238,248 ---- ; + :M BitmapDimensions: ( -- w h ) + GetValue: updnBitmapWidth + GetValue: updnBitmapHeight 2dup or 0= \ if zero set default + if 2drop 16 15 + then ;M + + : GetBitmap ( -- ) hwnd Start: GetBitmapDlg dup c@ *************** *** 226,230 **** err 0= if ButtonTextList ButtonTextLength Write: TDFFile to err then Close: TDFFile \ close ! err 0= s" Success!" ?MessageBox else drop then ; --- 266,270 ---- err 0= if ButtonTextList ButtonTextLength Write: TDFFile to err then Close: TDFFile \ close ! err s" Save error!" ?MessageBox else drop then ; *************** *** 255,258 **** --- 295,300 ---- On_Init: Super + self to DesignToolBar + self Start: updn#Bitmaps GetHandle: txt#Bitmaps SetBuddy: updn#Bitmaps *************** *** 424,430 **** begin dup while readline-memory 2>r ! 2dup s" separator" caps-compare 0= if 2drop s" SeparatorButton," append&crlf ! else 2dup s" extra" caps-compare 0= if 2drop s" ToolBarTableExtraButtons:" append&crlf else write-tableline --- 466,472 ---- begin dup while readline-memory 2>r ! 2dup s" separator" istr= if 2drop s" SeparatorButton," append&crlf ! else 2dup s" extra" istr= if 2drop s" ToolBarTableExtraButtons:" append&crlf else write-tableline Index: Forms.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/Forms.frm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Forms.frm 25 Sep 2005 20:00:35 -0000 1.3 --- Forms.frm 1 Nov 2005 23:14:04 -0000 1.4 *************** *** 5,24 **** :Object frmPropertiesWindow <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form TabControl TabProperties \ Coordinates and dimensions for btnApply ! 22 value btnApplyX ! 287 value btnApplyY ! 108 value btnApplyW ! 40 value btnApplyH \ Coordinates and dimensions for btnClose ! 132 value btnCloseX ! 287 value btnCloseY ! 108 value btnCloseW ! 40 value btnCloseH :M ClassInit: ( -- ) --- 5,24 ---- :Object frmPropertiesWindow <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form TabControl TabProperties \ Coordinates and dimensions for btnApply ! 22 value btnApplyX ! 287 value btnApplyY ! 108 value btnApplyW ! 40 value btnApplyH \ Coordinates and dimensions for btnClose ! 132 value btnCloseX ! 287 value btnCloseY ! 108 value btnCloseW ! 40 value btnCloseH :M ClassInit: ( -- ) *************** *** 45,49 **** :M StartSize: ( -- width height ) ! 261 333 ;M --- 45,49 ---- :M StartSize: ( -- width height ) ! 261 333 ;M *************** *** 126,130 **** :Object frmEditProperties <Super Child-Window ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color --- 126,130 ---- :Object frmEditProperties <Super Child-Window ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color *************** *** 143,147 **** ClassInit: super +dialoglist \ allow handling of dialog messages ! 392 to id \ set child id, changeable \ Insert your code here ;M --- 143,147 ---- ClassInit: super +dialoglist \ allow handling of dialog messages ! 400 to id \ set child id, changeable \ Insert your code here ;M *************** *** 167,171 **** :M StartSize: ( -- width height ) ! 248 287 ;M --- 167,171 ---- :M StartSize: ( -- width height ) ! 248 287 ;M *************** *** 185,189 **** self Start: grpControls ! 8 192 141 43 Move: grpControls Handle: Winfont SetFont: grpControls BS_CENTER +Style: grpControls --- 185,189 ---- self Start: grpControls ! 8 198 141 43 Move: grpControls Handle: Winfont SetFont: grpControls BS_CENTER +Style: grpControls *************** *** 191,195 **** self Start: grpOrientation ! 8 130 141 60 Move: grpOrientation Handle: Winfont SetFont: grpOrientation BS_CENTER +Style: grpOrientation --- 191,195 ---- self Start: grpOrientation ! 8 136 141 60 Move: grpOrientation Handle: Winfont SetFont: grpOrientation BS_CENTER +Style: grpOrientation *************** *** 209,213 **** self Start: lblXpos ! 1 36 39 14 Move: lblXpos Handle: Winfont SetFont: lblXpos SS_RIGHT +Style: lblXpos --- 209,213 ---- self Start: lblXpos ! 1 41 39 14 Move: lblXpos Handle: Winfont SetFont: lblXpos SS_RIGHT +Style: lblXpos *************** *** 215,219 **** self Start: lblYPos ! 81 36 37 14 Move: lblYPos Handle: Winfont SetFont: lblYPos SS_RIGHT +Style: lblYPos --- 215,219 ---- self Start: lblYPos ! 81 42 37 14 Move: lblYPos Handle: Winfont SetFont: lblYPos SS_RIGHT +Style: lblYPos *************** *** 221,225 **** self Start: lblWidth ! 2 51 39 14 Move: lblWidth Handle: Winfont SetFont: lblWidth SS_RIGHT +Style: lblWidth --- 221,225 ---- self Start: lblWidth ! 2 57 39 14 Move: lblWidth Handle: Winfont SetFont: lblWidth SS_RIGHT +Style: lblWidth *************** *** 227,231 **** self Start: lblHeight ! 83 52 36 14 Move: lblHeight Handle: Winfont SetFont: lblHeight SS_RIGHT +Style: lblHeight --- 227,231 ---- self Start: lblHeight ! 83 58 36 14 Move: lblHeight Handle: Winfont SetFont: lblHeight SS_RIGHT +Style: lblHeight *************** *** 233,237 **** self Start: lblTooltip ! 1 70 39 14 Move: lblTooltip Handle: Winfont SetFont: lblTooltip SS_RIGHT +Style: lblTooltip --- 233,237 ---- self Start: lblTooltip ! 1 76 39 14 Move: lblTooltip Handle: Winfont SetFont: lblTooltip SS_RIGHT +Style: lblTooltip *************** *** 239,243 **** self Start: lblBitmap ! 1 87 39 14 Move: lblBitmap Handle: Winfont SetFont: lblBitmap SS_RIGHT +Style: lblBitmap --- 239,243 ---- self Start: lblBitmap ! 1 92 39 14 Move: lblBitmap Handle: Winfont SetFont: lblBitmap SS_RIGHT +Style: lblBitmap *************** *** 245,296 **** self Start: txtName ! 44 3 175 15 Move: txtName Handle: Winfont SetFont: txtName self Start: txtCaption ! 44 20 175 14 Move: txtCaption Handle: Winfont SetFont: txtCaption self Start: txtXPos ! 44 36 34 14 Move: txtXPos Handle: Winfont SetFont: txtXPos self Start: txtYPos ! 120 36 34 14 Move: txtYPos Handle: Winfont SetFont: txtYPos self Start: txtWidth ! 44 52 34 14 Move: txtWidth Handle: Winfont SetFont: txtWidth self Start: txtHeight ! 120 53 34 14 Move: txtHeight Handle: Winfont SetFont: txtHeight self Start: txtToolTip ! 44 70 175 15 Move: txtToolTip Handle: Winfont SetFont: txtToolTip self Start: txtBitmap ! 44 86 175 15 Move: txtBitmap Handle: Winfont SetFont: txtBitmap self Start: btnBrowse ! 223 87 18 14 Move: btnBrowse Handle: Winfont SetFont: btnBrowse s" ..." SetText: btnBrowse self Start: chkGroup ! 1 109 62 17 Move: chkGroup Handle: Winfont SetFont: chkGroup s" Group" SetText: chkGroup self Start: chkGlobal ! 70 108 62 17 Move: chkGlobal Handle: Winfont SetFont: chkGlobal s" Global" SetText: chkGlobal self Start: radLeft ! 12 144 50 17 Move: radLeft WS_GROUP +Style: radLeft Handle: Winfont SetFont: radLeft --- 245,296 ---- self Start: txtName ! 44 3 175 17 Move: txtName Handle: Winfont SetFont: txtName self Start: txtCaption ! 44 21 175 17 Move: txtCaption Handle: Winfont SetFont: txtCaption self Start: txtXPos ! 44 42 34 14 Move: txtXPos Handle: Winfont SetFont: txtXPos self Start: txtYPos ! 120 42 34 14 Move: txtYPos Handle: Winfont SetFont: txtYPos self Start: txtWidth ! 44 58 34 14 Move: txtWidth Handle: Winfont SetFont: txtWidth self Start: txtHeight ! 120 59 34 14 Move: txtHeight Handle: Winfont SetFont: txtHeight self Start: txtToolTip ! 44 76 175 15 Move: txtToolTip Handle: Winfont SetFont: txtToolTip self Start: txtBitmap ! 44 92 175 15 Move: txtBitmap Handle: Winfont SetFont: txtBitmap self Start: btnBrowse ! 223 92 18 14 Move: btnBrowse Handle: Winfont SetFont: btnBrowse s" ..." SetText: btnBrowse self Start: chkGroup ! 2 114 62 17 Move: chkGroup Handle: Winfont SetFont: chkGroup s" Group" SetText: chkGroup self Start: chkGlobal ! 70 114 62 17 Move: chkGlobal Handle: Winfont SetFont: chkGlobal s" Global" SetText: chkGlobal self Start: radLeft ! 12 150 50 17 Move: radLeft WS_GROUP +Style: radLeft Handle: Winfont SetFont: radLeft *************** *** 298,317 **** self Start: radCenter ! 83 144 50 16 Move: radCenter Handle: Winfont SetFont: radCenter s" Center" SetText: radCenter self Start: radRight ! 12 163 46 16 Move: radRight Handle: Winfont SetFont: radRight s" Right" SetText: radRight self Start: radLefttext ! 83 163 57 16 Move: radLefttext Handle: Winfont SetFont: radLefttext s" Lefttext" SetText: radLefttext self Start: btnPrevious ! 17 208 49 20 Move: btnPrevious WS_GROUP +Style: btnPrevious Handle: Winfont SetFont: btnPrevious --- 298,317 ---- self Start: radCenter ! 83 150 50 16 Move: radCenter Handle: Winfont SetFont: radCenter s" Center" SetText: radCenter self Start: radRight ! 12 169 46 16 Move: radRight Handle: Winfont SetFont: radRight s" Right" SetText: radRight self Start: radLefttext ! 83 169 57 16 Move: radLefttext Handle: Winfont SetFont: radLefttext s" Lefttext" SetText: radLefttext self Start: btnPrevious ! 17 214 49 20 Move: btnPrevious WS_GROUP +Style: btnPrevious Handle: Winfont SetFont: btnPrevious *************** *** 319,323 **** self Start: btnNext ! 90 208 49 20 Move: btnNext Handle: Winfont SetFont: btnNext s" &Next" SetText: btnNext --- 319,323 ---- self Start: btnNext ! 90 214 49 20 Move: btnNext Handle: Winfont SetFont: btnNext s" &Next" SetText: btnNext *************** *** 355,362 **** :Object frmDefineMenu <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 270 170 2value XYPos \ save screen location of form GroupBox grpFunction --- 355,362 ---- :Object frmDefineMenu <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 270 170 2value XYPos \ save screen location of form GroupBox grpFunction *************** *** 364,371 **** Label lblMenu \ Coordinates and dimensions for tvMenuTree ! 8 value tvMenuTreeX ! 28 value tvMenuTreeY ! 373 value tvMenuTreeW ! 115 value tvMenuTreeH Label lblMenuText TextBox txtMenutext --- 364,371 ---- Label lblMenu \ Coordinates and dimensions for tvMenuTree ! 8 value tvMenuTreeX ! 28 value tvMenuTreeY ! 373 value tvMenuTreeW ! 115 value tvMenuTreeH Label lblMenuText TextBox txtMenutext *************** *** 410,414 **** :M StartSize: ( -- width height ) ! 389 289 ;M --- 410,414 ---- :M StartSize: ( -- width height ) ! 389 289 ;M *************** *** 561,564 **** --- 561,727 ---- + \ CREATEPROPERTYFORM.FRM + \- textbox needs excontrols.f + + + :Object frmPropertyForm <Super DialogWindow + + Font WinFont \ default font + ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND + ColorObject FrmColor \ the background color + 350 285 2value XYPos \ save screen location of form + + GroupBox grpOptions + Label lblName + Label lblCaption + TextBox txtName + TextBox txtCaption + CheckBox chkDefault + CheckBox chkMultiLine + CheckBox chkButtonTabs + CheckBox chkComPile + PushButton btnTest + PushButton btnEdit + PushButton btnClipBoard + PushButton btnClose + + :M ClassInit: ( -- ) + ClassInit: super + \ Insert your code here + ;M + + :M WindowStyle: ( -- style ) + WS_POPUPWINDOW WS_DLGFRAME or + ;M + + \ if this form is a modal form a non-zero parent must be set + :M ParentWindow: ( -- hwndparent | 0 if no parent ) + parent + ;M + + :M SetParent: ( hwndparent -- ) \ set owner window + to parent + ;M + + :M WindowTitle: ( -- ztitle ) + z" Compile Property Form" + ;M + + :M StartSize: ( -- width height ) + 359 187 + ;M + + :M StartPos: ( -- x y ) + XYPos + ;M + + :M Close: ( -- ) + \ Insert your code here + Close: super + ;M + + :M On_Init: ( -- ) + s" MS Sans Serif" SetFaceName: WinFont + 8 Width: WinFont + Create: WinFont + + \ set form color to system color + COLOR_BTNFACE Call GetSysColor NewColor: FrmColor + + + self Start: grpOptions + 63 61 158 115 Move: grpOptions + Handle: Winfont SetFont: grpOptions + s" Options" SetText: grpOptions + + self Start: lblName + 16 18 52 18 Move: lblName + Handle: Winfont SetFont: lblName + SS_RIGHT +Style: lblName + s" Name:" SetText: lblName + + self Start: lblCaption + 16 38 52 18 Move: lblCaption + Handle: Winfont SetFont: lblCaption + SS_RIGHT +Style: lblCaption + s" Caption:" SetText: lblCaption + + self Start: txtName + 72 16 150 18 Move: txtName + Handle: Winfont SetFont: txtName + + self Start: txtCaption + 72 36 150 18 Move: txtCaption + Handle: Winfont SetFont: txtCaption + + self Start: chkDefault + 72 75 139 22 Move: chkDefault + WS_GROUP +Style: chkDefault + Handle: Winfont SetFont: chkDefault + s" Add Default Buttons" SetText: chkDefault + + self Start: chkMultiLine + 72 99 139 22 Move: chkMultiLine + Handle: Winfont SetFont: chkMultiLine + s" Multi-Line Tabs" SetText: chkMultiLine + + self Start: chkButtonTabs + 72 123 139 22 Move: chkButtonTabs + Handle: Winfont SetFont: chkButtonTabs + s" Button Tabs" SetText: chkButtonTabs + + self Start: chkComPile + 72 147 139 22 Move: chkComPile + Handle: Winfont SetFont: chkComPile + s" Compile Forms to Disk" SetText: chkComPile + + self Start: btnTest + 244 15 97 23 Move: btnTest + WS_GROUP +Style: btnTest + Handle: Winfont SetFont: btnTest + s" &Test" SetText: btnTest + + self Start: btnEdit + 244 40 97 23 Move: btnEdit + Handle: Winfont SetFont: btnEdit + s" &Edit" SetText: btnEdit + + self Start: btnClipBoard + 244 65 97 23 Move: btnClipBoard + Handle: Winfont SetFont: btnClipBoard + s" Clip&Board" SetText: btnClipBoard + + self Start: btnClose + 244 90 97 23 Move: btnClose + Handle: Winfont SetFont: btnClose + s" &Close" SetText: btnClose + + ;M + + :M WM_COMMAND ( h m w l -- res ) + over LOWORD ( ID ) self \ object address on stack + WMCommand-Func ?dup \ must not be zero + if execute + else 2drop \ drop ID and object address + then 0 ;M + + :M SetCommand: ( cfa -- ) \ set WMCommand function + to WMCommand-Func + ;M + + :M On_Paint: ( -- ) + 0 0 GetSize: self Addr: FrmColor FillArea: dc + ;M + + :M On_Done: ( -- ) + Delete: WinFont + originx originy 2to XYPos + \ Insert your code here + On_Done: super + ;M + + ;Object + + \ CREATETOOLBARFORM.FRM \- textbox needs excontrols.f *************** *** 567,574 **** :Object frmDefineToolbar <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 210 225 2value XYPos \ save screen location of form GroupBox grpStyles --- 730,737 ---- :Object frmDefineToolbar <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 210 225 2value XYPos \ save screen location of form GroupBox grpStyles *************** *** 638,642 **** :M StartSize: ( -- width height ) ! 522 364 ;M --- 801,805 ---- :M StartSize: ( -- width height ) ! 522 364 ;M *************** *** 904,917 **** :Object frmFormPad <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form \ Coordinates and dimensions for scnEditor ! 3 value scnEditorX ! 10 value scnEditorY ! 484 value scnEditorW ! 305 value scnEditorH PushButton btnSaveToDisk PushButton btnCompile --- 1067,1080 ---- :Object frmFormPad <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form \ Coordinates and dimensions for scnEditor ! 3 value scnEditorX ! 10 value scnEditorY ! 484 value scnEditorW ! 305 value scnEditorH PushButton btnSaveToDisk PushButton btnCompile *************** *** 941,945 **** :M StartSize: ( -- width height ) ! 620 320 ;M --- 1104,1108 ---- :M StartSize: ( -- width height ) ! 620 320 ;M *************** *** 1017,1021 **** :Object frmEditFormProperties <Super Child-Window ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color --- 1180,1184 ---- :Object frmEditFormProperties <Super Child-Window ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color *************** *** 1046,1050 **** ClassInit: super +dialoglist \ allow handling of dialog messages ! 393 to id \ set child id, changeable \ Insert your code here ;M --- 1209,1213 ---- ClassInit: super +dialoglist \ allow handling of dialog messages ! 401 to id \ set child id, changeable \ Insert your code here ;M *************** *** 1070,1074 **** :M StartSize: ( -- width height ) ! 237 268 ;M --- 1233,1237 ---- :M StartSize: ( -- width height ) ! 237 268 ;M *************** *** 1225,1229 **** :Object frmGroupAction <Super Child-Window ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color --- 1388,1392 ---- :Object frmGroupAction <Super Child-Window ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color *************** *** 1249,1276 **** RadioButton radWidth \ Coordinates and dimensions for imgbtnUp ! 56 value imgbtnUpX ! 141 value imgbtnUpY ! 32 value imgbtnUpW ! 32 value imgbtnUpH \ Coordinates and dimensions for imgbtnRight ! 96 value imgbtnRightX ! 172 value imgbtnRightY ! 32 value imgbtnRightW ! 32 value imgbtnRightH \ Coordinates and dimensions for imgbtnDown ! 56 value imgbtnDownX ! 200 value imgbtnDownY ! 32 value imgbtnDownW ! 32 value imgbtnDownH \ Coordinates and dimensions for imgbtnLeft ! 16 value imgbtnLeftX ! 172 value imgbtnLeftY ! 32 value imgbtnLeftW ! 32 value imgbtnLeftH :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 394 to id \ set child id, changeable \ Insert your code here ;M --- 1412,1439 ---- RadioButton radWidth \ Coordinates and dimensions for imgbtnUp ! 56 value imgbtnUpX ! 141 value imgbtnUpY ! 32 value imgbtnUpW ! 32 value imgbtnUpH \ Coordinates and dimensions for imgbtnRight ! 96 value imgbtnRightX ! 172 value imgbtnRightY ! 32 value imgbtnRightW ! 32 value imgbtnRightH \ Coordinates and dimensions for imgbtnDown ! 56 value imgbtnDownX ! 200 value imgbtnDownY ! 32 value imgbtnDownW ! 32 value imgbtnDownH \ Coordinates and dimensions for imgbtnLeft ! 16 value imgbtnLeftX ! 172 value imgbtnLeftY ! 32 value imgbtnLeftW ! 32 value imgbtnLeftH :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages ! 402 to id \ set child id, changeable \ Insert your code here ;M *************** *** 1296,1300 **** :M StartSize: ( -- width height ) ! 210 253 ;M --- 1459,1463 ---- :M StartSize: ( -- width height ) ! 210 253 ;M *************** *** 1445,1452 **** :Object frmPreferences <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form GroupBox grpOther --- 1608,1615 ---- :Object frmPreferences <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form GroupBox grpOther *************** *** 1476,1480 **** :M StartSize: ( -- width height ) ! 158 173 ;M --- 1639,1643 ---- :M StartSize: ( -- width height ) ! 158 173 ;M *************** *** 1500,1504 **** 11 81 139 50 Move: grpOther Handle: Winfont SetFont: grpOther ! s" Miscellaneous" SetText: grpOther self Start: grpToolBar --- 1663,1667 ---- 11 81 139 50 Move: grpOther Handle: Winfont SetFont: grpOther ! s" Options" SetText: grpOther self Start: grpToolBar *************** *** 1518,1522 **** self Start: chkShowMonitor ! 18 93 89 18 Move: chkShowMonitor Handle: Winfont SetFont: chkShowMonitor s" Show Monitor" SetText: chkShowMonitor --- 1681,1685 ---- self Start: chkShowMonitor ! 18 101 89 18 Move: chkShowMonitor Handle: Winfont SetFont: chkShowMonitor s" Show Monitor" SetText: chkShowMonitor *************** *** 1572,1611 **** :Object frmSplitterWindow <Super DialogWindow ! Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form GroupBox grpOptions \ Coordinates and dimensions for imgType1 ! 11 value imgType1X ! 17 value imgType1Y ! 90 value imgType1W ! 72 value imgType1H \ Coordinates and dimensions for imgType2 ! 104 value imgType2X ! 17 value imgType2Y ! 90 value imgType2W ! 72 value imgType2H \ Coordinates and dimensions for imgType3 ! 11 value imgType3X ! 92 value imgType3Y ! 90 value imgType3W ! 72 value imgType3H \ Coordinates and dimensions for imgType4 ! 104 value imgType4X ! 90 value imgType4Y ! 90 value imgType4W ! 71 value imgType4H \ Coordinates and dimensions for imgType5 ! 11 value imgType5X ! 165 value imgType5Y ! 90 value imgType5W ! 72 value imgType5H \ Coordinates and dimensions for imgType6 ! 104 value imgType6X ! 166 value imgType6Y ! 90 value imgType6W ! 72 value imgType6H RadioButton radTest RadioButton radEdit --- 1735,1774 ---- :Object frmSplitterWindow <Super DialogWindow ! Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color ! 150 175 2value XYPos \ save screen location of form GroupBox grpOptions \ Coordinates and dimensions for imgType1 ! 11 value imgType1X ! 17 value imgType1Y ! 90 value imgType1W ! 72 value imgType1H \ Coordinates and dimensions for imgType2 ! 104 value imgType2X ! 17 value imgType2Y ! 90 value imgType2W ! 72 value imgType2H \ Coordinates and dimensions for imgType3 ! 11 value imgType3X ! 92 value imgType3Y ! 90 value imgType3W ! 72 value imgType3H \ Coordinates and dimensions for imgType4 ! 104 value imgType4X ! 90 value imgType4Y ! 90 value imgType4W ! 71 value imgType4H \ Coordinates and dimensions for imgType5 ! 11 value imgType5X ! 165 value imgType5Y ! 90 value imgType5W ! 72 value imgType5H \ Coordinates and dimensions for imgType6 ! 104 value imgType6X ! 166 value imgType6Y ! 90 value imgType6W ! 72 value imgType6H RadioButton radTest RadioButton radEdit *************** *** 1637,1641 **** :M StartSize: ( -- width height ) ! 339 247 ;M --- 1800,1804 ---- :M StartSize: ( -- width height ) ! 339 247 ;M --- NEW FILE: CreatePropertyForm.ff --- (This appears to be a binary file; contents omitted.) Index: FormHelp.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FormHelp.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FormHelp.f 21 Aug 2005 06:22:00 -0000 1.1 --- FormHelp.f 1 Nov 2005 23:14:04 -0000 1.2 *************** *** 1,4 **** \ FormHelp.f ! :Object FFHelpWindow <Super HtmlDisplayWindow --- 1,4 ---- \ FormHelp.f ! /* :Object FFHelpWindow <Super HtmlDisplayWindow *************** *** 25,27 **** --- 25,53 ---- then ; ' FormHelp is doFormHelp + */ + HtmlDisplayControl FFHelpWindow + 2005 SetID: FFHelpWindow + + : SizeHelpWindow ( -- ) + GetHandle: FFHelpWindow + if Canvas: TheMainWindow Move: FFHelpWindow + then ; + + : CloseHelpWindow ( -- ) + Close: FFHelpWindow + \+ withbgnd SW_SHOWNORMAL Show: BkGndImageWindow + UpdateSystem \ update toolbar help button + ; + + : FormHelp ( -- ) \ prepare dinner :-) + GetHandle: FFHelpwindow ?exit + s" doc\forthform\ForthForm.htm" "path-file 0= \ if help file found + if TheMainWindow Start: FFHelpWindow + asciiz SetUrl: FFHelpWindow \ show it + SizeHelpWindow + \+ withbgnd SW_HIDE Show: BkGndImageWindow + else 2drop true s" ForthForm.htm not found in path!" ?MessageBox \ sorry! + then UpdateSystem \ update toolbar help button + ; ' FormHelp is doFormHelp + \s Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** FORTHFORM.F 15 Sep 2005 16:36:08 -0000 1.8 --- FORTHFORM.F 1 Nov 2005 23:14:04 -0000 1.9 *************** *** 8,12 **** : sysgen ; ! \ add the ForthForm folder's to our path list \ September 20th, 2003 - 9:57 dbu --- 8,12 ---- : sysgen ; ! \ : withbgnd ; \ add the ForthForm folder's to our path list \ September 20th, 2003 - 9:57 dbu *************** *** 17,40 **** vocabulary forthform ! vocabulary testvocab forthform also definitions ! needs excontrols.f \ extended controls for Win32Forth needs ExUtils.f \ general utilities ! needs linklist.f \ very useful utility ! needs bitmap.f \ bitmap loading routines ! needs point.f \ simple point class ! needs rect.f \ class for drawing boxes ! needs fcases.f \ case extensions ! needs file.f \ file functions encapsulated in a class ! needs caseEx.f \ extension to case and if ! needs sendmessage.f \ simple macro ! needs toolbar.f \ Windows toolbar class ! needs enum.f \ enumerated constants ! needs multiopen.f \ open multiple forms needs rebarcontrol.f \ allow enhanced toolbar ! needs HtmlDisplayWindow.f \ for viewing the help file ! needs ScintillaControl.f ! needs FileLister.f \ directory viewer needs Win32Help.f needs Resources.f --- 17,41 ---- vocabulary forthform ! vocabulary testvocab \ for testing forms to avoid conflicts forthform also definitions ! needs excontrols.f \ extended controls for Win32Forth needs ExUtils.f \ general utilities ! needs linklist.f \ very useful utility ! needs bitmap.f \ bitmap loading routines ! needs point.f \ simple point class ! needs rect.f \ class for drawing boxes ! needs fcases.f \ case extensions ! needs file.f \ file functions encapsulated in a class ! needs caseEx.f \ extension to case and if ! needs sendmessage.f \ simple macro ! needs toolbar.f \ Windows toolbar class ! needs enum.f \ enumerated constants ! needs multiopen.f \ open multiple forms needs rebarcontrol.f \ allow enhanced toolbar ! needs HtmlDisplayControl.f \ for viewing the help file ! needs ScintillaControl.f \ editor for FormPad ! needs FileLister.f \ directory viewer ! needs exfont.f \ enhanced font class to allow runtime font selection needs Win32Help.f needs Resources.f *************** *** 66,74 **** 0 value TheMainWindow \ allow forward referencing 0 value FormList \ pointer to list of open forms 0 value ButtonID \ button to be unchecked 0 value TheControlToolBar 0 value NextControlType \ next control to be created GRAY value BackGroundColor \ default ! 0 value newcontrol? 0 value statuswindow \ pointer to status window object 0 value inconsole --- 67,76 ---- 0 value TheMainWindow \ allow forward referencing 0 value FormList \ pointer to list of open forms + 0 value formcount \ running total of created forms 0 value ButtonID \ button to be unchecked 0 value TheControlToolBar 0 value NextControlType \ next control to be created GRAY value BackGroundColor \ default ! false value newcontrol? 0 value statuswindow \ pointer to status window object 0 value inconsole *************** *** 76,98 **** 0 value staticbmp \ registry values ! 100 value WindowTop \ main window y position ! 100 value WindowLeft \ main window x position ! 600 value WindowWidth \ main window width ! 400 value WindowHeight \ main window height ! 536 value MonitorLeft \ monitor window x position ! 375 value MonitorTop \ default is same y position ! true value FlatToolBar? \ do we want a flat toolbar ? ! 0 value ButtonText? \ display button text ?, actually disabled ! true value ShowMonitor? ! 0 value session-error? \ did an error occurred while loading a session? ! WM_USER 256 + constant FF_PASTE \ mesage to tell SciEdit to paste source text ColorObject FormColor \ background form color ! Font ControlFont \ font for text to be written in control \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance \ adapted from WinEd ! 20204 constant fform_version# \ 2.02.04 \ Version numbers: v.ww.rr --- 78,104 ---- 0 value staticbmp \ registry values ! 100 value WindowTop \ main window y position ! 100 value WindowLeft \ main window x position ! 600 value WindowWidth \ main window width ! 400 value WindowHeight \ main window height ! 536 value MonitorLeft \ monitor window x position ! 375 value MonitorTop \ default is same y position ! true value FlatToolBar? \ do we want a flat toolbar ? ! false value ButtonText? \ display button text ?, actually disabled ! true value ShowMonitor? \ display the window positioning monitor ! false value session-error? \ did an error occurred while loading a session? ! 0 value frmdata-size ! 0 value ctrldata-size ! WM_USER 256 + constant FF_PASTE \ message to tell SciEdit to paste source text ColorObject FormColor \ background form color ! Font ControlFont \ default font for text to be written in control \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance + File MergeFile + File TheFile \ adapted from WinEd ! 20205 constant fform_version# \ 2.02.05 \ Version numbers: v.ww.rr *************** *** 111,114 **** --- 117,122 ---- : ExitOnError ( f -- ) S" A serious error has occurred in ForthForm!" ?TerminateBox ; + + macro ?abort " if abort then" \ define defer functions *************** *** 147,150 **** --- 155,170 ---- defer UpdateSystem defer (OpenForm) + defer doPropertyForm + + : Start-SciEditMdi ( -- ) + editor-present? not + if s" SciEditMdi.exe" PrePend<Home>\ + GetHandle: TheMainWindow ExecuteFile + then ; + + : Start-ProjectManager ( -- ) + ?promgr-started ?exit + s" Project.exe" PrePend<Home>\ + GetHandle: TheMainWindow ExecuteFile ; : set-base-path ( -- ) *************** *** 217,221 **** ArrangeHorizontal: ActiveForm ; ! :NoName ( -- ) ActiveForm 0= ?exit DeleteControl: ActiveForm ; is doDelete --- 237,241 ---- ArrangeHorizontal: ActiveForm ; ! :NoName ( -- ) ActiveForm 0= ?exit DeleteControl: ActiveForm ; is doDelete *************** *** 225,229 **** MoveToBack: ActiveForm ; is doMoveToBack ! :NoName ( -- ) ActiveForm 0= ?exit MoveToFront: ActiveForm ; is doMoveToFront --- 245,249 ---- MoveToBack: ActiveForm ; is doMoveToBack ! :NoName ( -- ) ActiveForm 0= ?exit MoveToFront: ActiveForm ; is doMoveToFront *************** *** 234,247 **** ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! ! : ?FormNumber { <object> -- n } \ given object address return position in list ! <object> 0= FormList 0= or ! if false exit ! then Link#: FormList >r >FirstLink: FormList 0 ! begin 1+ Data@: FormList <object> = ! LastLink?: FormList or ! >NextLink: FormList ! until r> >Link#: FormList ; ! : #Forms ( -- n ) \ return number of open forms FormList --- 254,272 ---- ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! ! : ChangeControlFont ( -- ) ! ActiveForm 0= ?exit ! ActiveControl: ActiveForm ?dup ! if GetUserFont: [ ] ! IsModified: ActiveForm ! then ; ! ! : ResetControlFont ( -- ) ! ActiveForm 0= ?exit ! ActiveControl: ActiveForm ?dup ! if DefaultFont: [ ] ! IsModified: ActiveForm ! then ; ! : #Forms ( -- n ) \ return number of open forms FormList *************** *** 253,256 **** --- 278,292 ---- then ; + : ?FormNumber { <object> -- n } \ given object address return position in list + <object> 0= FormList 0= or + if false exit + then >FirstLink: FormList + #Forms 1+ 1 + ?do Data@: FormList <object> = + if i unloop + exit + then >NextLink: FormList + loop 0 ; + FileOpenDialog OpenSessionDlg "Load Session File" "Session Files|*.ses|" FileSaveDialog SaveSessionDlg "Save Session File" "Session Files|*.ses|" *************** *** 273,277 **** needs SplitterWindow.f \ this is also an easy guess! needs CreateMenu.f \ now what could this file be for? ! :Object MiniWin <Super child-window --- 309,313 ---- needs SplitterWindow.f \ this is also an easy guess! needs CreateMenu.f \ now what could this file be for? ! needs CreatePropertyForm.f \ generate property sheet like template :Object MiniWin <Super child-window *************** *** 286,290 **** 0 to WasMoved? 0 to wx ! 0 to wy ;M :M WindowStyle: ( -- style ) --- 322,327 ---- 0 to WasMoved? 0 to wx ! 0 to wy ! 1 to ID ;M :M WindowStyle: ( -- style ) *************** *** 368,375 **** ;M - :M On_Init: ( -- ) - 1 SetID: MiniWin - ;M - :M On_Paint: ( -- ) 0 0 GetSize: self CYAN FillArea: dc --- 405,408 ---- *************** *** 430,435 **** Clear: FormPicker #Forms ?dup ! if Link#: FormList >r \ save link ! 1+ 1 ?do i >Link#: FormList Data@: FormList FormName: [ ] --- 463,467 ---- Clear: FormPicker #Forms ?dup ! if 1+ 1 ?do i >Link#: FormList Data@: FormList FormName: [ ] *************** *** 437,441 **** loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then r> >Link#: FormList then ; --- 469,473 ---- loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then then ; *************** *** 503,506 **** --- 535,547 ---- ; + : check-file { fname fcnt \ fsize -- f } \ check integrity of file before opening + fname fcnt SetName: TheFile \ + Open: TheFile ?dup ?exit + FileSize: TheFile drop to fsize \ larger than 4 gig .ff file? + 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 *************** *** 509,513 **** new$ >r s" Form" r@ place ! #Forms (.) r@ +place r> count 2dup SetName: ThisForm IsFormTitle: ThisForm --- 550,554 ---- new$ >r s" Form" r@ place ! formcount (.) r@ +place r> count 2dup SetName: ThisForm IsFormTitle: ThisForm *************** *** 516,527 **** doupdate ; is doNew ! :NoName ( fname fcnt -- ) \ open form given its name ! AddNewForm Start: ThisForm ! SetFileName: ThisForm ! Load: ThisForm ! StartSize: ThisForm GetHandle: ThisForm AdjustWindowSize ! FormTitle: ThisForm count Settext: ThisForm ! Refresh: ThisForm Display: ThisForm doupdate ; is (OpenForm) --- 557,570 ---- doupdate ; is doNew ! :NoName { fname fcnt -- } \ open form given its name ! fname fcnt check-file ! if fname fcnt pad place ! s" is an invalid ForthForm file!" pad +place ! true pad count ?MessageBox ! exit ! then AddNewForm Start: ThisForm ! fname fcnt SetFileName: ThisForm ! Load: ThisForm Display: ThisForm doupdate ; is (OpenForm) *************** *** 534,540 **** then ; is doOpen ! :NoName ( -- ) ! ActiveForm 0= ?exit ! GetBuffer: ActiveForm FormName: ActiveForm count ShowSource ; is doEditor : strip-cmdline ( addr cnt -- addr2 cnt2 ) --- 577,583 ---- then ; is doOpen ! :NoName ( -- ) \ view/edit form ! ActiveForm 0= ?exit ! GetBuffer: ActiveForm FormName: ActiveForm count ShowSource ; is doEditor : strip-cmdline ( addr cnt -- addr2 cnt2 ) *************** *** 567,580 **** ActiveForm 0= ?exit s" anew _frm" evaluate GetBuffer: ActiveForm 2drop fload-buffer \ load actual form GetSuperClass: ActiveForm dup CHILD-CLASS = \ compiling as a child window? ! if drop TestChildDialog: ActiveForm fload-buffer else MDIDIALOG-CLASS = \ or as a MDI dialog? ! if TestMDIDialog: ActiveForm fload-buffer else s" Start: " new$ dup>r place FormName: ActiveForm count r@ +place \ no, as a dialog window ! r> count evaluate then ! then ; is doTest :NoName ( -- ) \ clean slate --- 610,625 ---- 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 fload-buffer \ load actual form GetSuperClass: ActiveForm dup CHILD-CLASS = \ compiling as a child window? ! if drop TestChildDialog: ActiveForm fload-buffer else MDIDIALOG-CLASS = \ or as a MDI dialog? ! if TestMDIDialog: ActiveForm fload-buffer else s" Start: " new$ dup>r place FormName: ActiveForm count r@ +place \ no, as a dialog window ! r> count evaluate then ! then r> IsChildState: ActiveForm ; is doTest :NoName ( -- ) \ clean slate *************** *** 594,598 **** then ; is doSaveAll - File MergeFile :NoName { \ fname err - } \ compile all open forms to a single file #forms 2 < ?exit \ no use merging 1 form --- 639,642 ---- *************** *** 613,631 **** do Data@: FormList GetBuffer: [ ] 2drop +crlf +crlf \ couple blank lines ! TheBuffer Write: MergeFile dup to err ! ?leave >NextLink: FormList ! loop Close: MergeFile ! err 0= s" Forms successfully merged!" ?MessageBox ; is doMerge ! :NoName ( -- ) ! ActiveForm 0= ?exit ! GetBuffer: ActiveForm copy-clipboard ; is doCopy :Object MainWindow <Super Window MultiStatusbar controlstats \ status window - Rect aBox create bardivisions 136 , 250 , 400 , 460 , -1 , --- 657,672 ---- do Data@: FormList GetBuffer: [ ] 2drop +crlf +crlf \ couple blank lines ! TheBuffer Write: MergeFile ?leave >NextLink: FormList ! loop Close: MergeFile ClearName: MergeFile ; is doMerge ! :NoName ( -- ) \ copy to clipboard ! ActiveForm 0= ?exit ! GetBuffer: ActiveForm copy-clipboard ; is doCopy :Object MainWindow <Super Window MultiStatusbar controlstats \ status window create bardivisions 136 , 250 , 400 , 460 , -1 , *************** *** 662,666 **** 520 50 ;M - :M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window LoadAppIcon ;M --- 703,706 ---- *************** *** 683,686 **** --- 723,727 ---- #IFDEF withbgnd self Start: BkGndImageWindow + \ WS_CLIPSIBLINGS WS_CLIPCHILDREN or +Style: BkGndImageWindow FIT_SIZE SetViewMode: BkGndImageWindow GetBackGroundImage *************** *** 712,721 **** InitScintillaControl \ for the editor ;M #IFDEF withbgnd :M ReDrawImage: ( -- ) ! 0 Height: TheRebar dup>r ( -- x y ) ! Width Height Height: statuswindow - r> - ! Move: BkGndImageWindow ;M #ENDIF --- 753,764 ---- InitScintillaControl \ for the editor ;M + + :M Canvas: ( -- x y w h ) + 0 Height: TheRebar dup>r ( -- x y ) + Width Height Height: statuswindow - r> - ;M #IFDEF withbgnd :M ReDrawImage: ( -- ) ! Canvas: self Move: BkGndImageWindow ;M #ENDIF *************** *** 725,729 **** \+ withbgnd ReDrawImage: self Redraw: statuswindow ! ;M /* ***************** Toolbar handlers *********************** */ --- 768,772 ---- \+ withbgnd ReDrawImage: self Redraw: statuswindow ! SizeHelpWindow ;M /* ***************** Toolbar handlers *********************** */ *************** *** 732,735 **** --- 775,779 ---- if \+ withbgnd RedrawImage: self + SizeHelpWindow then *************** *** 830,839 **** Close: Monitor \+ withbgnd Close: BkGndImageWindow ! Close: frmCreateToolBar Close: frmProperties++ ! Close: FFHelpWindow ! Close: frmCreateSplitterWindow ! Close: frmCreateMenuForm ! \ Close: SCIWIndow Close: super ;M --- 874,884 ---- Close: Monitor \+ withbgnd Close: BkGndImageWindow ! Close: frmCreateToolBar Close: frmProperties++ ! Close: FFHelpWindow ! Close: frmCreateSplitterWindow ! Close: frmCreateMenuForm ! Close: frmFormPad ! Close: frmCreatePropertyForm Close: super ;M *************** *** 856,860 **** ZeroMenu: CurrentMenu then Delete: ControlFont ! picturebmp ?dup if Call DeleteObject drop 0 to picturebmp --- 901,905 ---- ZeroMenu: CurrentMenu then Delete: ControlFont ! picturebmp ?dup if Call DeleteObject drop 0 to picturebmp *************** *** 864,868 **** then ExitScintillaControl \+ sysgen 0 Call PostQuitMessage ! \+ sysgen msg-buffer off \ set as no longer running On_Done: super 0 ;M --- 909,913 ---- then ExitScintillaControl \+ sysgen 0 Call PostQuitMessage ! \+ sysgen false fform-started \ set as no longer running On_Done: super 0 ;M *************** *** 900,904 **** #Forms 0= ?exit 0 to cnt \ reset - Link#: FormList >r param-buffer cell+ to tmp #Forms 1+ 1 --- 945,948 ---- *************** *** 911,915 **** else 2drop then ! loop r> >Link#: FormList ; : send-forms ( -- ) --- 955,959 ---- else 2drop then ! loop ; : send-forms ( -- ) *************** *** 942,948 **** ActiveControl: Activeform if Updat... [truncated message content] |
