\ File: TextEdit.f \ Author: Jeff Kelm \ Created: 04-Sep-1998 \ Updated: 15-Oct-1998 NEEDS WinBase.f NEEDS Menubar.f NEEDS Toolbar.f NEEDS Statbar.f NEEDS Editbox.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Define control ID values \ CreateNewID CONSTANT IDM_NEW CreateNewID CONSTANT IDM_OPEN CreateNewID CONSTANT IDM_SAVE CreateNewID CONSTANT IDM_SAVEAS CreateNewID CONSTANT IDM_PGSETUP CreateNewID CONSTANT IDM_PRINT CreateNewID CONSTANT IDM_EXIT CreateNewID CONSTANT IDM_UNDO CreateNewID CONSTANT IDM_CUT CreateNewID CONSTANT IDM_COPY CreateNewID CONSTANT IDM_PASTE CreateNewID CONSTANT IDM_DEL CreateNewID CONSTANT IDM_ALL CreateNewID CONSTANT IDM_FIND CreateNewID CONSTANT IDM_NEXT CreateNewID CONSTANT IDM_REPL CreateNewID CONSTANT IDM_TOPICS CreateNewID CONSTANT IDM_ABOUT CreateNewID CONSTANT IDM_WRAP CreateNewID CONSTANT ID_EDITCHILD CreateNewID CONSTANT IDM_READONLY CreateNewID CONSTANT ID_TOOLBAR \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Create a semi-standard window menubar \ :Object appMenu rel @ \ get control id CASE IDM_NEW OF Z" New" ENDOF IDM_OPEN OF Z" Open" ENDOF IDM_SAVE OF Z" Save" ENDOF IDM_CUT OF Z" Cut" ENDOF IDM_COPY OF Z" Copy" ENDOF IDM_PASTE OF Z" Paste" ENDOF IDM_UNDO OF Z" Undo" ENDOF IDM_DEL OF Z" Delete" ENDOF IDM_PRINT OF Z" Print" ENDOF IDM_ABOUT OF Z" About" ENDOF DEFAULTOF Z" Undef" ENDOF ENDCASE rel>abs SWAP 3 CELLS + abs>rel ! ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Statusbar \ Statusbar sBar \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Openfile Dialog Box \ FileOpenDialog BrowseText "Open Text File" "Text Files|*.txt;*.f;*.asm;*.doc;*.seq;*.bat;*.c??;*.h|All Files|*.*|" CREATE cur-filename MAX-PATH ALLOT 0 VALUE text-len \ length of text 0 VALUE text-ptr \ address of current text line 0 VALUE text-blen \ total text buffer length : "open-text ( a1 n1 -- ) 2DUP R/O OPEN-FILE 0= IF >R MAX-PATH MIN cur-filename place \ release/allocate the text buffer text-ptr ?DUP IF FREE DROP THEN R@ FILE-SIZE DROP ( ior) D>S ( 32-bits) TO text-len text-len 10000 + TO text-blen text-blen ALLOCATE DROP TO text-ptr \ read the file into memory text-ptr text-len R@ READ-FILE DROP TO text-len R> CLOSE-FILE DROP \ null terminate text 0 text-ptr text-len + C! else 3drop \ October 9th, 1998 - 22:09 Bruno Gauthier then ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Multiline Edit Control Window \ GenericMultilineEdit wEdit \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Generic Sample Window for testing \ 0 VALUE hWnd \ to hold handle for application window : appName Z" Editor" rel>abs ; : wTitle Z" Untitled - WinPad" rel>abs ; \ Object to build and hold window title :Object szTitle abs ;M ;Object \ Default "Not Implemented" function for menu items : MenuFunc MB_OK Z" Command" rel>abs Z" Not implemented yet." rel>abs hWnd Call MessageBox drop ; \ Define the window procedure : (MainWndProc) { hWnd msg wParam lParam -- result } msg CASE WM_CREATE OF hWnd Create: tBar \ create toolbar control hWnd Create: sBar \ Create a statusbar hWnd Create: wEdit \ Create a TextEdit control \ initialize menu check marks UncheckWrap: appMenu UncheckReadOnly: appMenu 0 ENDOF WM_SETFOCUS OF GetHandle: wEdit Call SetFocus DROP 0 ENDOF WM_SIZE OF TRUE \ size Edit control lParam HIWORD GetWindowSize: tBar DROP - GetWindowSize: sBar DROP - ( height) lParam LOWORD ( width) GetWindowSize: tBar DROP ( top) 0 ( left) GetHandle: wEdit Call MoveWindow \ size Toolbar 0 0 TB_AUTOSIZE SendMessage: tBar DROP \ size Statusbar Redraw: sBar 0 ENDOF WM_COMMAND OF ( htBar idButton WM_COMMAND hWnd) wParam LOWORD CASE IDM_UNDO OF Undo: wEdit ENDOF IDM_CUT OF Cut: wEdit ENDOF IDM_COPY OF Copy: wEdit ENDOF IDM_PASTE OF Paste: wEdit ENDOF IDM_DEL OF Clear: wEdit ENDOF IDM_ALL OF SelectAll: wEdit ENDOF IDM_WRAP OF MenuFunc ENDOF IDM_ABOUT OF MenuFunc ENDOF IDM_READONLY OF GWL_STYLE GetWindowLong: wEdit ES_READONLY AND 0= IF TRUE ReadOnly: wEdit CheckReadOnly: appMenu ELSE FALSE ReadOnly: wEdit UncheckReadOnly: appMenu THEN hWnd Call DrawMenuBar ?WinError ENDOF IDM_NEW OF SelectAll: wEdit Clear: wEdit 0 0 EM_EMPTYUNDOBUFFER GetHandle: wEdit Call SendMessage DROP S" Untitled" cur-filename place ( reset titlebar) update: szTitle display: szTitle 0 WM_SETTEXT hWnd Call SendMessage DROP ENDOF IDM_OPEN OF \ open a file hWnd Start: BrowseText DUP C@ IF COUNT "open-text ELSE DROP THEN \ Add text to window text-ptr rel>abs 0 WM_SETTEXT SendMessage: wEdit DROP hWnd Call UpdateWindow text-ptr FREE DROP ( free alloc buffer) \ update titlebar update: szTitle display: szTitle 0 WM_SETTEXT hWnd Call SendMessage DROP ENDOF IDM_SAVE OF MenuFunc ENDOF IDM_SAVEAS OF MenuFunc ENDOF IDM_PGSETUP OF MenuFunc ENDOF IDM_PRINT OF MenuFunc ENDOF IDM_FIND OF MenuFunc ENDOF IDM_NEXT OF MenuFunc ENDOF IDM_REPL OF MenuFunc ENDOF IDM_TOPICS OF MenuFunc ENDOF IDM_EXIT OF hWnd Call DestroyWindow ?WinError ENDOF ENDCASE 0 ENDOF WM_NOTIFY OF \ ( ^LPNMHDR idButton WM_NOTIFY hWnd) lparam 2 CELLS + abs>rel @ \ fetch code from NMHDR structure CASE TTN_NEEDTEXT OF lparam SetTooltipText: tBar ENDOF DEFAULTOF TRUE ENDOF ENDCASE ENDOF WM_CLOSE OF text-ptr FREE DROP ENDOF WM_DESTROY OF Call PostQuitMessage ENDOF DEFAULTOF lParam wParam msg hWnd Call DefWindowProc ENDOF ENDCASE ; 4 callback MainWndProc (MainWndProc) \ Application Window Class structure CREATE wcSample \ WNDCLASS structure NULL , \ style MainWndProc rel>abs , \ lpfnWndProc 0 , \ cbClsExtra 0 , \ cbWndExtra appInst , \ hInstance IDI_APPLICATION NULL call LoadIcon , \ hIcon IDC_ARROW NULL call LoadCursor , \ hCursor WHITE_BRUSH call GetStockObject , \ hbrBackground appName , \ lpszMenuName appName , \ lpszClassName : CreateMainWindow ( -- hWnd) NULL \ creation parameters appInst \ instance handle GetHandle: appMenu \ menu handle NULL \ parent window CW_USEDEFAULT CW_USEDEFAULT \ window size ( h w) CW_USEDEFAULT CW_USEDEFAULT \ window position ( y x ) WS_OVERLAPPEDWINDOW \ window style wTitle \ window title appName \ class name NULL \ extended window style Call CreateWindowEx ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Main Routines : CLEANUP appInst appName Call UnregisterClass ?WinError text-ptr FREE DROP ; : DEMO ( -- ) Create: appMenu wcSample rel>abs Call RegisterClass ?WinError CreateMainWindow DUP TO hWnd ?WinError SW_SHOWNORMAL hWnd Call ShowWindow DROP hWnd Call UpdateWindow ?WinError ; CR .( Type 'DEMO' to run program and 'CLEANUP' afterwards )