Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Jos v.d.V. <jo...@us...> - 2005-09-25 15:19:35
|
Update of /cvsroot/win32forth/win32forth/apps/Solipon2 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5838/apps/Solipon2 Modified Files: SOLIPION.F Log Message: Removed the centering. Since it made Solipon unplayable. Index: SOLIPION.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/SOLIPION.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** SOLIPION.F 25 Sep 2005 15:11:38 -0000 1.4 --- SOLIPION.F 25 Sep 2005 15:19:28 -0000 1.5 *************** *** 437,444 **** ;M - :M StartPos: ( -- x y ) - CenterWindow: Self - ;M - :M WindowTitle: ( -- Zstring ) \ window caption z" SoliPion" --- 437,440 ---- |
|
From: Jos v.d.V. <jo...@us...> - 2005-09-25 15:11:47
|
Update of /cvsroot/win32forth/win32forth/apps/Solipon2 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4563/apps/Solipon2 Modified Files: SOLIPION.F Log Message: Center the main window Index: SOLIPION.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/SOLIPION.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** SOLIPION.F 12 Jun 2005 08:37:35 -0000 1.3 --- SOLIPION.F 25 Sep 2005 15:11:38 -0000 1.4 *************** *** 437,440 **** --- 437,444 ---- ;M + :M StartPos: ( -- x y ) + CenterWindow: Self + ;M + :M WindowTitle: ( -- Zstring ) \ window caption z" SoliPion" *************** *** 1695,1699 **** Start: SOLIPIONW StartPos: SOLIPIONW 50 + swap 50 + swap message-origin ! ['] ok_there! SetClickFunc: SOLIPIONW \ execute ok_there! if left-klick ['] ok_there! SetDblClickFunc: SOLIPIONW \ execute ok_there! if double-klick --- 1699,1703 ---- Start: SOLIPIONW StartPos: SOLIPIONW 50 + swap 50 + swap message-origin ! ['] ok_there! SetClickFunc: SOLIPIONW \ execute ok_there! if left-klick ['] ok_there! SetDblClickFunc: SOLIPIONW \ execute ok_there! if double-klick *************** *** 1820,1822 **** s" apps\Solipon2\solipion.ico" s" solipion.exe" AddAppIcon 1 pause-seconds ! |
|
From: Jos v.d.V. <jo...@us...> - 2005-09-25 14:27:54
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28668/apps/Player4 Modified Files: PLAYER4.F PLAYER4.frm Log Message: Centering the player. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** PLAYER4.F 7 Aug 2005 09:44:50 -0000 1.19 --- PLAYER4.F 25 Sep 2005 14:27:42 -0000 1.20 *************** *** 159,162 **** --- 159,166 ---- ; + :M StartPos: ( -- x y ) + CenterWindow: Self + ;M + : drawline ( -- ) SeparatorX 0 MoveTo: dc *************** *** 217,221 **** ['] on_unclicked to unclick-func ! catalog-exist? if map-config-file map-database --- 221,225 ---- ['] on_unclicked to unclick-func ! GetHandle: Self SetParent: ControlCenter catalog-exist? if map-config-file map-database *************** *** 542,544 **** PLAYER4 [then] ! |
|
From: Jos v.d.V. <jo...@us...> - 2005-09-25 14:14:43
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26209/src Modified Files: Window.f Log Message: Makes centering of windows possible. A number of sources need to be changed, since the int Parent is now in the Generic-Window Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Window.f 5 Sep 2005 15:51:46 -0000 1.5 --- Window.f 25 Sep 2005 14:14:34 -0000 1.6 *************** *** 119,122 **** --- 119,138 ---- THEN 0 ; + : GetDeskTopSize ( -- w h ) + 0 pad 0 spi_getworkarea Call SystemParametersInfo DROP + pad 8 + 2@ swap + ; + + : MidPoint ( x y w h - mx my ) rot + 2/ -rot + 2/ swap ; + + : CenterAroundMidpoint { mx my w h } ( mx my w h - xl yl ) + GetDeskTopSize 40 - + my h 2/ - 0 max + swap h - min + mx w 2/ - 0 max + rot w - min + swap + ; + \ ------------------------------------------------------------ *************** *** 151,154 **** --- 167,171 ---- WinDC dc \ The window's device context 16 cells bytes &ps \ pointer to paint structure + int Parent int mydialoglink *************** *** 245,253 **** :M StartSize: ( -- width height ) Width Height ;M \ override to change - :M StartPos: ( -- left top ) - OriginX - OriginY - ;M - :M SetOrigin: ( x y -- ) screen-size 100 - rot min 0max to OriginY --- 262,265 ---- *************** *** 362,366 **** 4 to wndExtra appInst to hInstance ! DefaultIcon: [ self ] to hIcon DefaultCursor: [ self ] NULL Call LoadCursor to hCursor WHITE_BRUSH Call GetStockObject to hbrBackground --- 374,378 ---- 4 to wndExtra appInst to hInstance ! DefaultIcon: [ self ] to hIcon DefaultCursor: [ self ] NULL Call LoadCursor to hCursor WHITE_BRUSH Call GetStockObject to hbrBackground *************** *** 377,383 **** : create-frame-window ( -- hwnd ) ! \ calc window rect 0 0 \ adjust x,y relative to 0,0 StartSize: [ self ] \ width, height SetRect: WinRect --- 389,396 ---- : create-frame-window ( -- hwnd ) ! \ calc window rect 0 0 \ adjust x,y relative to 0,0 StartSize: [ self ] \ width, height + 2dup to Height to Width \ Save Height Width SetRect: WinRect *************** *** 388,392 **** call AdjustWindowRectEx ?win-error \ adjust the window ! \ create the window ^base \ creation parameters appInst \ program instance --- 401,405 ---- call AdjustWindowRectEx ?win-error \ adjust the window ! \ create the window ^base \ creation parameters appInst \ program instance *************** *** 413,418 **** ;M ! :M ParentWindow: ( -- parent ) \ return the parent, or 0 = no parent ! 0 ;M --- 426,435 ---- ;M ! :M ParentWindow: ( -- hwndparent | 0 if no parent ) ! Parent ! ;M ! ! :M SetParent: ( hwndParent -- ) \ set owner window ! to Parent ;M *************** *** 533,536 **** --- 550,574 ---- ;M + :M GetPositionParent: ( -- x y wb hb ) \ return upper-left corner + Parent dup 0> + if pad 16 erase + pad swap Call GetWindowRect ?win-error + pad 2@ swap pad 8 + 2@ swap + else drop 0 0 GetDeskTopSize \ take the desktop when there is no parent. + then + ;M + + :M CenterWindow: ( -- x y ) + GetPositionParent: Self + MidPoint + GetSize: self + CenterAroundMidpoint + ;M + + :M StartPos: ( -- left top ) + OriginX + OriginY + ;M + :M On_Done: ( -- ) ;M *************** *** 570,574 **** On_Init: [ self ] 0 ! ;M :M WM_DESTROY --- 608,612 ---- On_Init: [ self ] 0 ! ;M :M WM_DESTROY *************** *** 827,830 **** Call SendMessage drop ; ! : LoadIconFile ( adr len -- hIcon ) \ load an icon from a ico-file ! asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ; --- 865,869 ---- Call SendMessage drop ; ! : LoadIconFile ( adr len -- hIcon ) \ load an icon from a ico-file ! asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ; ! \s |
|
From: Dirk B. <db...@us...> - 2005-09-25 06:18:07
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4318/src Modified Files: REGISTRY.F Log Message: Changed PROGREG-INIT to reset the values "regBaseKey" and "regAccessMask", too. Index: REGISTRY.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/REGISTRY.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** REGISTRY.F 29 Aug 2005 15:56:27 -0000 1.7 --- REGISTRY.F 25 Sep 2005 06:17:54 -0000 1.8 *************** *** 11,20 **** \ 2003/09/08 dbu removed the registry entries 'Directory' and 'Version' \ Sonntag, Dezember 26 2004 dbu mostly rewritten ! \ Dienstag, Mai 24 2005 dbu \ - Changed to work with Rod's RegistrySupport.f ! \ - fixed a bug in (RegQueryValue) \ - removed the deprecated words .REGISTRY and RE-REGISTER \ - Expanded TAB's into spaces ! \ Mittwoch, Mai 25 2005 dbu \ - Some more changes to work with Rod's RegistrySupport.f --- 11,20 ---- \ 2003/09/08 dbu removed the registry entries 'Directory' and 'Version' \ Sonntag, Dezember 26 2004 dbu mostly rewritten ! \ Dienstag, Mai 24 2005 dbu \ - Changed to work with Rod's RegistrySupport.f ! \ - fixed a bug in (RegQueryValue) \ - removed the deprecated words .REGISTRY and RE-REGISTER \ - Expanded TAB's into spaces ! \ Mittwoch, Mai 25 2005 dbu \ - Some more changes to work with Rod's RegistrySupport.f *************** *** 50,54 **** 0 to Class 0 to Disposition ! &OF Disposition \ disposition value buffer &OF hkResult \ key handle --- 50,54 ---- 0 to Class 0 to Disposition ! &OF Disposition \ disposition value buffer &OF hkResult \ key handle *************** *** 60,64 **** lpSubKey \ subkey name hKey \ handle to open key ! call RegCreateKeyEx ERROR_SUCCESS = if hkResult else INVALID_HANDLE_VALUE then ; --- 60,64 ---- lpSubKey \ subkey name hKey \ handle to open key ! call RegCreateKeyEx ERROR_SUCCESS = if hkResult else INVALID_HANDLE_VALUE then ; *************** *** 91,94 **** --- 91,97 ---- create ProgReg MAXSTRING allot + HKEY_CURRENT_USER value regBaseKey + KEY_ALL_ACCESS value regAccessMask + : PROGREG-SET-BASE-PATH ( -- ) s" Win32Forth " ProgReg place *************** *** 97,108 **** : PROGREG-INIT ( -- ) ! PROGREG-SET-BASE-PATH s" Win32For\" ProgReg +place ; initialization-chain chain-add PROGREG-INIT PROGREG-INIT - HKEY_CURRENT_USER value regBaseKey - KEY_ALL_ACCESS value regAccessMask - INTERNAL --- 100,111 ---- : PROGREG-INIT ( -- ) ! PROGREG-SET-BASE-PATH s" Win32For\" ProgReg +place ! HKEY_CURRENT_USER to regBaseKey ! KEY_ALL_ACCESS to regAccessMask ! ; initialization-chain chain-add PROGREG-INIT PROGREG-INIT INTERNAL |
|
From: George H. <geo...@us...> - 2005-09-24 10:37:15
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13273/win32forth/src/lib Modified Files: bitmap.f Log Message: gah: altered method to fix bug in forthform Index: bitmap.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/bitmap.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** bitmap.f 21 Aug 2005 06:22:01 -0000 1.3 --- bitmap.f 24 Sep 2005 10:37:06 -0000 1.4 *************** *** 414,418 **** :M WM_LBUTTONUP ( h w m l -- ) WM_LBUTTONUP WM: Super ! Paint: self 0 ;M --- 414,420 ---- :M WM_LBUTTONUP ( h w m l -- ) WM_LBUTTONUP WM: Super ! hwnd Call IsWindow ! if Paint: self ! then 0 ;M |
|
From: Jos v.d.V. <jo...@us...> - 2005-09-21 12:41:05
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9218/apps/ForthForm Modified Files: FORMOBJECT.F Log Message: Got some problems when Parent was defined as a value. Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** FORMOBJECT.F 21 Aug 2005 06:22:00 -0000 1.5 --- FORMOBJECT.F 21 Sep 2005 12:40:39 -0000 1.6 *************** *** 1422,1426 **** if s" MultiStatusBar TheStatusBar" append&crlf then GetSuperclass: self DIALOG-CLASS = \ only for dialogwindow super class ! if s" 0 value parent \ pointer to parent of form" append&crlf SaveScreen? if frmXPos (.) append 1 +spaces frmYPos (.) append --- 1422,1426 ---- if s" MultiStatusBar TheStatusBar" append&crlf then GetSuperclass: self DIALOG-CLASS = \ only for dialogwindow super class ! if s" int parent \ pointer to parent of form" append&crlf SaveScreen? if frmXPos (.) append 1 +spaces frmYPos (.) append *************** *** 2000,2002 **** r> >Link#: FormList ; ! \s \ No newline at end of file --- 2000,2002 ---- r> >Link#: FormList ; ! \s |
|
From: Dirk B. <db...@us...> - 2005-09-19 15:32:45
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14027/apps/SciEdit Modified Files: ScintillaMDI.f Log Message: Removed some old debug code. Index: ScintillaMDI.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/ScintillaMDI.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ScintillaMDI.f 31 Aug 2005 17:03:19 -0000 1.4 --- ScintillaMDI.f 19 Sep 2005 15:32:36 -0000 1.5 *************** *** 292,299 **** :M EnableStripTrailingSpaces: ( f -- ) ! cr dup space to StripTrailingSpaces? ;M :M EnableEnsureFinalNewLine: ( f -- ) ! cr dup space to EnsureFinalNewLine? ;M :M SetEOL: ( eolMode -- ) --- 292,299 ---- :M EnableStripTrailingSpaces: ( f -- ) ! to StripTrailingSpaces? ;M :M EnableEnsureFinalNewLine: ( f -- ) ! to EnsureFinalNewLine? ;M :M SetEOL: ( eolMode -- ) *************** *** 372,376 **** : SaveText ( -- ) \ save the Text in the control to the file ! cr StripTrailingSpaces? dup . space if StripTrailingSpaces: self --- 372,376 ---- : SaveText ( -- ) \ save the Text in the control to the file ! StripTrailingSpaces? dup . space if StripTrailingSpaces: self *************** *** 387,391 **** \ adjust the Text length in the EditFile because ! \ the Scintilla-Control returns on null byte at the \ end of the Text. Thank's Ezra for telling me about this \ bug (Freitag, August 19 2005 - dbu) --- 387,391 ---- \ adjust the Text length in the EditFile because ! \ the Scintilla-Control returns a null byte at the \ end of the Text. Thank's Ezra for telling me about this \ bug (Freitag, August 19 2005 - dbu) |
|
From: Dirk B. <db...@us...> - 2005-09-18 11:10:42
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13823/demos Added Files: FlashControlDemo.f HtmlControlDemo.f PdfControlDemo.f clock.swf Log Message: - Moved the demo code for the new ActiveX controls into seperate files in the Demos-Folder - Added two new tool's for exploring ActiveX controls - Added some notes about the new COM and ActiveX support to the release notes. --- NEW FILE: HtmlControlDemo.f --- \ $Id: HtmlControlDemo.f,v 1.1 2005/09/18 11:10:31 dbu_de Exp $ \ Demo for the HTML Control \ Thomas Dixon cr .( Loading Html Control Demo...) anew -HtmlControlDemo.f needs HtmlControl.f \ Create a simple browser window :class Browserwin <super window HTMLcontrol html :M On_Init: ( -- ) On_Init: super self Start: html ;M :M On_Size: ( h m w -- ) 2drop drop autosize: html ;M :M GetPath: ( -- str len ) GetPath: html ;M :M GetLocationURL: ( -- str len ) GetLocationURL: html ;M :M GetLocationName: ( -- str len ) GetLocationName: html ;M :M Busy?: ( -- flag ) Busy?: html ;M :M GoHome: ( -- ) GoHome: html ;M :M GoSearch: ( -- ) GoSearch: html ;M :M GoForward: ( -- ) GoForward: html ;M :M GoBack: ( -- ) GoBack: html ;M :M Refresh: ( -- ) Refresh: html ;M :M Stop: ( -- ) Stop: html ;M :M GoURL: ( str len -- ) GoURL: html ;M ;class BrowserWin bwin start: bwin \ s" www.win32forth.org" GoURL: bwin s" doc\p-relnotes.6.12.htm" Prepend<home>\ GoURL: bwin --- NEW FILE: FlashControlDemo.f --- \ $Id: FlashControlDemo.f,v 1.1 2005/09/18 11:10:31 dbu_de Exp $ \ Demo for Shockwave Flash control \ Tom Dixon cr .( Loading Flash Control Demo...) anew -FlashControlDemo.f needs FlashControl.f :class Flashwin <super window Flashcontrol fcntrl :M On_Init: ( -- ) On_Init: super self Start: fcntrl ;M :M On_Size: ( h m w -- ) 2drop drop autosize: fcntrl ;M \ ShockWave Methods :M PutMovie: ( str len -- f ) PutMovie: fcntrl ;M :M GetMovie: ( -- str len ) GetMovie: fcntrl ;M :M Play: ( -- ) Play: fcntrl ;M :M Stop: ( -- ) Stop: fcntrl ;M :M Back: ( -- ) Back: fcntrl ;M :M Forward: ( -- ) Forward: fcntrl ;M :M Rewind: ( -- ) Rewind: fcntrl ;M :M StopPlay: ( -- ) StopPlay: fcntrl ;M :M GotoFrame: ( n -- ) GotoFrame: fcntrl ;M :M CurrentFrame: ( -- n ) CurrentFrame: fcntrl ;M :M TotalFrames: ( -- n ) TotalFrames: fcntrl ;M :M Playing?: ( -- flag ) Playing?: fcntrl ;M :M Loaded%: ( -- percent ) Loaded%: fcntrl ;M :M Loop: ( flag -- ) Loop: fcntrl ;M :M Loop?: ( -- flag ) Loop?: fcntrl ;M :M Pan: ( n n n -- ) Pan: fcntrl ;M :M Zoom: ( n -- ) Zoom: fcntrl ;M :M SetZoomRect: ( n n n n -- ) SetZoomRect: fcntrl ;M :M BGColor: ( -- color ) BGColor: fcntrl ;M :M SetBGColor: ( color -- ) SetBGColor: fcntrl ;M ;class Flashwin fwin start: fwin 0x808080 setbgcolor: fwin s" demos\clock.swf" Prepend<home>\ putmovie: fwin drop true loop: fwin --- NEW FILE: PdfControlDemo.f --- \ $Id: PdfControlDemo.f,v 1.1 2005/09/18 11:10:31 dbu_de Exp $ \ Demo for the Acrobat PDF Control \ Thomas Dixon cr .( Loading PDF Control Demo...) anew -PdfControlDemo.f needs PdfControl.f \ Create a simple pdf window :class PDFwin <super window PDFControl pdf :M On_Init: ( -- ) On_Init: super self Start: pdf ;M :M On_Size: ( h m w -- ) 2drop drop autosize: pdf ;M :M LoadFile: ( str len -- flag ) LoadFile: pdf ;M :M SetPage: ( n -- ) SetPage: pdf ;M :M gotoFirstPage: ( -- ) gotoFirstPage: pdf ;M :M gotoLastPage: ( -- ) gotoLastPage: pdf ;M :M gotoNextPage: ( -- ) gotoNextPage: pdf ;M :M gotoPreviousPage: ( -- ) gotoPreviousPage: pdf ;M :M goForward: ( -- ) goForward: pdf ;M :M goBack: ( -- ) goBack: pdf ;M :M Print: ( -- ) Print: pdf ;M :M PrintWithDialog: ( -- ) PrintWithDialog: pdf ;M :M PrintPages: ( n n -- ) PrintPages: pdf ;M :M PrintPagesFit: ( flag n n -- ) PrintPagesFit: pdf ;M :M PrintAll: ( -- ) PrintAll: pdf ;M :M PrintAllFit: ( bool -- ) PrintAllFit: pdf ;M :M SetZoom: ( float -- ) SetZoom: pdf ;M :M SetZoomScroll: ( float float float -- ) SetZoomScroll: pdf ;M :M SetViewRect: ( float float float float -- ) SetViewRect: pdf ;M :M SetPageMode: ( str len -- ) SetPageMode: pdf ;M :M SetLayoutMode: ( str len -- ) SetLayoutMode: pdf ;M :M SetNamedDest: ( str len -- ) SetNamedDest: pdf ;M :M SetShowToolbar: ( flag -- ) SetShowToolbar: pdf ;M :M SetShowScrollbars: ( flag -- ) SetShowScrollbars: pdf ;M :M Aboutbox: ( -- ) Aboutbox: pdf ;M ;class \ This should load a pdf file and display it in a window pdfwin pwin start: pwin s" doc\Forth_Primer.pdf" Prepend<home>\ loadfile: pwin drop \ I don't think the PDF viewer was ever ment to be used as an embedded control \ It only supports the dispatch interface and updates (such as resizing) are rather slow --- NEW FILE: clock.swf --- (This appears to be a binary file; contents omitted.) |
|
From: Dirk B. <db...@us...> - 2005-09-18 11:10:41
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13823/src/lib Modified Files: AXControl.F FCOM.F FlashControl.F HTMLcontrol.F PDFControl.F Log Message: - Moved the demo code for the new ActiveX controls into seperate files in the Demos-Folder - Added two new tool's for exploring ActiveX controls - Added some notes about the new COM and ActiveX support to the release notes. Index: AXControl.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/AXControl.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** AXControl.F 15 Sep 2005 16:31:38 -0000 1.1 --- AXControl.F 18 Sep 2005 11:10:31 -0000 1.2 *************** *** 1,6 **** \ ActiveX Control Class \ Thomas Dixon - anew -AXControl.F --- 1,7 ---- + \ $Id$ + \ ActiveX Control Class \ Thomas Dixon anew -AXControl.F *************** *** 40,47 **** \s window win start: win axcontrol ax win start: ax ! s" MSCAL.Calendar.7" axcreate: ax autosize: ax --- 41,79 ---- \s + \ AXControl is a class that can be treated like any other control in + \ win32forth, except it is enabled to host an activex component. A short + \ example of it's usage: + window win start: win axcontrol ax win start: ax ! s" MSCAL.Calendar" axcreate: ax autosize: ax + + \ The example here hosts a calandar control by it's progid. + \ In order to see this work properly, you need to have that activex + \ control installed on your machine. ProgID's may also have some + \ version control to them. "MSCAL.Calendar.7" as the progid would + \ only host version 7 of the caladar control. + \ + \ You may also use the string of the clsid that you want to use instead of + \ the progid, if it suits your purposes better. Ex: + \ + \ s" {8E27C92B-1264-101C-8A2F-040224009C02}" axcreate: ax + \ autosize: ax + \ + \ You may also use a url if you want: + \ + \ s" http://www.google.com" axcreate: ax + \ autosize: ax + \ + \ You may also give it html code, if it is proceeded by "MSHTML:" Ex: + \ + \ s" MSHTML:<HTML><BODY>Hello World!</BODY></HTML>" axcreate: ax + \ autosize: ax + \ + \ + \ Just having the control there is nice, but the REAL trick is to + \ communicate with it and exchange data back and forth. The way that + \ this is done is by getting the control's interface and using it. Index: FlashControl.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FlashControl.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FlashControl.F 15 Sep 2005 16:31:38 -0000 1.1 --- FlashControl.F 18 Sep 2005 11:10:31 -0000 1.2 *************** *** 1,5 **** --- 1,9 ---- + \ $Id$ + \ Shockwave Flash control written in forth \ Tom Dixon + anew -FlashControl + needs AXControl *************** *** 53,102 **** \ We don't need the typelibrary anymore, so unload it now. - free-lasttypelib \s ! \ Example: ! ! :class Flashwin <super window ! Flashcontrol fcntrl ! ! :M On_Init: ( -- ) ! On_Init: super ! self Start: fcntrl ;M ! ! :M On_Size: ( h m w -- ) 2drop drop autosize: fcntrl ;M ! ! \ ShockWave Methods ! :M PutMovie: ( str len -- f ) PutMovie: fcntrl ;M ! :M GetMovie: ( -- str len ) GetMovie: fcntrl ;M ! :M Play: ( -- ) Play: fcntrl ;M ! :M Stop: ( -- ) Stop: fcntrl ;M ! :M Back: ( -- ) Back: fcntrl ;M ! :M Forward: ( -- ) Forward: fcntrl ;M ! :M Rewind: ( -- ) Rewind: fcntrl ;M ! :M StopPlay: ( -- ) StopPlay: fcntrl ;M ! :M GotoFrame: ( n -- ) GotoFrame: fcntrl ;M ! :M CurrentFrame: ( -- n ) CurrentFrame: fcntrl ;M ! :M TotalFrames: ( -- n ) TotalFrames: fcntrl ;M ! :M Playing?: ( -- flag ) Playing?: fcntrl ;M ! :M Loaded%: ( -- percent ) Loaded%: fcntrl ;M ! :M Loop: ( flag -- ) Loop: fcntrl ;M ! :M Loop?: ( -- flag ) Loop?: fcntrl ;M ! :M Pan: ( n n n -- ) Pan: fcntrl ;M ! :M Zoom: ( n -- ) Zoom: fcntrl ;M ! :M SetZoomRect: ( n n n n -- ) SetZoomRect: fcntrl ;M ! :M BGColor: ( -- color ) BGColor: fcntrl ;M ! :M SetBGColor: ( color -- ) SetBGColor: fcntrl ;M ! ! ;class ! ! Flashwin fwin ! start: fwin ! 0 setbgcolor: fwin ! s" c:\temp\swf\f02[1].swf" putmovie: fwin drop ! true loop: fwin ! ! ! ! --- 57,62 ---- \ We don't need the typelibrary anymore, so unload it now. free-lasttypelib \s ! for an example see demos\FlashControlDemo.f Index: HTMLcontrol.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/HTMLcontrol.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** HTMLcontrol.F 15 Sep 2005 16:31:38 -0000 1.1 --- HTMLcontrol.F 18 Sep 2005 11:10:31 -0000 1.2 *************** *** 1,5 **** --- 1,8 ---- + \ $Id$ + \ HTML Control \ Thomas Dixon + anew -HtmlControl.f needs AXControl *************** *** 54,96 **** \ We don't need the typelibrary anymore, so unload it now. - free-lasttypelib - \s ! ! \ Example: ! \ Create a simple browser window ! ! :class Browserwin <super window ! HTMLcontrol html ! ! :M On_Init: ( -- ) ! On_Init: super ! self Start: html ;M ! ! :M On_Size: ( h m w -- ) 2drop drop autosize: html ;M ! ! :M GetPath: ( -- str len ) GetPath: html ;M ! :M GetLocationURL: ( -- str len ) GetLocationURL: html ;M ! :M GetLocationName: ( -- str len ) GetLocationName: html ;M ! :M Busy?: ( -- flag ) Busy?: html ;M ! :M GoHome: ( -- ) GoHome: html ;M ! :M GoSearch: ( -- ) GoSearch: html ;M ! :M GoForward: ( -- ) GoForward: html ;M ! :M GoBack: ( -- ) GoBack: html ;M ! :M Refresh: ( -- ) Refresh: html ;M ! :M Stop: ( -- ) Stop: html ;M ! :M GoURL: ( str len -- ) GoURL: html ;M ! ! ;class ! ! BrowserWin bwin ! start: bwin ! \ gohome: bwin ! s" www.win32forth.org" GoURL: bwin ! \ and you should have a browser window at your home page ! ! ! ! --- 57,62 ---- \ We don't need the typelibrary anymore, so unload it now. free-lasttypelib \s ! \ Example: see demos\HtmlControlDemo.f Index: PDFControl.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/PDFControl.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** PDFControl.F 15 Sep 2005 16:31:38 -0000 1.1 --- PDFControl.F 18 Sep 2005 11:10:31 -0000 1.2 *************** *** 1,5 **** --- 1,8 ---- + \ $Id$ + \ Acrobat PDF Control \ Thomas Dixon + anew -PdfControl.f needs AXControl *************** *** 91,145 **** ;CLASS - \s - \ Example: - \ Create a simple pdf window - - :class PDFwin <super window - PDFControl pdf - - :M On_Init: ( -- ) - On_Init: super - self Start: pdf ;M - - :M On_Size: ( h m w -- ) 2drop drop autosize: pdf ;M - - :M LoadFile: ( str len -- flag ) LoadFile: pdf ;M - :M SetPage: ( n -- ) SetPage: pdf ;M - :M gotoFirstPage: ( -- ) gotoFirstPage: pdf ;M - :M gotoLastPage: ( -- ) gotoLastPage: pdf ;M - :M gotoNextPage: ( -- ) gotoNextPage: pdf ;M - :M gotoPreviousPage: ( -- ) gotoPreviousPage: pdf ;M - :M goForward: ( -- ) goForward: pdf ;M - :M goBack: ( -- ) goBack: pdf ;M - - :M Print: ( -- ) Print: pdf ;M - :M PrintWithDialog: ( -- ) PrintWithDialog: pdf ;M - :M PrintPages: ( n n -- ) PrintPages: pdf ;M - :M PrintPagesFit: ( flag n n -- ) PrintPagesFit: pdf ;M - :M PrintAll: ( -- ) PrintAll: pdf ;M - :M PrintAllFit: ( bool -- ) PrintAllFit: pdf ;M - - :M SetZoom: ( float -- ) SetZoom: pdf ;M - :M SetZoomScroll: ( float float float -- ) SetZoomScroll: pdf ;M - :M SetViewRect: ( float float float float -- ) SetViewRect: pdf ;M - - :M SetPageMode: ( str len -- ) SetPageMode: pdf ;M - :M SetLayoutMode: ( str len -- ) SetLayoutMode: pdf ;M - :M SetNamedDest: ( str len -- ) SetNamedDest: pdf ;M - - :M SetShowToolbar: ( flag -- ) SetShowToolbar: pdf ;M - :M SetShowScrollbars: ( flag -- ) SetShowScrollbars: pdf ;M - - :M Aboutbox: ( -- ) Aboutbox: pdf ;M - ;class - - pdfwin pwin - start: pwin - s" doc\Forth_Primer.pdf" Prepend<home>\ loadfile: pwin drop - - \ This should load a pdf file and display it in a window - \ I don't think the PDF viewer was ever ment to be used as an embedded control \ It only supports the dispatch interface and updates (such as resizing) are rather slow ! --- 94,100 ---- ;CLASS \ I don't think the PDF viewer was ever ment to be used as an embedded control \ It only supports the dispatch interface and updates (such as resizing) are rather slow ! \s ! \ Example: see demos/PdfControlDemo.f Index: FCOM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FCOM.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FCOM.F 15 Sep 2005 16:31:38 -0000 1.1 --- FCOM.F 18 Sep 2005 11:10:31 -0000 1.2 *************** *** 26,30 **** 3 proc LHashValOfNameSys ! DEFINED ISTR= NIP 0= [IF] synonym ISTR= STR(NC)= [THEN] \ unicode string functions --- 26,30 ---- 3 proc LHashValOfNameSys ! [UNDEFINED] ISTR= [IF] synonym ISTR= STR(NC)= [THEN] \ unicode string functions *************** *** 50,54 **** dup >r 2swap swap 0 0 WideCharToMultiByte drop r> zcount ; ! : >Unicode ( str len -- str len ) asc>uni 2dup new$ dup >r uniplace drop free drop r> unicount ; --- 50,54 ---- dup >r 2swap swap 0 0 WideCharToMultiByte drop r> zcount ; ! : >Unicode ( str len -- str len ) asc>uni 2dup new$ dup >r uniplace drop free drop r> unicount ; *************** *** 65,77 **** \ Defining GUIDs : hatoi number? 2drop ; ! : Guid, ( -- ) \ comments in a guid ! Base @ HEX BL Word count dup 38 <> abort" Invalid Guid Length" 1 /string 2dup ascii - scan 2dup >r >r nip - hatoi , r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup drop 2 0 do dup i 2 * + 2 hatoi c, loop drop ! ascii - scan ascii - skip drop 6 0 do dup i 2 * + 2 hatoi c, loop drop base ! ; : CLSID>Str ( addr -- str len ) --- 65,82 ---- \ Defining GUIDs + internal : hatoi number? 2drop ; + external ! : (Guid,) ( addr len -- ) \ comments in a guid ! Base @ >r HEX dup 38 <> abort" Invalid Guid Length" 1 /string 2dup ascii - scan 2dup >r >r nip - hatoi , r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup drop 2 0 do dup i 2 * + 2 hatoi c, loop drop ! ascii - scan ascii - skip drop 6 0 do dup i 2 * + 2 hatoi c, loop drop r> base ! ; ! ! : Guid, ( -- ) \ comments in a guid ! BL Word count (Guid,) ; : CLSID>Str ( addr -- str len ) *************** *** 91,95 **** : COMPILE-INTERFACE ( pointer imethod -- ) \ fast compile interface call ! POSTPONE @ POSTPONE dup POSTPONE @ cell+ @ cells POSTPONE lit , POSTPONE + POSTPONE @ POSTPONE call-proc ; --- 96,100 ---- : COMPILE-INTERFACE ( pointer imethod -- ) \ fast compile interface call ! POSTPONE @ POSTPONE dup POSTPONE @ cell+ @ cells POSTPONE lit , POSTPONE + POSTPONE @ POSTPONE call-proc ; *************** *** 110,115 **** : ComIFace ( interface -- ) create 0 , 16 + , IMMEDIATE does> state @ if dup POSTPONE lit , then ! dup peek rot cell+ @ search-iface ! if state @ if COMPILE-INTERFACE else RUN-INTERFACE then skip-word then state @ if drop then ; --- 115,120 ---- : ComIFace ( interface -- ) create 0 , 16 + , IMMEDIATE does> state @ if dup POSTPONE lit , then ! dup peek rot cell+ @ search-iface ! if state @ if COMPILE-INTERFACE else RUN-INTERFACE then skip-word then state @ if drop then ; *************** *** 119,126 **** : IMethod ( n -- ) \ n is vtable index ! here openiface 16 + @ , openiface 16 + ! , , ! here parse-word dup 1+ allot rot place ; ! : UCOM ( pointer -- ) \ call using an interface bl word find if execute else count type abort" Not an interface!" then peek rot 16 + search-iface --- 124,131 ---- : IMethod ( n -- ) \ n is vtable index ! here openiface 16 + @ , openiface 16 + ! , , ! here parse-word dup 1+ allot rot place ; ! : UCOM ( pointer -- ) \ call using an interface bl word find if execute else count type abort" Not an interface!" then peek rot 16 + search-iface *************** *** 241,246 **** \ Quick Structures - Not very usefull for anything but working with ! \ Com Interface structures, I wanted something simple that would allow ! \ levels of unions and stuff, so I made a quick structure thing. \ structure type --- 246,251 ---- \ Quick Structures - Not very usefull for anything but working with ! \ Com Interface structures, I wanted something simple that would allow ! \ levels of unions and stuff, so I made a quick structure thing. \ structure type *************** *** 392,396 **** 4 field: rgdispidNamedArgs \ Dispatch IDs of named arguments. 8 field: cArgs \ Number of arguments. ! 12 field: cNamedArgs \ Number of named arguments. close-struct --- 397,401 ---- 4 field: rgdispidNamedArgs \ Dispatch IDs of named arguments. 8 field: cArgs \ Number of arguments. ! 12 field: cNamedArgs \ Number of named arguments. close-struct *************** *** 483,487 **** $FFF constant VT_TYPEMASK \ used as a mask for vt_vector, array and what-not ! internal : vt>Str ( vt -- str len ) \ for type to string conversion --- 488,492 ---- $FFF constant VT_TYPEMASK \ used as a mask for vt_vector, array and what-not ! internal : vt>Str ( vt -- str len ) \ for type to string conversion *************** *** 634,638 **** else dup 0 ?do 42 emit loop nip 0 ?do usestruct typedesc lptdesc @ loop 0 >r rp@ swap usestruct typedesc hreftype @ argtypei UCOM ITypeinfo Getreftypeinfo drop ! 0 0 0 rp@ 0 >r rp@ -1 rot UCOM ITypeinfo GetDocumentation drop r@ zunicount unitype r> drop rp@ UCOM ITypeinfo ireleaseref drop r> drop 0 to argtypei then ; --- 639,643 ---- else dup 0 ?do 42 emit loop nip 0 ?do usestruct typedesc lptdesc @ loop 0 >r rp@ swap usestruct typedesc hreftype @ argtypei UCOM ITypeinfo Getreftypeinfo drop ! 0 0 0 rp@ 0 >r rp@ -1 rot UCOM ITypeinfo GetDocumentation drop r@ zunicount unitype r> drop rp@ UCOM ITypeinfo ireleaseref drop r> drop 0 to argtypei then ; *************** *** 656,662 **** tbuf @ usestruct funcdesc invkind @ INVOKE_PROPERTYPUT = if ." Put" then tbuf @ usestruct funcdesc invkind @ INVOKE_PROPERTYPUTREF = if ." PutRef" then ! dup 0 0 rot 0 tbuf 4 + rot tbuf @ @ swap UCOM ITypeinfo getdocumentation drop tbuf 4 + @ zunicount unitype space ." ( " ! tbuf @ usestruct funcdesc cparams w@ 0 ?do dup to argtypei tbuf @ dup usestruct funcdesc cparams w@ i - 1- arg>str space loop ." -- " --- 661,667 ---- tbuf @ usestruct funcdesc invkind @ INVOKE_PROPERTYPUT = if ." Put" then tbuf @ usestruct funcdesc invkind @ INVOKE_PROPERTYPUTREF = if ." PutRef" then ! dup 0 0 rot 0 tbuf 4 + rot tbuf @ @ swap UCOM ITypeinfo getdocumentation drop tbuf 4 + @ zunicount unitype space ." ( " ! tbuf @ usestruct funcdesc cparams w@ 0 ?do dup to argtypei tbuf @ dup usestruct funcdesc cparams w@ i - 1- arg>str space loop ." -- " *************** *** 675,685 **** tbuf @ usestruct vardesc elemdescvar tdesc vt w@ VT_USERDEFINED = if tbuf @ usestruct vardesc oInst @ . ! dup tbuf @ usestruct vardesc elemdescvar tdesc hreftype @ tbuf 4 + swap rot UCOM ITypeinfo GetRefTypeinfo drop ! 0 0 0 tbuf 8 + -1 tbuf 4 + UCOM ITypeinfo GetDocumentation drop ! tbuf 12 + tbuf 4 + UCOM Itypeinfo gettypeattr drop ! tbuf 12 + @ usestruct typeattr cbSizeInstance @ tbuf 12 + @ tbuf 4 + UCOM Itypeinfo releasetypeattr drop ! 4 > if tbuf 8 + @ zunicount unitype tbuf 4 + UCOM ITypeinfo ireleaseref drop ." Struct: " else --- 680,690 ---- tbuf @ usestruct vardesc elemdescvar tdesc vt w@ VT_USERDEFINED = if tbuf @ usestruct vardesc oInst @ . ! dup tbuf @ usestruct vardesc elemdescvar tdesc hreftype @ tbuf 4 + swap rot UCOM ITypeinfo GetRefTypeinfo drop ! 0 0 0 tbuf 8 + -1 tbuf 4 + UCOM ITypeinfo GetDocumentation drop ! tbuf 12 + tbuf 4 + UCOM Itypeinfo gettypeattr drop ! tbuf 12 + @ usestruct typeattr cbSizeInstance @ tbuf 12 + @ tbuf 4 + UCOM Itypeinfo releasetypeattr drop ! 4 > if tbuf 8 + @ zunicount unitype tbuf 4 + UCOM ITypeinfo ireleaseref drop ." Struct: " else *************** *** 707,711 **** dup tbuf i rot Ucom ITypeinfo getvardesc drop tbuf @ usestruct vardesc varkind @ VAR_CONST = ! if dup >r 0 0 0 tbuf 4 + tbuf @ @ r> UCOM ITypeInfo GetDocumentation drop tbuf 4 + @ zunicount unitype space tbuf over Ucom ITypeinfo releasevardesc drop --- 712,716 ---- dup tbuf i rot Ucom ITypeinfo getvardesc drop tbuf @ usestruct vardesc varkind @ VAR_CONST = ! if dup >r 0 0 0 tbuf 4 + tbuf @ @ r> UCOM ITypeInfo GetDocumentation drop tbuf 4 + @ zunicount unitype space tbuf over Ucom ITypeinfo releasevardesc drop *************** *** 713,720 **** : globaltype ( type typelib -- ) ! dup UCOM ITypeLib GetTypeInfoCount 0 ?do 2dup tbuf i rot UCOM ITypeLib GetTypeInfoType abort" Unable to get type info" tbuf @ = if dup 0 0 rot 0 tbuf rot i swap UCOM ITypeLib GetDocumentation ! abort" Unable to get Documentation!" tbuf @ zunicount unitype space then loop 2drop ; --- 718,725 ---- : globaltype ( type typelib -- ) ! dup UCOM ITypeLib GetTypeInfoCount 0 ?do 2dup tbuf i rot UCOM ITypeLib GetTypeInfoType abort" Unable to get type info" tbuf @ = if dup 0 0 rot 0 tbuf rot i swap UCOM ITypeLib GetDocumentation ! abort" Unable to get Documentation!" tbuf @ zunicount unitype space then loop 2drop ; *************** *** 722,729 **** create typelibhead 0 , ! external : typelib ( major minor | guid -- ) \ load a type library into the list ! here typelibhead dup @ , ! here dup >r 0 , here 0 , 2swap swap here guid, LoadRegTypeLib abort" Error Loading Type Library" --- 727,734 ---- create typelibhead 0 , ! external : typelib ( major minor | guid -- ) \ load a type library into the list ! here typelibhead dup @ , ! here dup >r 0 , here 0 , 2swap swap here guid, LoadRegTypeLib abort" Error Loading Type Library" *************** *** 731,749 **** : CoClasses ( -- ) \ print a list of all available coclasses ! cr typelibhead begin @ dup while ! dup cell+ TKIND_COCLASS swap globaltype repeat drop ; ! : Interfaces ( -- ) \ print a list of all available coclasses ! cr typelibhead begin @ dup while ! dup cell+ TKIND_INTERFACE swap globaltype ! dup cell+ TKIND_DISPATCH swap globaltype repeat drop ; ! : Structures ( -- ) \ print a list of all available coclasses ! cr typelibhead begin @ dup while ! dup cell+ TKIND_RECORD swap globaltype repeat drop ; : ComConsts ( -- ) \ print a list of all constants ! cr typelibhead begin @ dup while ! dup cell+ TKIND_ENUM swap globaltype repeat drop ; internal --- 736,754 ---- : CoClasses ( -- ) \ print a list of all available coclasses ! typelibhead begin @ dup while ! dup cell+ TKIND_COCLASS swap globaltype repeat drop ; ! : Interfaces ( -- ) \ print a list of all available interfaces ! typelibhead begin @ dup while ! dup cell+ TKIND_INTERFACE swap globaltype ! dup cell+ TKIND_DISPATCH swap globaltype repeat drop ; ! : Structures ( -- ) \ print a list of all available structures ! typelibhead begin @ dup while ! dup cell+ TKIND_RECORD swap globaltype repeat drop ; : ComConsts ( -- ) \ print a list of all constants ! typelibhead begin @ dup while ! dup cell+ TKIND_ENUM swap globaltype repeat drop ; internal *************** *** 772,776 **** : funcbind ( obj funcdesc tinfo -- ) \ function >r rp@ UCOM ITypeInfo IReleaseref drop r> drop ! dup funcoff swap CoTaskMemFree drop state @ if POSTPONE @ POSTPONE dup POSTPONE @ POSTPONE lit , POSTPONE + POSTPONE @ POSTPONE call-proc --- 777,781 ---- : funcbind ( obj funcdesc tinfo -- ) \ function >r rp@ UCOM ITypeInfo IReleaseref drop r> drop ! dup funcoff swap CoTaskMemFree drop state @ if POSTPONE @ POSTPONE dup POSTPONE @ POSTPONE lit , POSTPONE + POSTPONE @ POSTPONE call-proc *************** *** 800,804 **** : do-struct ( offset itypecomp -- offset ) peek >unicode drop swap >bind ! DESCKIND_VARDESC = if bl word drop over nested-struc? ?dup if 0 >r rp@ swap rot >r rp@ UCOM ITypeInfo GetRefTypeInfo drop --- 805,809 ---- : do-struct ( offset itypecomp -- offset ) peek >unicode drop swap >bind ! DESCKIND_VARDESC = if bl word drop over nested-struc? ?dup if 0 >r rp@ swap rot >r rp@ UCOM ITypeInfo GetRefTypeInfo drop *************** *** 866,870 **** ?dup if >r rp@ UCOM ITypeInfo IReleaseref drop r> drop then ?dup if CoTaskMemFree drop then ! ?dup if dup DESCKIND_VARDESC = swap DESCKIND_TYPECOMP = or if 2drop true exit else 2drop false exit then then swap >bindtype ?dup if --- 871,875 ---- ?dup if >r rp@ UCOM ITypeInfo IReleaseref drop r> drop then ?dup if CoTaskMemFree drop then ! ?dup if dup DESCKIND_VARDESC = swap DESCKIND_TYPECOMP = or if 2drop true exit else 2drop false exit then then swap >bindtype ?dup if *************** *** 879,888 **** repeat ; ! : comfind ( str -- str 0 | cfa flag ) [ defer@ find literal ] execute \ call previous find word ! ?dup 0= if count 0 ?typelib if ['] noop 1 else drop 1- 0 then then ; ! ' comfind is find \ Late-Binding for Types in typelibraries (needed only for interfaces and structures) --- 884,893 ---- repeat ; ! : comfind ( str -- str 0 | cfa flag ) [ defer@ find literal ] execute \ call previous find word ! ?dup 0= if count 0 ?typelib if ['] noop 1 else drop 1- 0 then then ; ! ' comfind is find \ Late-Binding for Types in typelibraries (needed only for interfaces and structures) *************** *** 911,916 **** if state @ if COMPILE-INTERFACE else RUN-INTERFACE then bl word drop then else \ automated interface ! drop typelibhead begin @ dup while ! dup 2 cells + peek rot istype? if 2 cells + parse-word 2dup tfind place >unicode drop swap >bindtype do-late exit then repeat 0= abort" Not An Interface!" --- 916,921 ---- if state @ if COMPILE-INTERFACE else RUN-INTERFACE then bl word drop then else \ automated interface ! drop typelibhead begin @ dup while ! dup 2 cells + peek rot istype? if 2 cells + parse-word 2dup tfind place >unicode drop swap >bindtype do-late exit then repeat 0= abort" Not An Interface!" *************** *** 920,936 **** : free-lasttypelib ( -- ) \ frees the last type library ! typelibhead @ ?dup if ! dup @ typelibhead ! ! dup cell+ UCOM ITypeComp IReleaseref drop 2 cells + UCOM ITypeLib IReleaseref drop then ; : freetypelibs ( -- ) typelibhead begin @ dup while ! dup cell+ UCOM ITypeComp IReleaseref drop dup 2 cells + UCOM ITypeLib IReleaseref drop repeat drop 0 typelibhead ! ; ! : com_init 0 CoInitialize drop ; Initialization-Chain Chain-Add Com_init --- 925,941 ---- : free-lasttypelib ( -- ) \ frees the last type library ! typelibhead @ ?dup if ! dup @ typelibhead ! ! dup cell+ UCOM ITypeComp IReleaseref drop 2 cells + UCOM ITypeLib IReleaseref drop then ; : freetypelibs ( -- ) typelibhead begin @ dup while ! dup cell+ UCOM ITypeComp IReleaseref drop dup 2 cells + UCOM ITypeLib IReleaseref drop repeat drop 0 typelibhead ! ; ! : com_init 0 CoInitialize drop ; Initialization-Chain Chain-Add Com_init *************** *** 947,951 **** \ through a bloated structure, and is slow. Avoid these interfaces if possible. ! \ The way to deal with it here is to pass argments on to a typed stack 16 CONSTANT maxvt \ Height of Stack --- 952,956 ---- \ through a bloated structure, and is slow. Avoid these interfaces if possible. ! \ The way to deal with it here is to pass argments on to a typed stack 16 CONSTANT maxvt \ Height of Stack *************** *** 954,964 **** DISPPARAMS Struct DispCall \ calling structure ! vtstack DispCall rgvarg ! VARIANT Struct RetVT \ return value - only one allowed :-( ! : vt@ ( addr -- n VT ) dup w@ swap 8 + over argcells 2 = if 2@ rot else @ swap then ; ! : vt! ( n VT addr -- ) 2dup w! 8 + swap argcells 2 = if 2! else ! then ; --- 959,969 ---- DISPPARAMS Struct DispCall \ calling structure ! vtstack DispCall rgvarg ! VARIANT Struct RetVT \ return value - only one allowed :-( ! : vt@ ( addr -- n VT ) dup w@ swap 8 + over argcells 2 = if 2@ rot else @ swap then ; ! : vt! ( n VT addr -- ) 2dup w! 8 + swap argcells 2 = if 2! else ! then ; *************** *** 969,1016 **** 16 * DispCall rgvarg @ + vt@ else 0 VT_EMPTY then ; ! ! : >VT ( n VT -- ) \ push Virtual Type onto Stack ! DispCall cargs @ dup maxvt < if ! 16 * DispCall rgvarg @ + vt! 1 DispCall cargs +! else abort" Variant Stack Full!" then ; ! : .vt ( -- ) DispCall cargs @ 0 ?do ! DispCall rgvarg @ i 16 * + vt@ dup vt>str type ." : " argcells 2 = if d. else . then loop ; ! internal variable disperr : DispatchCall ( type ID Interface -- hres ) \ Call IDispatch Invoke method ! 2>r >r disperr 0 RetVT DispCall r> 0 GUID_NULL 2r> UCOM IDispatch Invoke 0 DispCall cargs ! ; ! : GetDispID ( ustr Interface -- ID ) \ Get Dispatch ID ! swap >r rp@ swap disperr 0 2swap 1 -rot GUID_NULL swap ! UCOM IDispatch GetIDsOfNames r> drop if 0 else disperr @ then ; ! : methkind ( str len -- ustr kind ) over 6 s" PutRef" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUTREF exit then over 3 s" Put" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUT exit then ! over 3 s" Get" Istr= if 3 /string >unicode drop INVOKE_PROPERTYGET exit then ! >unicode drop INVOKE_FUNC ; ! : .dispwords ( interface -- ) 0 >r rp@ 0 rot 0 swap UCOM IDispatch GetTypeInfo abort" Unable to Call Dispatch!" rp@ .methods rp@ UCOM ITypeLib IReleaseref drop r> drop ; ! external : Do-Disp ( interface -- hres ) \ behavior of a dispatcher ! peek s" Words" Istr= if .dispwords skip-word exit then ! dup peek methkind swap rot ! getdispID dup 0= if 2drop state @ if POSTPONE lit , then exit else rot skip-word then ! state @ if swap POSTPONE lit , POSTPONE lit , POSTPONE DispatchCall else DispatchCall then ; ! : Dispatcher ( <name> <progID> -- ) create here 0 , here dup parse-word >unicode drop CLSIDFromProgID ! abort" Unable to Find ProgID!" IDispatch swap CLSCTX_SERVER 0 rot CoCreateInstance abort" Unable to Get IUnknown!" IMMEDIATE does> do-disp ; --- 974,1021 ---- 16 * DispCall rgvarg @ + vt@ else 0 VT_EMPTY then ; ! ! : >VT ( n VT -- ) \ push Virtual Type onto Stack ! DispCall cargs @ dup maxvt < if ! 16 * DispCall rgvarg @ + vt! 1 DispCall cargs +! else abort" Variant Stack Full!" then ; ! : .vt ( -- ) DispCall cargs @ 0 ?do ! DispCall rgvarg @ i 16 * + vt@ dup vt>str type ." : " argcells 2 = if d. else . then loop ; ! internal variable disperr : DispatchCall ( type ID Interface -- hres ) \ Call IDispatch Invoke method ! 2>r >r disperr 0 RetVT DispCall r> 0 GUID_NULL 2r> UCOM IDispatch Invoke 0 DispCall cargs ! ; ! : GetDispID ( ustr Interface -- ID ) \ Get Dispatch ID ! swap >r rp@ swap disperr 0 2swap 1 -rot GUID_NULL swap ! UCOM IDispatch GetIDsOfNames r> drop if 0 else disperr @ then ; ! : methkind ( str len -- ustr kind ) over 6 s" PutRef" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUTREF exit then over 3 s" Put" Istr= if 3 /string >unicode drop INVOKE_PROPERTYPUT exit then ! over 3 s" Get" Istr= if 3 /string >unicode drop INVOKE_PROPERTYGET exit then ! >unicode drop INVOKE_FUNC ; ! : .dispwords ( interface -- ) 0 >r rp@ 0 rot 0 swap UCOM IDispatch GetTypeInfo abort" Unable to Call Dispatch!" rp@ .methods rp@ UCOM ITypeLib IReleaseref drop r> drop ; ! external : Do-Disp ( interface -- hres ) \ behavior of a dispatcher ! peek s" Words" Istr= if .dispwords skip-word exit then ! dup peek methkind swap rot ! getdispID dup 0= if 2drop state @ if POSTPONE lit , then exit else rot skip-word then ! state @ if swap POSTPONE lit , POSTPONE lit , POSTPONE DispatchCall else DispatchCall then ; ! : Dispatcher ( <name> <progID> -- ) create here 0 , here dup parse-word >unicode drop CLSIDFromProgID ! abort" Unable to Find ProgID!" IDispatch swap CLSCTX_SERVER 0 rot CoCreateInstance abort" Unable to Get IUnknown!" IMMEDIATE does> do-disp ; *************** *** 1020,1024 **** : DispLate" ( interface <method> -- hres ) \ late-late bound dispatch ! state @ if COMPILE dup COMPILE (s") ," COMPILE do-displate else dup [CHAR] " parse do-displate then ; IMMEDIATE --- 1025,1029 ---- : DispLate" ( interface <method> -- hres ) \ late-late bound dispatch ! state @ if COMPILE dup COMPILE (s") ," COMPILE do-displate else dup [CHAR] " parse do-displate then ; IMMEDIATE *************** *** 1082,1086 **** \ Close-Interface ! \ you can do the same with structures, but there are better ways to do \ structures. --- 1087,1091 ---- \ Close-Interface ! \ you can do the same with structures, but there are better ways to do \ structures. *************** *** 1092,1098 **** )) ! \ 2 5 typelib {00000205-0000-0010-8000-00AA006D2EA4} \ 1 0 typelib {CA8A9783-280D-11CF-A24D-444553540000} \ IDispatch comiface disp ! \ disp IDispatch 1 0 RecordSet CoCreateInstance . |
|
From: Dirk B. <db...@us...> - 2005-09-18 11:10:40
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13823/doc Modified Files: p-relnotes.6.12.htm Log Message: - Moved the demo code for the new ActiveX controls into seperate files in the Demos-Folder - Added two new tool's for exploring ActiveX controls - Added some notes about the new COM and ActiveX support to the release notes. Index: p-relnotes.6.12.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-relnotes.6.12.htm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** p-relnotes.6.12.htm 15 Sep 2005 16:31:38 -0000 1.4 --- p-relnotes.6.12.htm 18 Sep 2005 11:10:31 -0000 1.5 *************** *** 30,34 **** <li>Ezra Boyce</li> <li>Dirk Busch</li> ! <li>Thomas Dixon</li> <li>Bruno Gauthier</li> <li>George Hubert</li> --- 30,34 ---- <li>Ezra Boyce</li> <li>Dirk Busch</li> ! <li>Thomas Dixon (COM and ActiveX support)</li> <li>Bruno Gauthier</li> <li>George Hubert</li> *************** *** 37,41 **** <li>Andrew Stephenson</li> <li>Jos van de Ven</li> ! <li>and some others...</li> </dir> <h2>Distributions</h2> --- 37,41 ---- <li>Andrew Stephenson</li> <li>Jos van de Ven</li> ! <li>and others...</li> </dir> <h2>Distributions</h2> *************** *** 74,77 **** --- 74,81 ---- <h2>System Changes</h2> <p> + <li>The File w32fHtmlDisplay.dll was removed because it was replaced whith + the new ActiveX support written by Thomas Dixon. + </li> + </p> <h3>Documentation</h3> *************** *** 100,108 **** </ul> ! <h2>New Classes</h2> <ul> ! <li><a href="../src/lib/HTMLControl.F">browser control</a> ! This is a browser control that can be used for all kinds of things. ! An example of a browser window is included in at the bottom of the file. </li> --- 104,111 ---- </ul> ! <h2>New Controls</h2> <ul> ! <li><a href="../src/lib/HTMLControl.F">HTML browser control</a> ! This is a HTML browser control that can be used for all kinds of things. </li> *************** *** 110,122 **** Embeds a adobe acrobat control into your window. This control uses the dispatch interface to talk to the control (because a real interface wasn't ! provided). This requires that you have a adobe reader installed. ! Example also included at bottom of the file. </li> <li><a href="../src/lib/FlashControl.F">Shockwave Flash Control</a> ! Flash control that can play swf movies. There are many more methods to the calling interface that I did not include because I didn't know what they did. Maybe someone who has more experience with flash could help ! develop it futher. You do need the shockwave control installed. </li> --- 113,124 ---- Embeds a adobe acrobat control into your window. This control uses the dispatch interface to talk to the control (because a real interface wasn't ! provided). This requires that you have a adobe reader installed. </li> <li><a href="../src/lib/FlashControl.F">Shockwave Flash Control</a> ! Flash control that can play swf movies. There are many more methods to the calling interface that I did not include because I didn't know what they did. Maybe someone who has more experience with flash could help ! develop it futher. You do need the shockwave control installed. </li> *************** *** 150,162 **** autosize: ax - You may also give it html code, if it is proceeded by "MSHTML:" Ex: - - s" MSHTML:<HTML><BODY>Hello World!</BODY></HTML>" axcreate: ax - autosize: ax - Just having the control there is nice, but the REAL trick is to communicate with it and exchange data back and forth. The way that ! this is done is by getting the control's interface and using it. That is ! what was done in all the other activex controls posted. </pre><p> </li> --- 152,159 ---- autosize: ax Just having the control there is nice, but the REAL trick is to communicate with it and exchange data back and forth. The way that ! this is done is by getting the control's interface and using it. ! That is what was done in all the other activex controls. </pre><p> </li> *************** *** 165,169 **** <h2>New Demos</h2> <ul> ! <li></li> </ul> --- 162,175 ---- <h2>New Demos</h2> <ul> ! <li><a href="../demos/HtmlControlDemo.f">demos/HtmlControlDemo.f - Shows how to use the HTMLControl</a></li> ! <li><a href="../demos/PdfControlDemo.f">demos/PdfControlDemo.f - Shows how to use the PDFControl</a></li> ! <li><a href="../demos/FlashControlDemo.f">demos/FlashControlDemo.f - Shows how to use the FlashControl</a></li> ! <li>demos\COM\*.f - Various demos for the new COM interface.</li> ! </ul> ! ! <h2>New Tools</h2> ! <ul> ! <li><a href="../src/tools/AxConList.f">src/tools/AxConList.f - Shows a list of all installed ActiveX controls</a></li> ! <li><a href="../src/tools/AxConInfo.f">src/tools/AxConInfo.f - Shows informations about an ActiveX control</a></li> </ul> |
|
From: Dirk B. <db...@us...> - 2005-09-18 11:10:40
|
Update of /cvsroot/win32forth/win32forth/demos/COM In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13823/demos/COM Modified Files: D3Dtest.f EX_ADO.F EX_D3D.F EX_DDRAW.F EX_SAPI.F Log Message: - Moved the demo code for the new ActiveX controls into seperate files in the Demos-Folder - Added two new tool's for exploring ActiveX controls - Added some notes about the new COM and ActiveX support to the release notes. Index: EX_ADO.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/EX_ADO.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsjURJlN and /tmp/cvsiPkylm differ Index: EX_D3D.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/EX_D3D.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EX_D3D.F 15 Sep 2005 16:31:38 -0000 1.1 --- EX_D3D.F 18 Sep 2005 11:10:30 -0000 1.2 *************** *** 1,2 **** --- 1,4 ---- + \ $Id$ + \ Example of using Direct3d (Directx 8.1) \ Thomas Dixon Index: D3Dtest.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/D3Dtest.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsObXVGP and /tmp/cvsax2hMo differ Index: EX_DDRAW.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/EX_DDRAW.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EX_DDRAW.F 15 Sep 2005 16:31:38 -0000 1.1 --- EX_DDRAW.F 18 Sep 2005 11:10:30 -0000 1.2 *************** *** 1,2 **** --- 1,4 ---- + \ $Id$ + \ Example of using Direct Draw (Directx) \ Thomas Dixon Index: EX_SAPI.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/EX_SAPI.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsbUKMiz and /tmp/cvsQdaXla differ |
|
From: Dirk B. <db...@us...> - 2005-09-18 11:10:40
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13823/src/tools Added Files: AXConList.F AxConInfo.f Log Message: - Moved the demo code for the new ActiveX controls into seperate files in the Demos-Folder - Added two new tool's for exploring ActiveX controls - Added some notes about the new COM and ActiveX support to the release notes. --- NEW FILE: AxConInfo.f --- \ $Id: AxConInfo.f,v 1.1 2005/09/18 11:10:31 dbu_de Exp $ \ AxConInfo.f \ Get informations about an ActiveX control from registry and \ display them. \ Written by Dirk Busch cr .( Loading ActiveX control info tool) anew -AxConInfo.f needs fcom internal in-system create org_BaseReg 260 allot create org_ProgReg 260 allot 0 value org_regBaseKey 0 value org_regAccessMask : SaveReg ( -- ) BaseReg count org_BaseReg place ProgReg count org_ProgReg place regBaseKey to org_regBaseKey regAccessMask to org_regAccessMask ; : RestoreReg ( -- ) org_BaseReg count BaseReg place org_ProgReg count ProgReg place org_regBaseKey to regBaseKey org_regAccessMask to regAccessMask ; : tab-type ( addr len -- ) tab-size >r 32 to tab-size tab type r> to tab-size ; : RegGetAxInfoValue ( addr1 len1 addr2 len2 -- addr3 len3 ) s" CLSID\" BaseReg place 2swap BaseReg +place \ guid s" \" BaseReg +place BaseReg +place \ section ProgReg off s" " s" " RegGetString ; : (.AxInfoValue) ( addr len -- ) 2dup type ." : " RegGetAxInfoValue tab-type ; : (.AxInfo) ( addr len -- ) cr ." GUID: " 2dup tab-type cr 2dup ." ClassName" s" " (.AxInfoValue) cr 2dup s" ProgID" (.AxInfoValue) cr 2dup s" TypeLib" (.AxInfoValue) cr 2dup s" Version" (.AxInfoValue) cr s" VersionIndependentProgID" (.AxInfoValue) cr ; : AxInitReg ( -- ) SaveReg HKEY_CLASSES_ROOT to regBaseKey KEY_READ to regAccessMask ; : AxRestoreReg ( -- ) RestoreReg ; : /get { str len char \ str1 len1 -- str len str1 len1 } \ search for char in string, return string till char and rest of string after char str len char scan to len1 to str1 len1 0> if len len1 - to len str1 1+ to str1 len1 1- ?dup if to len1 then then str len str1 len1 ; : guid>version ( addr len -- major minor ) s" Version" RegGetAxInfoValue ?dup if [char] . /get number? drop d>s >r number? drop d>s r> else drop 1 0 then ; : guid>typelib ( addr len -- addr len ) s" TypeLib" RegGetAxInfoValue ; external : GetAxVersion ( "GUID" -- major minor ) AxInitReg parse-word ?dup if guid>version else drop 0 0 then RestoreReg ; : GetAxTypeLib ( "GUID" -- addr len ) AxInitReg parse-word ?dup if guid>typelib else drop s" " then RestoreReg ; internal [undefined] (Guid,) [if] : (Guid,) ( addr len -- ) \ comments in a guid Base @ >r HEX dup 38 <> abort" Invalid Guid Length" 1 /string 2dup ascii - scan 2dup >r >r nip - hatoi , r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup ascii - scan 2dup >r >r nip - hatoi w, r> r> ascii - skip 2dup drop 2 0 do dup i 2 * + 2 hatoi c, loop drop ascii - scan ascii - skip drop 6 0 do dup i 2 * + 2 hatoi c, loop drop r> base ! ; [then] : (guid_typelib) ( major minor addr len -- ) \ load a type library for given GUID into the list 2>r here typelibhead dup @ , ! here dup >r 0 , here 0 , 2swap swap here r> 2r> rot >r (Guid,) LoadRegTypeLib abort" Error Loading Type Library" r> dup cell+ swap UCOM ITypeLib GetTypeComp abort" Error Getting TypeComp" ; external : guid_typelib ( "GUID" -- ) \ load a type library for given GUID into the list parse-word ?dup if AxInitReg 2dup guid>version 2swap guid>typelib (guid_typelib) RestoreReg else drop abort" GUID missing" then ; : .AxInfo ( "GUID" -- ) cr cr ." ActiveX Control info" parse-word ?dup if AxInitReg 2dup (.AxInfo) 2dup guid>version 2swap guid>typelib (guid_typelib) cr ." CoClasses:" tab CoClasses cr cr ." Interfaces:" tab Interfaces cr cr ." Structures:" tab Structures cr cr ." ComConsts:" tab ComConsts AxRestoreReg else drop then cr ; module in-application cr .( Usage: .axinfo <guid>) cr .( Example: .axinfo {0002DF01-0000-0000-C000-000000000046}) --- NEW FILE: AXConList.F --- \ $Id: AXConList.F,v 1.1 2005/09/18 11:10:31 dbu_de Exp $ \ Dump all installed ActiveX Controls to the console \ Thomas Dixon anew -AXConList.f needs fcom \ include the com library internal in-system \ define some guids UUID StdComponentCategoriesMgr {0002E005-0000-0000-C000-000000000046} UUID AXControl {40FC6ED4-2438-11cf-A3DB-080036F12502} \ I couldn't find a typelibrary for these interfaces, so I must statically \ define them. There are only two, so it's not bad. IUnknown Interface ICatInformation {0002E013-0000-0000-C000-000000000046} ICatInformation Open-Interface 3 3 IMethod EnumCategories ( *ppenumCategoryInfo lcid -- hres ) 4 4 IMethod GetCategoryDesc ( *pszDesc lcid rcatid -- hres ) 6 5 IMethod EnumClassesOfCategories ( *ppenumClsid rgcatidReq cReq rgcatidImpl cImp -- hres ) 6 6 IMethod IsClassOfCategories ( rgcatidReq cReq rgcatidImpl n clsid -- hres ) 3 7 IMethod EnumImplCategoriesOfClass ( *ppenumCatid rclsid -- hres ) 3 8 IMethod EnumReqCategoriesOfClass ( *ppenumCatid clsid -- hres ) Close-Interface IUnknown Interface IEnumGUID {0002E000-0000-0000-C000-000000000046} IEnumGUID Open-Interface 4 3 IMethod Next ( *n *rgelt celt -- hres ) 2 4 IMethod Skip ( *celt -- hres ) 1 5 IMethod Reset ( -- hres ) 2 6 IMethod Clone ( *ppenum -- hres ) Close-Interface \ Make a few interfaces ICatInformation comiface catinfo IEnumGUID comiface enumg create tempguid 16 allot \ temporary guid buffer external \ word to list controls : .axcontrols ( -- ) cr ." Listing all ActiveX controls:" cr catinfo ICatInformation 1 0 StdComponentCategoriesMgr CoCreateInstance abort" Unable to initialize Control Manager!" enumg pad 0 axcontrol 1 catinfo EnumClassesOfCategories drop enumg reset drop begin 0 tempguid 1 enumg next 0= while pad tempguid StringFromCLSID 0= if ." " pad @ zunicount unitype then pad 1 tempguid call OleRegGetUserType 0= if ." " pad @ zunicount unitype then cr repeat enumg IReleaseref drop catinfo IReleaseref drop ; MODULE .axcontrols in-application |
|
From: Dirk B. <db...@us...> - 2005-09-17 07:01:33
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27861/apps/Setup Modified Files: Setup.f Log Message: Removed copying the w32fHtmlDisplay.dll from the Setup (thank's Jos) Index: Setup.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/Setup.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Setup.f 12 Jun 2005 08:37:35 -0000 1.6 --- Setup.f 17 Sep 2005 07:01:24 -0000 1.7 *************** *** 27,31 **** FLOAD ..\..\src\pointer.f FLOAD ..\..\src\registry.f \ Win32 Registry support ! FLOAD ..\..\src\ansfile.f FLOAD ..\..\src\shell.f FLOAD ..\..\src\callback.f --- 27,31 ---- FLOAD ..\..\src\pointer.f FLOAD ..\..\src\registry.f \ Win32 Registry support ! FLOAD ..\..\src\ansfile.f FLOAD ..\..\src\shell.f FLOAD ..\..\src\callback.f *************** *** 35,39 **** : ?win-error ( f -- ) drop ; : seconds ( n -- ) drop ; ! FLOAD sub_dirs.f FLOAD array.f \ array words FLOAD hyper.f \ build hyper link index --- 35,39 ---- : ?win-error ( f -- ) drop ; : seconds ( n -- ) drop ; ! FLOAD sub_dirs.f FLOAD array.f \ array words FLOAD hyper.f \ build hyper link index *************** *** 61,65 **** &forthdir count drop $current-dir! drop ! cmdline -if ." invoked with commandline <" type ." >" cr then --- 61,65 ---- &forthdir count drop $current-dir! drop ! cmdline -if ." invoked with commandline <" type ." >" cr then *************** *** 68,72 **** GetSystemDirectory ; ! 0 callback &noop noop \ a noop-callback : setup-bye ( -- ) --- 68,72 ---- GetSystemDirectory ; ! 0 callback &noop noop \ a noop-callback : setup-bye ( -- ) *************** *** 127,131 **** ." A Rebuild sample applications (Player4, Solipon2 and PlayVirginRadio)" cr cr ." D Copy Win32Forth dll files (w32fConsole.dll, w32fScintilla.dll," cr ! ." w32fHtmlDisplay.dll, wincon.dll and Zip32.dll) into the Windows system folder:" cr ." '" SystemDirectory$ count type ." ' (this is not done by default)." cr cr ." X Exit setup." cr cr --- 127,131 ---- ." A Rebuild sample applications (Player4, Solipon2 and PlayVirginRadio)" cr cr ." D Copy Win32Forth dll files (w32fConsole.dll, w32fScintilla.dll," cr ! ." wincon.dll and Zip32.dll) into the Windows system folder:" cr ." '" SystemDirectory$ count type ." ' (this is not done by default)." cr cr ." X Exit setup." cr cr *************** *** 193,197 **** _conHndl call SetForegroundWindow drop ." process finished" cr ! key? drop then --- 193,197 ---- _conHndl call SetForegroundWindow drop ." process finished" cr ! key? drop then *************** *** 199,203 **** : cleanbuild ( f -- ) \ clean up the files before install ! cls cr c" WIN32FOR.EXE" filedelete c" WIN32FOR.DBG" filedelete --- 199,203 ---- : cleanbuild ( f -- ) \ clean up the files before install ! cls cr c" WIN32FOR.EXE" filedelete c" WIN32FOR.DBG" filedelete *************** *** 295,299 **** c" w32fConsole.dll" copydll c" w32fScintilla.dll" copydll - c" w32fHtmlDisplay.dll" copydll c" wincon.dll" copydll c" Zip32.dll" copydll --- 295,298 ---- *************** *** 308,312 **** buildwined \ build WinEd if buildindex \ build the index files for WinEd ! then buildforthform \ build ForthForm buildproject \ build ProjectManager --- 307,311 ---- buildwined \ build WinEd if buildindex \ build the index files for WinEd ! then buildforthform \ build ForthForm buildproject \ build ProjectManager *************** *** 486,490 **** ." Rebuilding Sample applications" cr checkcont ! buildsamples endedok ; --- 485,489 ---- ." Rebuilding Sample applications" cr checkcont ! buildsamples endedok ; *************** *** 555,557 **** wait&bye - |
|
From: Dirk B. <db...@us...> - 2005-09-17 07:01:33
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27861 Modified Files: setup.exe Log Message: Removed copying the w32fHtmlDisplay.dll from the Setup (thank's Jos) Index: setup.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/setup.exe,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 Binary files /tmp/cvsvTfj6M and /tmp/cvsPi8brv differ |
|
From: Dirk B. <db...@us...> - 2005-09-16 15:55:07
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10368 Removed Files: w32fHtmlDisplay.dll Log Message: Removed w32fHtmlDisplay.dll from the CVS. It isn't needed any more. --- w32fHtmlDisplay.dll DELETED --- |
|
From: Jos v.d.V. <jo...@us...> - 2005-09-15 21:24:55
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18425/src/tools Added Files: Config.f Log Message: For saving data, variables and strings in a file. Very easy to use. Just @ ! and place can do the job --- NEW FILE: Config.f --- anew Config.f \ For saving data, variables and strings in a file. 0 value /ConfigDef \ Keeps how big the size of the config file should be. create ConfigFile$ maxstring allot s" Config.dat" ConfigFile$ place map-handle config-mhndl : file-exist? ( adr len -- true-if-file-exist ) file-status nip 0= ; : file-size>s ( fileid -- len ) file-size drop d>s ; : map-hndl>vadr ( m_hndl - vadr ) >hfileAddress @ ; : map-config-file ( - ) ConfigFile$ count config-mhndl open-map-file throw ; : vadr-config ( - vadr-config ) config-mhndl map-hndl>vadr ; : DisableConfigFile ( - ) config-mhndl dup flush-view-file drop close-map-file drop ; : extend-file ( size hndl - ) dup>r file-size drop d>s + s>d r@ resize-file abort" Can't extend file." r> close-file drop ; : CreateConfigFile ( - ) /ConfigDef ConfigFile$ count r/w create-file abort" Can't create configuration file" extend-file ; : check-config ( -- ) \ creates a config-file with the right size. ConfigFile$ count file-exist? if ConfigFile$ count r/w open-file abort" Can't open the cofiguration file" /ConfigDef over file-size>s 2dup > \ Extend it when it is needed. if - swap extend-file \ Keep the extisting data. else 2drop close-file throw \ Do nothing when it is right. then else CreateConfigFile then ; : AllotConfigDef ( size - ) /ConfigDef dup , + to /ConfigDef ; : OffsetInConfigDef ( adr - ) @ vadr-config + ; \ A ConfigVariable directly acceses the config file. \ They only work when the config file is mapped. : ConfigVariable \ Allocates variables in a configuration file create cell AllotConfigDef \ Compiletime: ( -< name >- ) does> OffsetInConfigDef \ Runtime: ( - AdrInMappedConfigFile ) ; : Config$: \ Allocates strings in a configuration file create maxstring AllotConfigDef \ Compiletime: ( -< name >- ) does> OffsetInConfigDef \ Runtime: ( - AdrInMappedConfigFile ) ; : DataArea: \ Allocates a data area in a configuration file create AllotConfigDef \ Compiletime: ( size -< name >- ) does> OffsetInConfigDef \ Runtime: ( - AdrInMappedConfigFile ) ; : EnableConfigFile ( - ) check-config map-config-file ; \s Disable this line to see it's use: \ Define ConfigVariables to access the mapped file. ConfigVariable LBs/Inches- ConfigVariable SingCutoff- Config$: DataFile$ ConfigVariable ShowObese- 8 DataArea: Test EnableConfigFile \ Make sure there is a config file with the right size and map it 1 LBs/Inches- ! 2 SingCutoff- ! s" c:\appl\test.dat" DataFile$ place 3 ShowObese- ! -1 Test ! DisableConfigFile \ When you are ready. EnableConfigFile \ To use the config file again. cr .( The saved values are: ) LBs/Inches- ? SingCutoff- ? ShowObese- ? cr .( The name of the DataFile$ in the config file is: ) DataFile$ count type vadr-config /ConfigDef dump DisableConfigFile \ When you are ready. \s |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:18
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/src/tools Modified Files: HelpSystem.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: HelpSystem.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/HelpSystem.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** HelpSystem.f 3 May 2005 14:21:59 -0000 1.5 --- HelpSystem.f 15 Sep 2005 16:36:10 -0000 1.6 *************** *** 130,134 **** : internal-browser ( addr len -- ) \ open the help file in our own Window asciiz - InitHtmlControl Start: HelpWindow SetURL: HelpWindow ; --- 130,133 ---- *************** *** 192,196 **** else ." No error happened." then ; ! WARNING OFF : help ( -<word>- -- ) \ show help for a word or the last win32forth error message --- 191,195 ---- else ." No error happened." then ; ! WARNING OFF : help ( -<word>- -- ) \ show help for a word or the last win32forth error message *************** *** 213,217 **** if msdn-help? if (msdn-help) ! else sdk-help? if (sdk-help) else 2drop (api-help-error) --- 212,216 ---- if msdn-help? if (msdn-help) ! else sdk-help? if (sdk-help) else 2drop (api-help-error) *************** *** 234,236 **** help-system - |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:18
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/src/lib Modified Files: HtmlDisplayControl.f HtmlDisplayWindow.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: HtmlDisplayControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/HtmlDisplayControl.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 Binary files /tmp/cvsoRbsiB and /tmp/cvsYJob0Y differ Index: HtmlDisplayWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/HtmlDisplayWindow.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** HtmlDisplayWindow.f 21 Dec 2004 00:19:10 -0000 1.1 --- HtmlDisplayWindow.f 15 Sep 2005 16:36:09 -0000 1.2 *************** *** 14,17 **** --- 14,18 ---- needs HtmlDisplayControl.f + needs SendMessage.f needs Bitmap.f needs Toolbar.f *************** *** 143,147 **** \ restore any settings ! false SaveRestore: HtmlToolbar [ RBBIM_CHILD RBBIM_CHILDSIZE or RBBIM_STYLE or RBBIM_SIZE or ] LITERAL --- 144,148 ---- \ restore any settings ! false SaveRestore: HtmlToolbar [ RBBIM_CHILD RBBIM_CHILDSIZE or RBBIM_STYLE or RBBIM_SIZE or ] LITERAL *************** *** 197,201 **** 0 to HtmlToolbar ;M ! ;class --- 198,202 ---- 0 to HtmlToolbar ;M ! ;class *************** *** 235,239 **** tempRect.AddrOf GetClientRect: self ! Left: tempRect ShowToolbar? if Height: HtmlRebar 2 - else Top: tempRect then Right: tempRect --- 236,240 ---- tempRect.AddrOf GetClientRect: self ! Left: tempRect ShowToolbar? if Height: HtmlRebar 2 - else Top: tempRect then Right: tempRect *************** *** 246,250 **** :M SetString: ( zUrl -- ) ! SetString: HtmlControl ;M :M SetURL: ( zUrl -- ) --- 247,251 ---- :M SetString: ( zUrl -- ) ! drop ;M DEPRECATED :M SetURL: ( zUrl -- ) *************** *** 300,302 **** ;class ! MODULE |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:18
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/src Modified Files: imageman.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: imageman.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/imageman.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** imageman.f 29 Aug 2005 15:56:28 -0000 1.8 --- imageman.f 15 Sep 2005 16:36:09 -0000 1.9 *************** *** 7,11 **** IMAGEMAN builds Windows EXE images. ! For documentation on the PECOFF format, see http://www.microsoft.com/hwdev/hardware/PECOFF.asp. Note: not included because of copyright restrictions, but freely downloadable. Also see "Peering Inside the PE: A Tour --- 7,11 ---- IMAGEMAN builds Windows EXE images. ! For documentation on the PECOFF format, see http://www.microsoft.com/hwdev/hardware/PECOFF.asp. Note: not included because of copyright restrictions, but freely downloadable. Also see "Peering Inside the PE: A Tour *************** *** 35,39 **** VIMAGE IMAGEMAN has its own dictionary (because of possible name collisions) ! so a separate dictionary is used. COMPACT Standard file is built with 4096 (4KBYTE) file sections. COMPACT specifies 512 (0x200) file sections, which builds a smaller EXE file --- 35,39 ---- VIMAGE IMAGEMAN has its own dictionary (because of possible name collisions) ! so a separate dictionary is used. COMPACT Standard file is built with 4096 (4KBYTE) file sections. COMPACT specifies 512 (0x200) file sections, which builds a smaller EXE file *************** *** 70,74 **** ENDBUILD Creates the image from the information given above. ! s" name" IMAGE-LOAD Loads a .IMG file for subsequent conversion. Sets the following words as a side effect; IMAGE-PTR pointer to the loaded image --- 70,74 ---- ENDBUILD Creates the image from the information given above. ! s" name" IMAGE-LOAD Loads a .IMG file for subsequent conversion. Sets the following words as a side effect; IMAGE-PTR pointer to the loaded image *************** *** 108,112 **** The first section always starts on 0x1000. Section #1 will start at 0x1000, and be 0x1234 bytes padded out to the next 4K boundary (out to 0x2FFF). Section #2 will start ! at 0x3000, be 0x1120 bytes padded out to 0x4FFF, etc. The .idata section should be written last. --- 108,112 ---- The first section always starts on 0x1000. Section #1 will start at 0x1000, and be 0x1234 bytes padded out to the next 4K boundary (out to 0x2FFF). Section #2 will start ! at 0x3000, be 0x1120 bytes padded out to 0x4FFF, etc. The .idata section should be written last. *************** *** 161,165 **** cr ." File '" PEIMG-NAME count type ." ' : " ! WinErrMsg ON GetLastWinErr then ; --- 161,165 ---- cr ." File '" PEIMG-NAME count type ." ' : " ! WinErrMsg ON GetLastWinErr then ; *************** *** 185,189 **** PEIMG-HNDL FILE-POSITION ?PEIMG-FERROR d>s ; ! 0x1000 CONSTANT 4KBYTE 0x100000 CONSTANT 1MBYTE --- 185,189 ---- PEIMG-HNDL FILE-POSITION ?PEIMG-FERROR d>s ; ! 0x1000 CONSTANT 4KBYTE 0x100000 CONSTANT 1MBYTE *************** *** 252,256 **** RES-LOAD \ .res name before this RES-PTR RES-LEN ; ! )) --- 252,256 ---- RES-LOAD \ .res name before this RES-PTR RES-LEN ; ! )) *************** *** 353,357 **** "next" pointer points to a list of all functions (IMPORT) "func" pointer points to a list of functions in this library (IMPORTs in IMPLIB) ! Uses structure based on BASE-IMPSTR --- 353,357 ---- "next" pointer points to a list of all functions (IMPORT) "func" pointer points to a list of functions in this library (IMPORTs in IMPLIB) ! Uses structure based on BASE-IMPSTR *************** *** 404,408 **** Add imports a stand-alone section normally called .idata. Section must be declared. ! Steps: --- 404,408 ---- Add imports a stand-alone section normally called .idata. Section must be declared. ! Steps: *************** *** 412,416 **** Build the lib names, remember where we put them (write into the linked list at IMP-RVA) Build the hint/func names, remember where we put them ! If section isn't big enough, make it larger (we haven't written it yet) --- 412,416 ---- Build the lib names, remember where we put them (write into the linked list at IMP-RVA) Build the hint/func names, remember where we put them ! If section isn't big enough, make it larger (we haven't written it yet) *************** *** 430,437 **** IID-RVA-IAT ------------------------------------------------------+ ... ! # of IIDs = IMPLIB-COUNT + 1 # of ILT entries = IMPLIB-COUNT + IMPFUNC-COUNT (same for IAT) ! IAT is built first, and is the table modified by the loader to contain load addresses. Note that the entries are built back-to-front from the declaration order -- the last function --- 430,437 ---- IID-RVA-IAT ------------------------------------------------------+ ... ! # of IIDs = IMPLIB-COUNT + 1 # of ILT entries = IMPLIB-COUNT + IMPFUNC-COUNT (same for IAT) ! IAT is built first, and is the table modified by the loader to contain load addresses. Note that the entries are built back-to-front from the declaration order -- the last function *************** *** 457,461 **** : ENDIMPORTS ( -- addr len ) \ build import words, return buffer ! { \ CURR-IID CURR-ILT CURR-FUNCS CURR-IAT LEN-IAT LEN-ALLIIDS } \ temporaries --- 457,461 ---- : ENDIMPORTS ( -- addr len ) \ build import words, return buffer ! { \ CURR-IID CURR-ILT CURR-FUNCS CURR-IAT LEN-IAT LEN-ALLIIDS } \ temporaries *************** *** 471,475 **** CURR-IID ->RVA EXED-IMPORT ! \ point at imports LEN-ALLIIDS EXED-IMPORT CELL+ ! \ length of IIDs ! CURR-IAT ->RVA EXED-IAT ! \ point at IAT LEN-IAT EXED-IAT CELL+ ! \ length of IAT --- 471,475 ---- CURR-IID ->RVA EXED-IMPORT ! \ point at imports LEN-ALLIIDS EXED-IMPORT CELL+ ! \ length of IIDs ! CURR-IAT ->RVA EXED-IAT ! \ point at IAT LEN-IAT EXED-IAT CELL+ ! \ length of IAT *************** *** 492,496 **** CELL +TO CURR-ILT CELL +TO CURR-IAT \ update ILT/IAT pointers REPEAT ! CELL +TO CURR-ILT CELL +TO CURR-IAT \ update ILT/IAT pointers (zero entry) LEN-IID +TO CURR-IID \ next IID --- 492,496 ---- CELL +TO CURR-ILT CELL +TO CURR-IAT \ update ILT/IAT pointers REPEAT ! CELL +TO CURR-ILT CELL +TO CURR-IAT \ update ILT/IAT pointers (zero entry) LEN-IID +TO CURR-IID \ next IID *************** *** 627,635 **** SECTINIT ; ! : ENDBUILD ( -- ) \ fixup all the missing info cr ." Building image " PEIMG-NAME COUNT TYPE PEIMG-FCREATE \ create the file ! FILE-ALIGN EXEH-FILEALIGN ! \ n BYTE file align (mult of 512 bytes) LEN-HEAD EXEH-HEADSIZE ! \ n byte header size (mult of filealign) --- 627,635 ---- SECTINIT ; ! : ENDBUILD ( -- ) \ fixup all the missing info cr ." Building image " PEIMG-NAME COUNT TYPE PEIMG-FCREATE \ create the file ! FILE-ALIGN EXEH-FILEALIGN ! \ n BYTE file align (mult of 512 bytes) LEN-HEAD EXEH-HEADSIZE ! \ n byte header size (mult of filealign) *************** *** 654,658 **** R> cr ." Built length " dup . ." (" 1 H.R ." h) bytes" ! HEAD-BUFF release \ release storage --- 654,658 ---- R> cr ." Built length " dup . ." (" 1 H.R ." h) bytes" ! HEAD-BUFF release \ release storage *************** *** 665,669 **** TRUE VALUE CONSOLE-DLL? \ set to true if your app needs the w32fConsole.dll - FALSE VALUE HTML-DISPLAY-DLL? \ set to true if your app needs the w32fHtmlDisplay.dll FALSE VALUE SCINTILLA-DLL? \ set to true if your app needs the w32fScintilla.dll --- 665,668 ---- *************** *** 678,682 **** 1MBYTE 0x8000 HEAPSIZE IMAGE-ENTRY ENTRYPOINT ! s" .code" SECTION STD-DATA STD-CODE or SECTIONTYPE --- 677,681 ---- 1MBYTE 0x8000 HEAPSIZE IMAGE-ENTRY ENTRYPOINT ! s" .code" SECTION STD-DATA STD-CODE or SECTIONTYPE *************** *** 684,688 **** IMAGE-CSIZE SECTIONSIZE ENDSECTION ! s" .app" SECTION STD-DATA SECTIONTYPE --- 683,687 ---- IMAGE-CSIZE SECTIONSIZE ENDSECTION ! s" .app" SECTION STD-DATA SECTIONTYPE *************** *** 690,694 **** IMAGE-ASIZE SECTIONSIZE ENDSECTION ! IMAGE-SACTUAL IF \ might be a TURNKEY, so don't write section s" .sys" SECTION --- 689,693 ---- IMAGE-ASIZE SECTIONSIZE ENDSECTION ! IMAGE-SACTUAL IF \ might be a TURNKEY, so don't write section s" .sys" SECTION *************** *** 698,702 **** ENDSECTION THEN ! s" .idata" SECTION S-INIT S-READ OR SECTIONTYPE --- 697,701 ---- ENDSECTION THEN ! s" .idata" SECTION S-INIT S-READ OR SECTIONTYPE *************** *** 704,715 **** s" W32FCONSOLE.DLL" IMPLIB \ force load of the DLL, required 0 s" c_initconsole" IMPORT - THEN - - HTML-DISPLAY-DLL? IF - s" w32fHtmlDisplay.dll" IMPLIB \ force load of the DLL, required - 0 s" DoPageAction" IMPORT THEN ! SCINTILLA-DLL? IF s" w32fScintilla.dll" IMPLIB \ force load of the DLL, required 0 s" Scintilla_DirectFunction@16" IMPORT --- 703,709 ---- s" W32FCONSOLE.DLL" IMPLIB \ force load of the DLL, required 0 s" c_initconsole" IMPORT THEN ! SCINTILLA-DLL? IF s" w32fScintilla.dll" IMPLIB \ force load of the DLL, required 0 s" Scintilla_DirectFunction@16" IMPORT *************** *** 730,734 **** ENDBUILD ; ! PREVIOUS DEFINITIONS ALSO VIMAGE --- 724,728 ---- ENDBUILD ; ! PREVIOUS DEFINITIONS ALSO VIMAGE *************** *** 789,793 **** cannot be debugged. TURNKEY is followed by the name of the program to create. The name passed to TURNKEY must not be the ! same name as the Forth you are currently running. TURNKEY is used as follows; --- 783,787 ---- cannot be debugged. TURNKEY is followed by the name of the program to create. The name passed to TURNKEY must not be the ! same name as the Forth you are currently running. TURNKEY is used as follows; *************** *** 813,817 **** can still be debugged. APPLICATION is followed by the name of the program to create. The name passed to APPLICATION must not be the same ! name as the Forth you are currently running. APPLICATION is used as follows; --- 807,811 ---- can still be debugged. APPLICATION is followed by the name of the program to create. The name passed to APPLICATION must not be the same ! name as the Forth you are currently running. APPLICATION is used as follows; *************** *** 833,837 **** : PORIG ( n -- ) tab IMAGE-ORIGIN + 8 H.R ." h" ; ! : PSIZE ( n -- ) tab 7 .r ; --- 827,831 ---- : PORIG ( n -- ) tab IMAGE-ORIGIN + 8 H.R ." h" ; ! : PSIZE ( n -- ) tab 7 .r ; |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:18
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/src/kernel Modified Files: version.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:17
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/apps/SciEdit Modified Files: Main.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/Main.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Main.f 31 Aug 2005 17:03:19 -0000 1.10 --- Main.f 15 Sep 2005 16:36:08 -0000 1.11 *************** *** 279,283 **** InitScintillaControl \ Dienstag, August 03 2004 dbu - InitHtmlControl \ Dienstag, August 03 2004 dbu AccelTable EnableAccelerators \ init the accelerator table GetHandle: self Create: ScintillaStatusbar --- 279,282 ---- *************** *** 299,303 **** save-defaults \ save properties in registry ExitScintillaControl \ terminate the Scintilla control - ExitHtmlControl \ terminate the html control AccelTable DisableAccelerators \ free the accelerator table bye \ then terminate the program --- 298,301 ---- |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:17
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/demos Modified Files: HtmlDisplay.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: HtmlDisplay.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/HtmlDisplay.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 Binary files /tmp/cvs7p4ZSJ and /tmp/cvscnm404 differ |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:17
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338 Modified Files: fkernel.exe Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 Binary files /tmp/cvsO9uDpo and /tmp/cvsFbN16K differ |
|
From: Dirk B. <db...@us...> - 2005-09-15 16:36:17
|
Update of /cvsroot/win32forth/win32forth/apps/ProMgr In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16338/apps/ProMgr Modified Files: ProjectManager.f Log Message: Replaced our Html display control (w32fHtmlDisplay.dll) with Tom's ActiveX control. So the file w32fHtmlDisplay.dll isn't needed any more. Index: ProjectManager.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ProMgr/ProjectManager.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ProjectManager.f 5 Sep 2005 19:58:34 -0000 1.9 --- ProjectManager.f 15 Sep 2005 16:36:08 -0000 1.10 *************** *** 113,117 **** needs RegistrySupport.f needs RecentFiles.f ! needs PMMenu.f \ Menu and command IDs in separate file needs AcceleratorTables.f --- 113,117 ---- needs RegistrySupport.f needs RecentFiles.f ! needs PMMenu.f \ Menu and command IDs in separate file needs AcceleratorTables.f *************** *** 165,171 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! PROGREG-SET-BASE-PATH create RegPath$ max-path allot ! ProgReg count RegPath$ place s" ProjectManager" RegPath$ +place RegPath$ count RegistrySet ProjectManager RegPath$ count pad place s" \Window" pad +place pad count RegistrySet WindowSettings --- 165,171 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! PROGREG-SET-BASE-PATH create RegPath$ max-path allot ! ProgReg count RegPath$ place s" ProjectManager" RegPath$ +place RegPath$ count RegistrySet ProjectManager RegPath$ count pad place s" \Window" pad +place pad count RegistrySet WindowSettings *************** *** 176,180 **** RecentFilesList s" File1" 10 1 DO ! 2dup + 1- i 48 + swap c! 2dup i GetRecentFile: RecentFiles count 2swap REG_SZ SetRegistryValue --- 176,180 ---- RecentFilesList s" File1" 10 1 DO ! 2dup + 1- i 48 + swap c! 2dup i GetRecentFile: RecentFiles count 2swap REG_SZ SetRegistryValue *************** *** 439,443 **** :M Expand: ( hItem f -- ) TVM_EXPAND SendMessageDrop ;M \ :M ToggleExpandItem: ( hItem -- ) TVE_TOGGLE Expand: self ;M ! :M CollapseReset: ( hItem -- ) TVE_COLLAPSERESET TVE_COLLAPSE or Expand: self ;M :M GetItemRect: ( hItem -- f ) ItemRect ! ItemRect true TVM_GETITEMRECT SendMessage ;M :M SelectItem: ( hItem -- ) TVGN_CARET TVM_SELECTITEM SendMessageDrop ;M --- 439,443 ---- :M Expand: ( hItem f -- ) TVM_EXPAND SendMessageDrop ;M \ :M ToggleExpandItem: ( hItem -- ) TVE_TOGGLE Expand: self ;M ! :M CollapseReset: ( hItem -- ) TVE_COLLAPSERESET TVE_COLLAPSE or Expand: self ;M :M GetItemRect: ( hItem -- f ) ItemRect ! ItemRect true TVM_GETITEMRECT SendMessage ;M :M SelectItem: ( hItem -- ) TVGN_CARET TVM_SELECTITEM SendMessageDrop ;M *************** *** 468,472 **** GetNext: self Repeat drop drop ! MaxWidth ;M --- 468,472 ---- GetNext: self Repeat drop drop ! MaxWidth ;M *************** *** 787,791 **** MessageBox: parent IDNO = if SetFocus: self exitm then handle: SelectedItem \ save handle of selected item on stack ! SelectedItem ParentItem: SelectedItem to SelectedItem DeleteItem: SelectedItem #items: SelectedItem \ SelectedItem is now ParentItem SelectedItem MainList = or \ don't reset main list --- 787,791 ---- MessageBox: parent IDNO = if SetFocus: self exitm then handle: SelectedItem \ save handle of selected item on stack ! SelectedItem ParentItem: SelectedItem to SelectedItem DeleteItem: SelectedItem #items: SelectedItem \ SelectedItem is now ParentItem SelectedItem MainList = or \ don't reset main list *************** *** 793,797 **** ELSE drop handle: SelectedItem dup SelectItem: self CollapseReset: self THEN ! true to Modified ;M --- 793,797 ---- ELSE drop handle: SelectedItem dup SelectItem: self CollapseReset: self THEN ! true to Modified ;M *************** *** 1139,1143 **** IF "to-pathend" ELSE drop ProjectName: TheProject ! THEN pad +place s" ?" pad +place pad +NULL pad 1+ z" Project Manager" --- 1139,1143 ---- IF "to-pathend" ELSE drop ProjectName: TheProject ! THEN pad +place s" ?" pad +place pad +NULL pad 1+ z" Project Manager" *************** *** 1213,1217 **** THEN ;M ! :M Classinit: ( -- ) ClassInit: super \ init super class --- 1213,1217 ---- THEN ;M ! :M Classinit: ( -- ) ClassInit: super \ init super class *************** *** 1224,1228 **** \ ['] On_DblClick SetDblClickFunc: self \ set later, SetSplitter ;M ! :M WindowHasMenu: ( -- f ) true ;M --- 1224,1228 ---- \ ['] On_DblClick SetDblClickFunc: self \ set later, SetSplitter ;M ! :M WindowHasMenu: ( -- f ) true ;M *************** *** 1233,1237 **** :M On_Size: ( -- ) ! dup to WindowState \ get WindowState, don't save size of maximised or minimised window AutoSize: TheToolBar Redraw: ProjectStatusBar --- 1233,1237 ---- :M On_Size: ( -- ) ! dup to WindowState \ get WindowState, don't save size of maximised or minimised window AutoSize: TheToolBar Redraw: ProjectStatusBar *************** *** 1272,1276 **** s" " SetProjectFileName: TheProject LeftPane Start: TheProject - InitHtmlControl ;M --- 1272,1275 ---- *************** *** 1289,1293 **** Options SaveSettings ProjectManager SaveSettings ! SaveRecentFiles MenuHandle: CurrentMenu ?dup if Call DestroyMenu ?win-error \ discard the menubar --- 1288,1292 ---- Options SaveSettings ProjectManager SaveSettings ! SaveRecentFiles MenuHandle: CurrentMenu ?dup if Call DestroyMenu ?win-error \ discard the menubar *************** *** 1295,1299 **** then ExitScintillaControl \ Dienstag, August 03 2004 dbu - ExitHtmlControl PMAccelerators DisableAccelerators \ free the accelerator table \+ sysgen 0 Call PostQuitMessage --- 1294,1297 ---- *************** *** 1307,1317 **** :M WM_CLOSE ( h m w l -- res ) SaveIfModified ! IF GetProjectFileName: TheProject pad place pad Insert: RecentFiles WM_CLOSE WM: Super \ close window ! ELSE 0 \ abandon the close THEN ;M ! :M WindowTitle: ( -- zstring ) z" Project Manager" ;M --- 1305,1315 ---- :M WM_CLOSE ( h m w l -- res ) SaveIfModified ! IF GetProjectFileName: TheProject pad place pad Insert: RecentFiles WM_CLOSE WM: Super \ close window ! ELSE 0 \ abandon the close THEN ;M ! :M WindowTitle: ( -- zstring ) z" Project Manager" ;M *************** *** 1400,1404 **** else drop then ; IDM_OPEN SetCommand ! : save-project ( -- ) SaveProject: TheProject --- 1398,1402 ---- else drop then ; IDM_OPEN SetCommand ! : save-project ( -- ) SaveProject: TheProject *************** *** 1450,1454 **** : Expand/Collapse ( a f -- ) swap to ThisList Handle: ThisList swap Expand: TheProject ; ! : Expand ( a -- ) TVE_EXPAND Expand/Collapse ; : Collapse ( a -- ) TVE_COLLAPSE Expand/Collapse ; --- 1448,1452 ---- : Expand/Collapse ( a f -- ) swap to ThisList Handle: ThisList swap Expand: TheProject ; ! : Expand ( a -- ) TVE_EXPAND Expand/Collapse ; : Collapse ( a -- ) TVE_COLLAPSE Expand/Collapse ; *************** *** 1464,1468 **** ModuleList: TheProject to ThisList Handle: ThisList SelectItem: TheProject SetSplitter ; IDM_EXPAND_ALL SetCommand ! : CollapseAll ( -- ) ModuleList: TheProject collapse --- 1462,1466 ---- ModuleList: TheProject to ThisList Handle: ThisList SelectItem: TheProject SetSplitter ; IDM_EXPAND_ALL SetCommand ! : CollapseAll ( -- ) ModuleList: TheProject collapse *************** *** 1475,1479 **** MainList: TheProject to ThisList Handle: ThisList SelectItem: TheProject ; IDM_COLLAPSE_ALL SetCommand ! \ Project Menu Commands \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1473,1477 ---- MainList: TheProject to ThisList Handle: ThisList SelectItem: TheProject ; IDM_COLLAPSE_ALL SetCommand ! \ Project Menu Commands \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1531,1536 **** DOC keep this for adding files like docs ENDDOC ! : +Comment ( n -- ) comment? IF drop ELSE comment? or to comment? THEN ; ! : -Comment ( n -- ) invert comment? and to comment? ; : \Comment ( -- ) comment? 0= IF source nip >in ! THEN ; \ ignore till end of line --- 1529,1534 ---- DOC keep this for adding files like docs ENDDOC ! : +Comment ( n -- ) comment? IF drop ELSE comment? or to comment? THEN ; ! : -Comment ( n -- ) invert comment? and to comment? ; : \Comment ( -- ) comment? 0= IF source nip >in ! THEN ; \ ignore till end of line *************** *** 1543,1547 **** bl word count '"' -TrailChars pad place bl word count fpathplus count caps-compare 0= ! IF pad count "fpath+ drop ELSE >in ! THEN ; --- 1541,1545 ---- bl word count '"' -TrailChars pad place bl word count fpathplus count caps-compare 0= ! IF pad count "fpath+ drop ELSE >in ! THEN ; *************** *** 1616,1620 **** IF 2drop false \ missing-file ELSE true ! THEN ELSE drop false THEN ; --- 1614,1618 ---- IF 2drop false \ missing-file ELSE true ! THEN ELSE drop false THEN ; *************** *** 1648,1657 **** pad count addfile 2dup asciiz 0 SetText: ProjectStatusBar ! THEN skip-recurse? ! if 2drop else comment? -rot recurse to comment? \ save comment? on stack ! then ! then then ( false to skip-recurse? ) repeat source-id close-file drop --- 1646,1655 ---- pad count addfile 2dup asciiz 0 SetText: ProjectStatusBar ! THEN skip-recurse? ! if 2drop else comment? -rot recurse to comment? \ save comment? on stack ! then ! then then ( false to skip-recurse? ) repeat source-id close-file drop *************** *** 1756,1760 **** temp$ 1+ 1 SetText: TheStatusBar true to dirty? else drop ! then THEN >NextLink: ThisList loop --- 1754,1758 ---- temp$ 1+ 1 SetText: TheStatusBar true to dirty? else drop ! then THEN >NextLink: ThisList loop *************** *** 1765,1769 **** : CopyNonLib ( -- ) true to NoLibFiles copy-files ; IDM_COPY SetCommand ! : cancel-zip? ( addr cnt -- 0 ) 2drop key? --- 1763,1767 ---- : CopyNonLib ( -- ) true to NoLibFiles copy-files ; IDM_COPY SetCommand ! : cancel-zip? ( addr cnt -- 0 ) 2drop key? *************** *** 2003,2008 **** s" doc\promgr\prjProjectWindow.gif" needed-file **** these are not found with spaces in filenames! s" doc\promgr\prjFileMenu.gif" needed-file **** e.g. "prjFile Menu.gif" ! s" doc\promgr\prjViewMenu.gif" needed-file ! s" doc\promgr\prjProjectMenu.gif" needed-file ! s" doc\promgr\prjHelpMenu.gif" needed-file ENDDOC --- 2001,2006 ---- s" doc\promgr\prjProjectWindow.gif" needed-file **** these are not found with spaces in filenames! s" doc\promgr\prjFileMenu.gif" needed-file **** e.g. "prjFile Menu.gif" ! s" doc\promgr\prjViewMenu.gif" needed-file ! s" doc\promgr\prjProjectMenu.gif" needed-file ! s" doc\promgr\prjHelpMenu.gif" needed-file ENDDOC |
1040 messages has been excluded from this view by a project administrator.
