Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / DATABASE / YME060.ZIP / YSAMPLES.PRG < prev

Wrap

Text File | 1993-08-28 | 15.8 KB | 476 lines

* YSamples.prg * * Sample application for YAME -- Yet Another Memo Editor * * by Kenneth Chan * Please refer to YAME.DOC for contacts * * 08/21/93 * use YSAMPLES define popup uYAME from 7,26 define bar 1 of uYAME prompt " Single memo with .FMT " message " WP option in CONFIG.DB " define bar 2 of uYAME prompt " Multiple memo with .FMT " message " WP option in CONFIG.DB and YAMEPARM " define bar 3 of uYAME prompt " .BIN invocation " message " LOAD and CALL " define bar 4 of uYAME prompt "──────────────────────────" skip define bar 5 of uYAME prompt " Last two rows problem " message " Demonstrate problem with losing lines 23 and 24 " define bar 6 of uYAME prompt " Last two rows solution " message " Workaround for problem with losing lines 23 and 24 " define bar 7 of uYAME prompt "──────────────────────────" skip define bar 8 of uYAME prompt " Go to dot prompt " message " RETURN " define bar 9 of uYAME prompt " Go to DOS " message " QUIT " on selection popup uYAME deactivate popup do while .t. clear @ 4,34 say "YAME Samples" @ 3,26 to 5,53 double activate popup uYAME do case case "Single" $ prompt() do Fmt1 case "Multiple" $ prompt() do Fmt2 case "BIN" $ prompt() do BinInvoc case "problem" $ prompt() do RowsProb case "solution" $ prompt() do RowsSol case "DOS" $ prompt() quit otherwise exit endcase enddo release popup uYAME use in YSAMPLES RETURN PROCEDURE Fmt1 set format to YSAMPLE1 *-- Goto record with memo formatted for this form. In your applications, *-- all your memos will be formatted the same, but in this demo file, there *-- are different memos for the different implementations/margins. goto 1 && soft returns at 57 margin edit next 1 nomenu set format to RETURN PROCEDURE Fmt2 set format to YSAMPLE2 load YAMEPARM *-- Goto record with memo formatted for this form. goto 2 && soft returns at 37 margin edit next 1 nomenu *-- Uninstall YAMPARM by CALLing it with no parameters call YAMEPARM release module YAMEPARM set format to RETURN PROCEDURE BinInvoc *-- Load YAME (note .COM extension) load Y.COM *-- Load edit buffer load YAMEBUFF *-- Init buffer with maximum allowed memo size. 65024 is maximum maximum. call YAMEBUFF with 65024 *-- Goto record with memo formatted for this form. goto 3 && YAME native; no soft returns clear @ 1, 1 say ".BIN invocation: using the provided MemoKey() function, you can simulate the" @ 2, 1 say "standard key action for a memo field. Here, there is one open window and one" @ 3, 1 say "memo marker. The YAMEBUFF.BIN file must be loaded and initialized for the" @ 4, 1 say ".BIN invocation to work." @ 7, 0 to 7,79 @ 8,27 say "Topic" @ 8,33 get TOPIC @ 10,14 say "Argument FOR" *-- Putting the memo marker one row down and one column to the right * ╔══════════════════════╗ * ║memo ║ * ║ ║ * ║ ║ * ╚══════════════════════╝ *-- of the window puts cursor at top left of the inside of the memo window @ 12, 1 get ARG_PRO ; when MemoKey( 11, 0, 19, 39, "/i19,1" ) *-- Display the contents of the open window do DispMemo with "ARG_PRO", 11, 0, 19, 39 *-- For this field use a memo marker @ 10,52 say "Argument AGAINST" *-- by putting the memo field outside the window @ 10,69 get ARG_CON ; when MemoKey( 11, 40, 19, 79, "/i19,41" ) @ 22,28 say "by" @ 22,31 get AUTHOR read *-- Uninstall YAMEBUFF with CALLing with no parameters call YAMEBUFF release module YAMEBUFF *-- No separate uninstall for Y.COM; just RELEASE release module Y RETURN PROCEDURE RowsProb clear @ 1, 0 to 23,79 176 *-- Goto record with memo formatted for this demo goto 1 *-- Copy the memo field to a temp file to workaround abort READ anomaly copy to ONEMEMO field ARG_CON next 1 use ONEMEMO in select() @ 4, 6 get TOPIC ; message " Cursor down to the memo field " @ 6, 6 get ONEMEMO->ARG_CON ; message " Press CTRL-HOME then press ESC. Watch this line and the line above. " @ 8, 6 get AUTHOR ; message " Cursor up to the memo field " read *-- If changes were made, copy memo back from temp file if readkey() >= 256 replace ARG_CON with ONEMEMO->ARG_CON endif *-- Erase temp file(s) use in ONEMEMO erase ONEMEMO.DBF erase ONEMEMO.DBT RETURN PROCEDURE RowsSol clear @ 1, 0 to 23,79 176 *-- Goto record with memo formatted for this demo goto 1 *-- Copy the memo field to a temp file to workaround abort READ anomaly copy to ONEMEMO field ARG_CON next 1 use ONEMEMO in select() *-- State variable public n_MemoScrn * 0 == no checking * 1 == initial entry into memo field * 2 == grab next key * 3 == screen saved *-- Set state for initial entry into memo field n_MemoScrn = 1 @ 4, 6 get TOPIC ; message " Cursor down to the memo field " @ 6, 6 get ONEMEMO->ARG_CON ; when ForcValid() ; valid required MemoScrn() ; error "" ; message " Press CTRL-HOME then press ESC. Watch this line and the line above. " @ 8, 6 get AUTHOR ; message " Cursor up to the memo field " read *-- If changes were made, copy memo back from temp file if readkey() >= 256 replace ARG_CON with ONEMEMO->ARG_CON endif *-- Erase temp file(s) use in ONEMEMO erase ONEMEMO.DBF erase ONEMEMO.DBT *-- Release state variable release n_MemoScrn RETURN FUNCTION ForcValid *---------------------------------------------------------------------------- *-- Programmer..: Kenneth Chan [Zak] CIS:71542,2712 *-- Date........: 01/27/1993 *-- Notes.......: Workaround for losing last two lines on screen when * using external memo editor. * * Forces a VALID check, activating MemoScrn() * *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 01/27/1993 1.0 *-- Calls.......: Works in tandem with MemoScrn() * The memvar n_MemoScrn must be defined, and should be * set to 1 before the READ * *-- State variable * public n_MemoScrn * * 0 == no checking * * 1 == initial entry into memo field * * 2 == grab next key * * 3 == screen saved * *-- Set state for initial entry into memo field * n_MemoScrn = 1 *-- Called by...: WHEN clause of GET *-- Usage.......: when ForcValid() valid required MemoScrn() *-- Example.....: @ 6,11 get NOTES ; * when ForcValid() ; * valid required MemoScrn() ; * error "" *-- Returns.....: .T. *-- Parameters..: <none> *---------------------------------------------------------------------------- if n_MemoScrn = 1 *-- Move to next stage n_MemoScrn = 2 *-- Trigger VALID check keyboard "{CTRL-M}" *-- Silence bell set bell to 19,1 endif if n_MemoScrn = 0 *-- Set state var for next memo field n_MemoScrn = 1 *-- Restore bell to default tone set bell to 512,2 endif RETURN .t. FUNCTION MemoScrn *---------------------------------------------------------------------------- *-- Programmer..: Kenneth Chan [Zak] CIS:71542,2712 *-- Date........: 01/27/1993 *-- Notes.......: Workaround for losing last two lines on screen when * using external memo editor. * * Works better when the ERROR message is set to * nothing (""). * *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 01/27/1993 1.0 *-- Calls.......: Works in tandem with ForcValid() * The memvar n_MemoScrn must be defined * *-- State variable * public n_MemoScrn * * 0 == no checking * * 1 == initial entry into memo field * * 2 == grab next key * * 3 == screen saved *-- Called by...: VALID REQUIRED clause of GET *-- Usage.......: when ForcValid() valid required MemoScrn() *-- Example.....: @ 6,11 get NOTES ; * when ForcValid() ; * valid required MemoScrn() ; * error "" *-- Returns.....: .T. eventually *-- Parameters..: <none> *---------------------------------------------------------------------------- private lRet, nKey if n_MemoScrn > 1 if n_MemoScrn = 3 *-- Restore lines 23 and 24 restore screen from sMemoScrn release screen sMemoScrn endif *-- Wait for keypress nKey = inkey( 0 ) *-- Return VALID false to force next action to occur in *-- current field lRet = .f. *-- Clear VALID error message keyboard " " *-- Ctrl-Home; edit memo if nKey = 29 save screen to sMemoScrn n_MemoScrn = 3 *-- Open memo and force recheck keyboard "{CTRL-HOME}{CTRL-M}" else *-- Don't stop the next key n_MemoScrn = 0 *-- Type the key that was trapped keyboard "{" + ltrim( str( nKey )) + "}" endif else *-- Pass key through lRet = .t. *-- Must init PRIVATE memvar nKey = 0 endif RETURN lRet PROCEDURE DispMemo *---------------------------------------------------------------------------- *-- Programmer..: Kenneth Chan [Zak] CIS:71542,2712 *-- Date........: 07/14/1993 *-- Notes.......: Displays a memo field in a window *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 07/14/1993 1.0 *-- Calls.......: <none> *-- Called by...: <any> *-- Usage.......: do DispMemo with <cMemoFld>, <nTop>, <nLft>, <nBtm>, <nRht> *-- Example.....: do DispMemo with "NOTES", 5, 10, 18, 69 *-- Returns.....: <na> *-- Parameters..: cMemoFld = name of memo field * nTop = top row of window * nLft = left column of window * nBtm = bottom row of window * nRht = right column of window *---------------------------------------------------------------------------- parameter cMemoFld, nTop, nLft, nBtm, nRht private nOldWidth, n1 nOldWidth = set( "MEMOWIDTH" ) *-- Set MEMOWIDTH for window set memowidth to nRht - nLft - 2 *-- Draw border @ nTop, nLft to nBtm, nRht @ nTop + 1, nLft + 1 clear to nBtm - 1, nRht - 1 n1 = 1 *-- Display each line do while n1 < nBtm - nTop @ nTop + n1, nLft + 1 say mline( &cMemoFld., n1 ) n1 = n1 + 1 enddo set memowidth to nOldWidth RETURN FUNCTION MemoKey *---------------------------------------------------------------------------- *-- Programmer..: Kenneth Chan [Zak] CIS:71542,2712 *-- Date........: 07/14/1993 *-- Notes.......: Emulates standard behavior when cursor is on memo marker. * If Ctrl-Home or F9 is pressed, YAME is CALLed. Defaults * to double border, and margins to fit in window. * * If memo field is inside window coordinates, memo is * treated like an OPEN WINDOW. * *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 07/14/1993 1.0 *-- Calls.......: Y.COM, DispMemo *-- Called by...: WHEN clause of GET *-- Usage.......: when MemoKey( <nTop>, <nLft>, <nBtm>, <nRht>, ; * [ <cExtraParm> ] ) *-- Example.....: @ 6,11 get NOTES when MemoKey( 5, 10, 18, 69 ) *-- Returns.....: .T. *-- Parameters..: nTop = top row of window * nLft = left column of window * nBtm = bottom row of window * nRht = right column of window * cExtraParm = extra parameters to pass to YAME *---------------------------------------------------------------------------- parameters nTop, nLft, nBtm, nRht, cExtraParm *-- Make sure extra parameter is defined if pcount() < 5 cExtraParm = "" endif private nRow, nCol, lLoop, cYAMEPARM, cMemoFld, cColorFld *-- Construct YAME parameter string cYAMEParm = "/m" + ltrim( str( nRht - nLft - 2 )) + " /@" + ; ltrim( str( nTop )) + "," + ltrim( str( nLft )) + "," + ; ltrim( str( nBtm )) + "," + ltrim( str( nRht )) + ; " /bd " + cExtraParm + " MEMO_TMP.$DB" cMemoFld = varread() nRow = row() nCol = col() *-- Get the COLOR OF FIELDS cColorFld = substr( set( "ATTRIBUTES" ), rat( ",", set( "ATTRIBUTES" )) + 1 ) if file( "MEMO_TMP.$DB" ) erase MEMO_TMP.$DB endif copy memo &cMemoFld. to MEMO_TMP.$DB lLoop = .t. do while lLoop nKey = inkey( 0 ) do case case nKey = 29 .or. nKey = -8 && Ctrl-Home or F9 save screen to sMemoKey *-- Invoke YAME; exit code returned in parameter string call Y with cYAMEParm restore screen from sMemoKey release screen sMemoKey *-- Check exit code to see if file was saved if cYAMEParm = "0" *-- Update memo field append memo &cMemoFld. from MEMO_TMP.$DB overwrite endif *-- If memo marker is outside the window if nRow < nTop .or. nRow > nBtm .or. nCol + 3 < nLft .or. nCol > nRht *-- Update the memo marker @ nRow, nCol say iif( len( &cMemoFld. ) = 0, "memo", "MEMO" ) color &cColorFld. else *-- Redisplay memo do DispMemo with cMemoFld, nTop, nLft, nBtm, nRht endif *-- Overwrite exit code with original slash cYAMEParm = stuff( cYAMEParm, 1, 1, "/" ) *-- Do not KEYBOARD Ctrl-Home nKey = 0 case "," + ltrim( str( nKey )) + "," $ ; ",1,3,4,5,6,9,13,17,18,19,23,24,27,-400," *-- These keys will move the cursor, let them pass case nKey > 0 .and. nKey < 256 *-- Ignore all other non-function keys nKey = 0 otherwise *-- KEYBOARD function key to allow for ON KEY traps keyboard "{" + ltrim( str( nKey )) + "}" *-- but don't leave nKey = 0 endcase if nKey # 0 *-- Type key keyboard "{" + ltrim( str( nKey )) + "}" clear *-- Quit loop lLoop = .f. endif *-- Move cursor back after possible memo redraw @ nRow, nCol say "" enddo if file( "MEMO_TMP.$DB" ) erase MEMO_TMP.$DB endif *-- Return .T. to read stuffed keystroke RETURN .t. *-- If you don't have dBASE IV v2.0, here's a RAT() UDF FUNCTION RAt *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Reverse "at", returns position a character string is last *-- AT in a larger string. *-- Written for.: dBASE IV *-- Rev. History: 03/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Rat("<cFindStr>","<cBigStr>") *-- Example.....: ? Rat("Test","This is a Test string, with Test data") *-- Returns.....: Numeric value *-- Parameters..: cFindStr = string to find in cBigStr *-- cBigStr = string to look in *------------------------------------------------------------------------------- parameters cFindstr, cBigstr private nPos,nLen nLen = len( cFindstr ) nPos = len( cBigstr ) - nLen + 1 do while nPos > 0 if substr( cBigstr, nPos, nLen ) = cFindstr exit else nPos = nPos - 1 endif enddo RETURN max( nPos, 0 ) *-- EoF: RAt()