Menu
▾
▴
[Win32forth-cvs] win32forth/src/lib AXControl.F, 1.3, 1.4 ScintillaControl.f, 1.4, 1.5 TabControl.f, 1.1, 1.2 treeview.f, 1.5, 1.6
|
From: Dirk B. <db...@us...> - 2006-06-11 07:37:33
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv23478/src/lib Modified Files: AXControl.F ScintillaControl.f TabControl.f treeview.f Log Message: - Changed the TreeViewControl to use the control class as the base class. - Moved some methods from the ProjectTreeViewControl into the TreeViewControl class. - Changed the TreeViewControl to use SendMessage:self and SendMessage:selfdrop - AutoSize: method added to the control and the child-window class. Index: TabControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/TabControl.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TabControl.f 6 Jun 2006 02:58:24 -0000 1.1 --- TabControl.f 11 Jun 2006 07:37:27 -0000 1.2 *************** *** 204,214 **** 0 0 TCM_GETROWCOUNT SendMessage:self ;M - :M AutoSize: ( -- ) - \ *G Resize the control to fit in the client area of the parent window. - tempRect.AddrOf GetClientRect: Parent - 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w - Move: self - ;M - :M Enable: ( f -- ) \ *G Enable the control. --- 204,207 ---- Index: treeview.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/treeview.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** treeview.f 17 May 2006 15:26:17 -0000 1.5 --- treeview.f 11 Jun 2006 07:37:27 -0000 1.6 *************** *** 86,90 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! :Class TreeViewControl <super Child-Window Record: nmhdr --- 86,90 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! :Class TreeViewControl <super control Record: nmhdr *************** *** 157,160 **** --- 157,161 ---- ;RecordSize: /nmtv + Rectangle ItemRect : fill-nmhdr ( l -- ) *************** *** 179,205 **** \ -------------------- Create Tree-View Control -------------------- - create treeview-class z," SysTreeView32" \ Pre-registered class - - : create-treeview ( -- hWnd ) - \ Make sure Common Controls are loaded - Call InitCommonControls drop - - NULL \ Creation parameter - appInst \ Instance handle - id \ Child id - Parent conhndl = - if conhndl - else GetHandle: Parent \ parent window handle - then - tempRect.AddrOf GetClientRect: Parent - Bottom: tempRect Right: tempRect \ Size h,w - 0 0 \ Position y,x - WindowStyle: [ self ] \ Style - NULL \ Window name - treeview-class \ Pre-registered class - 0 \ Extended style - Call CreateWindowEx - ; :M WindowStyle: ( -- style ) --- 180,185 ---- \ -------------------- Create Tree-View Control -------------------- + create treeview-class z," SysTreeView32" \ Pre-registered class :M WindowStyle: ( -- style ) *************** *** 209,225 **** :M Start: ( Parent -- ) hWnd ! if drop ! SW_SHOWNOACTIVATE Show: self ! else ! to Parent ! create-treeview to hWnd ! then ! ;M ! ! :M AutoSize: ( -- ) ! tempRect.AddrOf GetClientRect: Parent ! 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w ! Move: self ! ;M :M Handle_Notify: ( h m w l -- f ) --- 189,198 ---- :M Start: ( Parent -- ) hWnd ! if drop ! SW_SHOWNOACTIVATE Show: self ! else to Parent ! Call InitCommonControls drop ! treeview-class Create-Control ! then ;M :M Handle_Notify: ( h m w l -- f ) *************** *** 244,259 **** ;M - :M ToggleExpandItem: ( hItem -- ) ! TVE_TOGGLE TVM_EXPAND hWnd Call SendMessage drop ;M :M ExpandItem: ( hItem -- ) ! TVE_EXPAND TVM_EXPAND hWnd Call SendMessage drop ;M :M CollapseItem: ( hItem -- ) ! TVE_COLLAPSE TVM_EXPAND hWnd Call SendMessage drop ;M :M SortChildren: ( hItem -- ) ! false TVM_SORTCHILDREN hWnd Call SendMessage drop ;M :M DeleteItem: ( hItem -- ) --- 217,231 ---- ;M :M ToggleExpandItem: ( hItem -- ) ! TVE_TOGGLE TVM_EXPAND SendMessage:SelfDrop ;M :M ExpandItem: ( hItem -- ) ! TVE_EXPAND TVM_EXPAND SendMessage:SelfDrop ;M :M CollapseItem: ( hItem -- ) ! TVE_COLLAPSE TVM_EXPAND SendMessage:SelfDrop ;M :M SortChildren: ( hItem -- ) ! false TVM_SORTCHILDREN SendMessage:SelfDrop ;M :M DeleteItem: ( hItem -- ) *************** *** 261,265 **** \ ** hItem is the handle of the item to delete. If hItem is set to TVI_ROOT, \ ** all items are deleted. ! 0 TVM_DELETEITEM hWnd Call SendMessage drop ;M --- 233,276 ---- \ ** hItem is the handle of the item to delete. If hItem is set to TVI_ROOT, \ ** all items are deleted. ! 0 TVM_DELETEITEM hWnd SendMessage:SelfDrop ;M ! ! :M InsertItem: ( -- hItem ) tvins 0 TVM_INSERTITEM SendMessage:Self ;M ! :M SetImageList: ( himl iImage -- ) TVM_SETIMAGELIST SendMessage:SelfDrop ;M ! :M DeleteItem: ( hItem -- f ) 0 TVM_DELETEITEM SendMessage:Self ;M ! :M SetItem: ( -- ) tvitem 0 TVM_SETITEM SendMessage:SelfDrop ;M ! :M Expand: ( hItem f -- ) TVM_EXPAND SendMessage:SelfDrop ;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:Self ;M ! :M SelectItem: ( hItem -- ) TVGN_CARET TVM_SELECTITEM SendMessage:SelfDrop ;M ! :M GetNextItem: ( hItem -- h ) TVM_GETNEXTITEM SendMessage:Self ;M ! :M GetRoot: ( -- hItem ) 0 TVGN_ROOT GetNextItem: self ;M ! :M GetChild: ( hItem -- hItem ) TVGN_CHILD GetNextItem: self ;M ! :M GetParentItem: ( hItem -- hItem ) TVGN_PARENT GetNextItem: self ;M ! :M GetNext: ( hItem -- hItem ) TVGN_NEXT GetNextItem: self ;M ! :M GetPrevious: ( hItem -- hItem ) TVGN_PREVIOUS GetNextItem: self ;M ! ! int maxwidth ! : ItemWidthMax ( hItem -- hItem ) ! dup GetItemRect: self IF right: ItemRect maxwidth max to maxwidth THEN ; ! ! :M GetMaxWidth: ( -- n ) ! 0 to MaxWidth ! GetRoot: self ! ItemWidthMax ! GetChild: self ! Begin dup dup ! While ! ItemWidthMax ! GetChild: self ! Begin dup ! While ! ItemWidthMax ! GetNext: self ! Repeat drop ! GetNext: self ! Repeat drop drop ! MaxWidth ! ;M Index: ScintillaControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaControl.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ScintillaControl.f 13 May 2006 20:27:32 -0000 1.4 --- ScintillaControl.f 11 Jun 2006 07:37:27 -0000 1.5 *************** *** 673,687 **** ;M - :M AutoSize: ( -- ) - tempRect.AddrOf GetClientRect: Parent - 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w - Move: self - ;M - - :M ~: ( -- ) - \ DestroyWindow: self \ first destroy the window - ~: super - ;M - \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- --- 673,676 ---- *************** *** 1785,1789 **** \ Execute a Keyboard command ! :M KeyCommand: ( n -- ) 0 0 rot SendMessage:Self drop ;M --- 1774,1778 ---- \ Execute a Keyboard command ! :M KeyCommand: ( n -- ) 0 0 rot SendMessage:Self drop ;M *************** *** 1831,1837 **** \ You can enable the drawing of visual flags to indicate a line is wrapped. Bits set ! \ in wrapVisualFlags determine which visual flags are drawn. Symbol Value Effect ! \ SC_WRAPVISUALFLAG_NONE 0 No visual flags ! \ SC_WRAPVISUALFLAG_END 1 Visual flag at end of subline of a wrapped line. \ SC_WRAPVISUALFLAG_START 2 Visual flag at begin of subline of a wrapped line. \ Subline is indented by at least 1 to make room for the flag. --- 1820,1826 ---- \ You can enable the drawing of visual flags to indicate a line is wrapped. Bits set ! \ in wrapVisualFlags determine which visual flags are drawn. Symbol Value Effect ! \ SC_WRAPVISUALFLAG_NONE 0 No visual flags ! \ SC_WRAPVISUALFLAG_END 1 Visual flag at end of subline of a wrapped line. \ SC_WRAPVISUALFLAG_START 2 Visual flag at begin of subline of a wrapped line. \ Subline is indented by at least 1 to make room for the flag. *************** *** 1844,1851 **** \ You can set wether the visual flags to indicate a line is wrapped are drawn near \ the border or near the text. Bits set in wrapVisualFlagsLocation set the location ! \ to near the text for the corresponding visual flag. Symbol Value Effect ! \ SC_WRAPVISUALFLAGLOC_DEFAULT 0 Visual flags drawn near border ! \ SC_WRAPVISUALFLAGLOC_END_BY_TEXT 1 Visual flag at end of subline drawn near text ! \ SC_WRAPVISUALFLAGLOC_START_BY_TEXT 2 Visual flag at begin of subline drawn near text :M SetWrapVisualFlagsLocation: ( wrapVisualFlagsLocation -- ) 0 swap SCI_SETWRAPVISUALFLAGSLOCATION SendMessage:Self ;M --- 1833,1840 ---- \ You can set wether the visual flags to indicate a line is wrapped are drawn near \ the border or near the text. Bits set in wrapVisualFlagsLocation set the location ! \ to near the text for the corresponding visual flag. Symbol Value Effect ! \ SC_WRAPVISUALFLAGLOC_DEFAULT 0 Visual flags drawn near border ! \ SC_WRAPVISUALFLAGLOC_END_BY_TEXT 1 Visual flag at end of subline drawn near text ! \ SC_WRAPVISUALFLAGLOC_START_BY_TEXT 2 Visual flag at begin of subline drawn near text :M SetWrapVisualFlagsLocation: ( wrapVisualFlagsLocation -- ) 0 swap SCI_SETWRAPVISUALFLAGSLOCATION SendMessage:Self ;M *************** *** 1858,1862 **** \ sizes, but values less than 0 or large values may have undesirable effects. \ The indention of sublines is independent of visual flags, but if SC_WRAPVISUALFLAG_START ! \ is set an indent of at least 1 is used. :M SetWrapStartIdent: ( indent -- ) 0 swap SCI_SETWRAPSTARTINDENT SendMessage:Self ;M --- 1847,1851 ---- \ sizes, but values less than 0 or large values may have undesirable effects. \ The indention of sublines is independent of visual flags, but if SC_WRAPVISUALFLAG_START ! \ is set an indent of at least 1 is used. :M SetWrapStartIdent: ( indent -- ) 0 swap SCI_SETWRAPSTARTINDENT SendMessage:Self ;M *************** *** 1866,1874 **** \ You can set cacheMode to one of the symbols in the table: ! \ Symbol Value Layout cached for these lines ! \ SC_CACHE_NONE 0 No lines are cached. ! \ SC_CACHE_CARET 1 The line containing the text caret. This is the default. ! \ SC_CACHE_PAGE 2 Visible lines plus the line containing the caret. ! \ SC_CACHE_DOCUMENT 3 All lines in the document. :M SetLayoutCache: ( cacheMode -- ) 0 swap SCI_SETLAYOUTCACHE SendMessage:Self ;M --- 1855,1863 ---- \ You can set cacheMode to one of the symbols in the table: ! \ Symbol Value Layout cached for these lines ! \ SC_CACHE_NONE 0 No lines are cached. ! \ SC_CACHE_CARET 1 The line containing the text caret. This is the default. ! \ SC_CACHE_PAGE 2 Visible lines plus the line containing the caret. ! \ SC_CACHE_DOCUMENT 3 All lines in the document. :M SetLayoutCache: ( cacheMode -- ) 0 swap SCI_SETLAYOUTCACHE SendMessage:Self ;M *************** *** 1880,1884 **** \ pixelWidth wide. Splitting occurs on word boundaries wherever possible in a \ similar manner to line wrapping. When pixelWidth is 0 then the width of the ! \ window is used. :M LineSplit: ( pixelWidth -- ) 0 swap SCI_LINESSPLIT SendMessage:Self ;M --- 1869,1873 ---- \ pixelWidth wide. Splitting occurs on word boundaries wherever possible in a \ similar manner to line wrapping. When pixelWidth is 0 then the width of the ! \ window is used. :M LineSplit: ( pixelWidth -- ) 0 swap SCI_LINESSPLIT SendMessage:Self ;M *************** *** 1886,1890 **** \ Join a range of lines indicated by the target into one line by removing line \ end characters. Where this would lead to no space between words, an extra space ! \ is inserted. :M LinesJoin: ( -- ) 0 0 SCI_LINESJOIN SendMessage:Self ;M --- 1875,1879 ---- \ Join a range of lines indicated by the target into one line by removing line \ end characters. Where this would lead to no space between words, an extra space ! \ is inserted. :M LinesJoin: ( -- ) 0 0 SCI_LINESJOIN SendMessage:Self ;M *************** *** 1892,1896 **** \ ----------------------------------------------------------------------------- ! \ Tabs \ ----------------------------------------------------------------------------- --- 1881,1885 ---- \ ----------------------------------------------------------------------------- ! \ Tabs \ ----------------------------------------------------------------------------- *************** *** 1917,1928 **** \ ----------------------------------------------------------------------------- ! \ Printing \ ----------------------------------------------------------------------------- Record: RangeToFormat ! int hdcPrinter ! int hdcTarget ! rectangle Pagesize ! rectangle rcPage int cpMin \ CharacterRange int cpMax --- 1906,1917 ---- \ ----------------------------------------------------------------------------- ! \ Printing \ ----------------------------------------------------------------------------- Record: RangeToFormat ! int hdcPrinter ! int hdcTarget ! rectangle Pagesize ! rectangle rcPage int cpMin \ CharacterRange int cpMax *************** *** 1938,1942 **** : SetFormatRange ( -- ) GetHandle: ThePrinter dup to hdcPrinter to hdcTarget ! rtMargin @ Xpixels rtMargin cell+ @ Ypixels Width: ThePrinter rtMargin 2 cells+ @ Xpixels - Height: ThePrinter rtMargin 3 cells+ @ Ypixels - --- 1927,1931 ---- : SetFormatRange ( -- ) GetHandle: ThePrinter dup to hdcPrinter to hdcTarget ! rtMargin @ Xpixels rtMargin cell+ @ Ypixels Width: ThePrinter rtMargin 2 cells+ @ Xpixels - Height: ThePrinter rtMargin 3 cells+ @ Ypixels - *************** *** 1961,1965 **** REPEAT dup nToPage w! nMaxPage w! RestoreDC: ThePrinter ! print-close hDevMode 2! \ restore selected printer \ Number of pages is put into nToPage and nMaxPage --- 1950,1954 ---- REPEAT dup nToPage w! nMaxPage w! RestoreDC: ThePrinter ! print-close hDevMode 2! \ restore selected printer \ Number of pages is put into nToPage and nMaxPage *************** *** 1987,1993 **** WHILE 1+ REPEAT drop ( last PageNo ) ! print-end RestoreDC: ThePrinter ! print-close THEN ;M --- 1976,1982 ---- WHILE 1+ REPEAT drop ( last PageNo ) ! print-end RestoreDC: ThePrinter ! print-close THEN ;M Index: AXControl.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/AXControl.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** AXControl.F 11 Jan 2006 17:45:20 -0000 1.3 --- AXControl.F 11 Jun 2006 07:37:27 -0000 1.4 *************** *** 53,63 **** \ *G AXControl Base class for ActiveX controls - :M AutoSize: ( -- ) - \ Resize the ActiveX Control to fit into the client area of his parent window. - tempRect.AddrOf GetClientRect: Parent - 0 0 Right: tempRect Bottom: tempRect \ x,y,h,w - Move: self - ;M - :M AXUCreate: ( ustr -- ) \ *G calls unicode creation function --- 53,56 ---- |
