Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthInstaller Installerform.f, NONE, 1.1 LinksInGroup.f, NONE, 1.1 Win32ForthInstaller.f, 1.1, 1.2
|
From: Jos v.d.V. <jo...@us...> - 2016-01-11 20:05:22
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv6380 Modified Files: Win32ForthInstaller.f Added Files: Installerform.f LinksInGroup.f Log Message: Jos: Exteded the installer for optional shortcuts --- NEW FILE: LinksInGroup.f --- Anew -LinksInGroup.f s" apps\Setup" "fpath+ needs Setup_dtop_lnk.f needs Mkdir.f #define CSIDL_PROGRAMS 0x0002 \ <user name>\Start Menu\Programs : create_link_group ( name$ cnt -- dirSpec cnt ) CSIDL_PROGRAMS GetSpecialFolderLocation link-location$ place s" \" link-location$ +place link-location$ +place link-location$ count mkdir ; : create_links_in_group ( -- ) init_dtop_for_link s" Win32Forth" create_link_group create_links_in_location CoUninitialize ; \s Index: Win32ForthInstaller.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller/Win32ForthInstaller.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Win32ForthInstaller.f 9 Jan 2016 14:51:18 -0000 1.1 --- Win32ForthInstaller.f 11 Jan 2016 20:05:20 -0000 1.2 *************** *** 9,28 **** needs lz77files.f needs Browsefld.f ! ! : msgboxEx { \ title$ message$ -- } ( adr2 len2 adr1 len1 type - button ) ! MAXSTRING localAlloc: message$ ! MAXSTRING localAlloc: title$ ! >r ! message$ place message$ +NULL ! title$ place title$ +NULL ! r> ! title$ 1+ message$ 1+ ! conhndl call MessageBox ! ; ! ! : qbox { \ title$ message$ -- } ( adr2 len2 adr1 len1 - button ) ! [ MB_YESNO MB_ICONQUESTION or MB_TASKMODAL or MB_SETFOREGROUND or ] literal msgboxEx ! ; ! only forth also installer also forth definitions --- 9,13 ---- needs lz77files.f needs Browsefld.f ! needs Installerform.f only forth also installer also forth definitions *************** *** 123,126 **** --- 108,112 ---- ; + : BuildApps ( - ) cr ." -- Win32Forth support files:" cr *************** *** 177,182 **** : create-links ( - ) cr ." -- Create links" ! s" idir apps\Setup fload Setup_dtop_lnk.f create_links_on_desktop bye" ! ProcexecNew ; --- 163,174 ---- : create-links ( - ) cr ." -- Create links" ! LinksOnDesktop- ! if s" idir apps\Setup fload Setup_dtop_lnk.f create_links_on_desktop bye" ! ProcexecNew ! then ! LinksInMenu- ! if s" idir apps\Win32ForthInstaller fload LinksInGroup.f create_links_in_group bye" ! ProcexecNew ! then ; *************** *** 237,248 **** ; ! : Install_Y/N? ( - flag ) ! OverwriteTest if s" Warning: OVERWRITING a previous Win32Forth installation." ." Warning: Found a previous Win32Forth installation." cr ." The install directory should be empty." cr cr else s" Installing Win32Forth." ! then ! s" Would you like to install Win32Forth?" qbox IDYES = ; --- 229,244 ---- ; ! : WaitOnStartInstallForm ( - Flag ) ! begin 200 ms winpause IdOnClose 0<> until IdOnClose IDOK = ! ; ! ! : Install_Y/N? ( - ) ! 0 to IdOnClose OverwriteTest if s" Warning: OVERWRITING a previous Win32Forth installation." ." Warning: Found a previous Win32Forth installation." cr ." The install directory should be empty." cr cr else s" Installing Win32Forth." ! then TitleInstallForm place ! Start: InstallForm WaitOnStartInstallForm ; *************** *** 287,291 **** previous ! : StartInstallWin32Forth ( - ) Start: LiveLogWindow InstallWin32Forth ; chdir .. --- 283,291 ---- previous ! : StartInstallWin32Forth ( - ) ! Start: LiveLogWindow ! GetHandle: LiveLogWindow SetParent: InstallForm ! InstallWin32Forth ! ; chdir .. --- NEW FILE: Installerform.f --- Anew Installerform.f \- textbox Require excontrols.f 0 value IdOnClose string: TitleInstallForm s" Warning: OVERWRITING a previous Win32Forth installation." TitleInstallForm place 0 value LinksOnDesktop- 0 value LinksInMenu- :Object InstallForm <Super DialogWindow Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color PushButton Button1 PushButton Button2 GroupBox Group1 CheckBox Check1 CheckBox Check2 Label Label1 :M ClassInit: ( -- ) ClassInit: super \ Insert your code here, e.g initialize variables, values etc. ;M :M WindowStyle: ( -- style ) WS_DLGFRAME ;M \ N.B if this form is a modal form a non-zero parent must be set :M ParentWindow: ( -- hwndparent | 0 if no parent ) hWndParent ;M :M WindowTitle: ( -- ztitle ) TitleInstallForm dup +null 1+ ;M :M StartSize: ( -- width height ) 480 263 ;M :M StartPos: ( -- x y ) CenterWindow: Self ;M :M Close: ( -- ) \ Insert your code here, e.g any data entered in form that needs to be saved Close: super ;M : HandleId ( Id - ) IsButtonChecked?: Check1 to LinksOnDesktop- IsButtonChecked?: Check2 to LinksInMenu- to IdOnClose close: Self ; : HandleButtons ( Action/Button - ) case IDOK of IDOK HandleId endof IDcancel of IDcancel HandleId endof endcase ; :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 drop HandleButtons else 2drop \ drop ID and object address then 0 ;M :M SetCommand: ( cfa -- ) \ set WMCommand function to WMCommand-Func ;M :M On_Init: ( -- ) On_Init: Super s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont Create: WinFont \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor IDOK SetID: Button1 self Start: Button1 130 210 100 25 Move: Button1 Handle: Winfont SetFont: Button1 s" Yes" SetText: Button1 IDCANCEL SetID: Button2 self Start: Button2 240 210 100 25 Move: Button2 Handle: Winfont SetFont: Button2 s" No" SetText: Button2 self Start: Check1 150 60 210 27 Move: Check1 true Check: Check1 Handle: Winfont SetFont: Check1 s" Add shorcuts on the desktop" SetText: Check1 self Start: Check2 150 100 210 28 Move: Check2 Handle: Winfont SetFont: Check2 s" Add shortcuts to the Start menu" SetText: Check2 win8 winver = if false Check: Check2 Disable: Check2 else true Check: Check2 then self Start: Group1 131 27 212 111 Move: Group1 Handle: Winfont SetFont: Group1 s" Options" SetText: Group1 self Start: Label1 149 160 220 44 Move: Label1 Handle: Winfont SetFont: Label1 s" Would you like to install Win32Forth?" SetText: Label1 ;M :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc ;M :M On_Done: ( -- ) Delete: WinFont \ Insert your code here, e.g delete fonts, any bitmaps etc. On_Done: super ;M ;Object \s |
