FoxFAQ Pt4b More Tips etc 
Author Message
 FoxFAQ Pt4b More Tips etc

PART 4b
This is an interim and incomplete version of the FAQ and is posted for
convenience and comment.
Accreditations have been omitted temporarily but will be re-instated
when the upgrades are more complete
July 10th, 1995  Gordon Angus,  Perth FPUG

More Tips etc

Index

Diagonal Lines In FoxProw
Save Structures for Tables in a Directory (Create Data Dictionary)
Save Indexes and Filters for Tables in a Directory
Passwords (3 examples)
Disable Escape Key during Screen Input

DIAGONAL LINES IN FOXPRO/WINDOWS (Doug Blank)

IT is sad but true: you cannot draw a diagonal line  in FoxPro. I did
try
dropping down to the windows API, and you can in fact draw any thing
that you want in the fox window --- but Fox doesn't "know" about it.
Therefore, if you close the window and reopen it your line is gone.
Any time that you cover your line, it won't be redrawn.

So, I finally ended up with the solution below. It does a pretty good
job on arbitrary lines. You may have to adjust x and y dotsize. These
parameters exist because of translation problems from real-valued
points to screen coordinates (welcome to the world of GUI's!)

To use, call with:


11,30 or
=drawline(1,5,11,30)     && to produce a black line

Using this method, you can draw circles, splines, etc. Put the
function below in your program, or comment out the first line and
place in a file named DRAWLINE.PRG. It's not real fast nor smooth,
but it works. You probably can't make the line any thinner due to
related problems with real-valued vs. screen coordinates, so pensize
and penlength probaly can't be changed. You can change the RGB()
funtion to make any colors you want, or even add a CASE statement to
do them all, add shadows, etc.

FUNCTION drawline
PARAMETER x1,y1,x2,y2,color
PRIVATE x,y,B,slope
#DEFINE xdotsize (.2)
#DEFINE ydotsize (.5)
#DEFINE pensize (3)
#DEFINE penlen (.7)
IF m.y1 = m.y2 && vertical line
   IF x1 < x2
      IF color

            RGB(0,255,0,255,255,255) style "T"
      ELSE

            RGB(255,0,255,255,255,255) style "T"
      ENDIF
   ELSE
      IF color

            RGB(0,255,0,255,255,255) style "T"
      ELSE

            RGB(255,0,255,255,255,255) style "T"
      ENDIF
   ENDIF
ELSE
   m.slope = (m.x1 - m.x2)/(m.y1 - m.y2)
   m.B = m.x1 - (m.slope * m.y1)
   IF ABS((m.x1 - m.x2) / xdotsize) > ABS((m.y1 - m.y2) / ;
      ydotsize)
      FOR m.x = m.x1 TO m.x2 STEP xdotsize * ;
         IIF( m.x1 > m.x2, -1, 1)
            m.y = (m.x - m.B) / m.slope
            IF color

                  pensize color RGB(0,255,0,255,255,255) ;
                  style "T"
            ELSE

                  pensize color RGB(255,0,255,255,255,255) ;
                  style "T"
            ENDIF
      ENDFOR
   ELSE
      FOR m.y = m.y1 TO m.y2 STEP ydotsize * IIF( m.y1 > ;
         m.y2, -1, 1)
         m.x = (m.slope * m.y) + m.B
         IF color

               pensize color RGB(0,255,0,255,255,255);
               style "T"
         ELSE

               pensize color RGB(255,0,255,255,255,255) ;
               style "T"
         ENDIF
      ENDFOR
   ENDIF
ENDIF
RETURN

SAVE STRUCTURES FOR  TABLES IN A DIRECTORY
Read all the table structures for files in a given directory and
output them to a text file.:

SET TALK OFF
CLEAR ALL
PRIVATE ALL LIKE l*

*prompt the user for a directory
lDirectory = GETDIR(CURDIR(), "Select a directory containing tables:")

* make sure they selected one
IF !EMPTY(lDirectory)

*       *read all of the names of tables into an array
        lHits = ADIR(lTables, lDirectory + "*.DBF")

*       *make sure we have found some tables
        IF lHits == 0
                WAIT WINDOW "No tables found in " + lDirectory
        ELSE
                WAIT WINDOW "Processing tables..." NOWAIT
                SELECT 0

*                       *we need some temporary work space
                CREATE CURSOR work (FileName C(8), StrucList M(10))

*               *process each table in the array
                FOR lCount = 1 TO lHits

*                       *get a temporary file name
                        lTempFile = SYS(3) + ".TXT"

*                           *build the full path to the file, then open the
table
                        lFileSpec = lDirectory + lTables[lCount, 1]
                        SELECT 0
                        USE (lFileSpec)

*                       *write the structure info out to the temporary
file
                        DISPLAY STRUCTURE NOCONSOLE TO FILE
(lTempFile)

*                       *add a new record for this table
                        INSERT INTO work (FileName) VALUES
(lTables[lCount, 1])

*                       *we no longer need the table open
                         USE
                        SELECT work

*                       *load the temporary file into the memo field
                        APPEND MEMO StrucList FROM (lTempFile)

*                       *ensure we clean up the temporary file
                        DELETE FILE (lTempFile)

*                 *any further processing goes here, for instance one
might
*                 *want to parse out useful info into separate fields

                ENDFOR
                GO TOP

*               *this is the easiest way to write to a text file
                SET TEXTMERGE ON
                SET TEXTMERGE TO struc.txt NOSHOW
                \Table Structure Listing
                  \-----------------------

*               *for each record, output the structure memo
                SCAN
                        \<<StrucList>>
                ENDSCAN
                SET TEXTMERGE TO
                SET TEXTMERGE OFF
                USE
                WAIT WINDOW ALLTRIM(STR(lHits)) + " tables processed!"
NOWAIT
        ENDIF
ENDIF
RETURN

SAVE INDEXES AND FILTERS FOR TABLES IN A DIRECTORY (Eli Linkov)

*INDEXSAV.PRG
*       this program can be used to set up a .DBF in the system
directory of a
*       project which holds the project's table names and the index
(and filter,
*       if any names of each table. The table name is DBINFO.DBF.
*       The structure of the table is
*                       field   dbfname   12 chars
*                       field   infomemo   memo field
*
*                       The memo field will hold the index name, index
expression
*               and filter, if any, as indexname/expression%filter
*                       on one line of the memo per index
*
*       This program should be run to create the dbfinfo table and
ass'd memo
*       once the system is ready for installation.
*       The table/memo should be installed at the user site in the
"system"
*   directory, together with an EXE version of the INDEXMAK program.
*       The INDEXMAK.EXE should only be available via the file manager
to
*       the system caretaker, and should not have an program manager
icon
*        associated with it.
*       To recover indexing on the project tables, INDEXMAK.EXE should
be run
*       if the indexes are suspected of being corrupted.

CLOSE DATABASES

* the next 2 lines should be amended to suit the project path names
datapath =  "C:\sxc\sxcbuild\"          && where the indexed tables
are
workpath =  "C:\sxc\sxcmaint\"           && where the system EXE is

IF NOT FILE(workpath + "dbfinfo.dbf")
        SET DEFAULT TO (workpath)

        * create the table to be used by INDEXMAK.PRG
        CREATE TABLE dbfinfo (dbfname C(12), infomemo m)
ENDIF

SET DEFAULT TO &datapath

DIMENSION filelist(1)
=ADIR(filelist,"*.dbf")

CLOSE DATA
SET DEFAULT TO &workpath

SELECT 0
USE dbfinfo EXCLUSIVE
SET SAFETY OFF
ZAP
SET SAFETY ON

APPEND FROM ARRAY filelist
RELEASE filelist
GO TOP
SET DEFAULT TO &datapath
SCAN
        TEXT = ALLTRIM(dbfname)
        IF TEXT = "DBFINFO.DBF"
        ELSE
                REPLACE dbfname WITH LEFT(TEXT,LEN(TEXT) - 4)
                SELECT 0
                USE  (dbfinfo.dbfname) EXCLUSIVE
                DIMENSION taglist(1,3)
                indexstr = ""
                arrct = 1
                DO WHILE NOT EMPTY(TAG(arrct))
                        taglist(arrct,1) = TAG(arrct)           && the
tag name
                        taglist(arrct,2) = SYS(14,arrct)        && the
tag expression
                        taglist(arrct,3) = sys(2021,arrct)      && the
tag filter (if any)
                        arrct = arrct + 1
                        DIMENSION taglist(arrct,3)
                ENDDO
                SELECT dbfinfo
                FOR x = 1 TO arrct - 1
                   indexstr=indexstr+taglist(x,1)+"/"+taglist(x,2);
                   +"%"+taglist(x,3)+CHR(13)
                ENDFOR
                REPLACE infomemo WITH indexstr
        ENDIF
ENDSCAN
SET DEFAULT TO &workpath
CLOSE DATA

*INDEXMAK.PRG
*       This program is used to recover indexes when the project
tables are
*       suspected of being corrupted.  It uses the DBFINFO.DBF table
produced
*       by the program INDEXSAV.PRG to recover the index names,
expressions and
*       filters and re-applies this information to the tables.
*
*       This program should be installed at the user site as an EXE
file, only
*       useable via the file manager. It should not have an icon
associated
*       with it for use via the program manager.
*
* the table was set up by indexsav.prg in the system directory
* fields - dbfname      C 12
*        - infomemo     M

CLOSE DATABASES

* set this path for data tables & system EXE
datapath =  "C:\sxc\sxcbuild\"
workpath = "c:\sxc\sxcmaint\"

SET DEFAULT TO &workpath
SELECT 0
USE dbfinfo EXCLUSIVE
SET SAFETY OFF
GO TOP
SET DEFAULT TO &datapath
SCAN
        TEXT = ALLTRIM(dbfname)
        IF TEXT = "DBFINFO.DBF"
        ELSE
           SELECT 0
           USE (dbfinfo.dbfname) EXCLUSIVE
           DELETE TAG ALL

           memct = 1
           fred = dbfinfo.infomemo
           IF NOT EMPTY(fred)
               DO WHILE NOT EMPTY(MLINE(dbfinfo.infomemo,memct))
                     fred = ALLTRIM(MLINE(dbfinfo.infomemo,memct))
                     colno1 = AT("/",fred)
                     colno2 = AT("%",fred)
                     tagfield = LEFT(fred,colno1 - 1)
&& tag name
                     tagname = SUBSTR(fred,colno1 + 1,;
                         (colno2 - colno1 - 1)) && tag expression
                     tagfilt = alltrim(RIGHT(fred,LEN(fred) - colno2))
&& tag filter
                     IF tagfilt <> ""
                            INDEX ON &tagfield FOR &tagfilt TAG
&tagname
                     ELSE
                            INDEX ON &tagfield TAG &tagname
                     ENDIF
                     memct = memct + 1
                ENDDO
            ENDIF
        ENDIF
ENDSCAN
SET DEFAULT TO &workpath
SET SAFETY ON
CLOSE DATA

PASSWORDS - EXAMPLE1 (Brian Copeland)
This example is a quick and dirty demo of how to use inkey() in a
procedure to input the password and echo '*'s to the field.

CLEAR
mpassword=''

READ

PROCEDURE checkpass
DO WHILE .T.
   mkey=INKEY(0)
   DO CASE
      CASE mkey=13
         * enter/return
         EXIT

      CASE BETWEEN(mkey,48,57)
         * is a number
         mpassword=mpassword+CHR(mkey)
         mshowpass = mshowpass+'*'

      CASE BETWEEN(mkey,97,122)
         * is lowercase letter
         mpassword=mpassword+CHR(mkey)
         mshowpass = mshowpass+'*'

      CASE BETWEEN(mkey,65,90)
         * is uppercase letter
         mpassword=mpassword+CHR(mkey)
         mshowpass = mshowpass+'*'

      CASE mkey=127
         * backspace
         mpassword=LEFT(mpassword,LEN(mpassword)-1)
         mshowpass=LEFT(mshowpass,LEN(mshowpass)-1)

   ENDCASE
   SHOW GETS
ENDDO
CLEAR READ
* routine to check password
* if password ok return .t.
* otherwise return .f. or invoke security
* procedure
RETURN

PASSWORDS - EXAMPLE2 (R. Premkumar)
* n = max length of password which you want to allow
* c = character string for display (instead of stars, you may want
"Good
*     Morning" to appear progressively as the user types in the
password
* t = title of the window

PROCEDURE password
PARAMETERS N,C,t
PRIVATE ALL

IF (PARA()>0 AND TYPE('n')#'N') OR (PARA()>1 AND TYPE('c')#'C') OR ;
   (PARA()>2 AND TYPE('t')#'C')
   WAIT WINDOW NOWAIT ;
   'Usage : ? PASSWORD( [ <length> [, <display string> [, <title> ]]]
)'
   *In a program you can call this function as, say: a=password()
   RETURN
ENDIF

IF PARA()=0
   N=7
   *   Default length of password.  Used when you call the function
   *   without any parameters
ENDIF

IF PARA()<3
   t='ENTER PASSWORD'  &&Default title
ENDIF

DEFINE WINDOW paswrd  DOUBLE TITLE t ;
        FROM 11,IIF(MAX(N,LEN(t))<10,30,CEIL(35-MAX(N,LEN(t))/2)) ;
        TO 13,IIF(MAX(N,LEN(t))<10,50,CEIL(45+MAX(N,LEN(t))/2))
ACTIVATE WINDOW paswrd
SET COLOR TO x/N

cd=IIF(PARA()<2,REPL('*',N),PADR(C,N,'.'))  &&By default, show stars
ps=""

FOR i=1 TO N

   p=INKEY(0)
   DO CASE
      CASE LAST()=127 &&backspace
         IF i>1

            ps=LEFT(ps,LEN(ps)-1)
         ENDIF
         i=i-2
         i=IIF(i<0,0,i)
      CASE LAST()=13  &&Return
         EXIT
      OTHERWISE

         ps=ps+CHR(p)
   ENDCASE
ENDFOR

SET COLOR TO
RELEASE WINDOW paswrd
RETURN ps

PASSWORDS  -  EXAMPLE3 (John Torrance)
  Will accept a password and check it against the password passed
  into the procedure as a parameter.  The procedure returns .T. or
  .F. indicating if the user was correct.  Optional parameters control
  the number of attempts that the user gets, and the timeout for
  waiting for the user to enter a password.  If no password is
  passed in as a parameter, the procedure will return .T.

     _PassWord - The password to verify against. Not case sensitive!
     _NumTries - Number of times computer will ask before giving
                 up.  Optional, defaults to 1.
     _TimeOut  - Time the computer will wait for the user to enter
                 a KEYSTROKE.  If the user does not press a key (even
                 in the middle of a password) for this amount of
                 seconds, whatever typed to that point is checked as
                 the password.  Optional, defaults to 0 which means
                 wait forever.

PROCEDURE password
PARAMETER _password, _numtries, _timeout
PRIVATE m.password, m.retval, i
m.retval   = .T.
m.talkstat = SET("TALK")
SET TALK OFF

IF !EMPTY( _password )
   **  Set default number of tries (1), and timeout (0=none)
   IF EMPTY( _numtries )
      _numtries = 1
   ENDIF
   IF EMPTY( _timeout )
      _timeout = 0
   ENDIF

   **  Define and activate window
   DEFINE WINDOW lw_pass  AT 0,0  SIZE 4.5,100 ;
         FONT "MS Sans Serif", 8 NOFLOAT NOCLOSE NOMINIMIZE ;
         SYSTEM  COLOR RGB(,,,192,192,192)
   MOVE WINDOW lw_pass CENTER
   ACTIVATE WINDOW lw_pass

   **  Initialize counter of tries and set the return value to 'false'
   i = 0
   m.retval = .F.

   **  Loop until they enter the correct password or run out of tries
   DO WHILE !m.retval .AND. i < _numtries

      **  Display prompt and get word entered (via function)

              FONT "MS Sans Serif", 12  STYLE "BT"
      m.password = passenter( _timeout )

      **  Check the password for validity
      DO CASE
         CASE TRIM(m.password) ==
TRIM(UPPER(LEFT(_password+SPACE(32),32)))
            m.retval = .T.

         *-- This allows them to escape (returning false) if they
press
         *-- enter with a blank password.
         CASE EMPTY( m.password )
            i = _numtries - 1

         OTHERWISE
            SET BELL TO 220,18
            WAIT WINDOW NOWAIT " Invalid Password "
            ?? CHR(7)
            SET BELL TO

      ENDCASE
      i = i + 1
   ENDDO
   RELEASE WINDOW lw_pass
ENDIF

SET TALK &talkstat
SET BELL TO
WAIT CLEAR
RETURN m.retval

**  This procedure gets a word from the user without echoing it.
PROCEDURE passenter
PARAMETER _timeout
PRIVATE _x, _retval
curset = SET("CURSOR")
SET CURSOR OFF

_x = 0
_retval = ''
_falsepass = SPACE(32)

   FONT "FoxFont", 9  COLOR ,RGB(,,,255,255,255)

CLEAR GETS
DO WHILE _x <> 13
   _x = INKEY( _timeout )

   DO CASE
      CASE _x = 127 .OR. _x = 19             && Backspace or left
arrow
         IF LEN( _retval ) > 0
            _retval = LEFT( _retval, LEN( _retval ) - 1 )
         ELSE
            SET BELL TO 440,2
            ?? CHR(7)
            SET BELL TO
         ENDIF

      CASE _x = 0
         _x = 13

      CASE _x = 13

      OTHERWISE
         _retval = _retval + CHR( _x )
   ENDCASE

   _falsepass = LEFT(REPLICATE('', LEN(TRIM(_retval)))+SPACE(32), 32)


      FONT "FoxFont", 9  COLOR ,RGB(,,,255,255,255)
   CLEAR GETS

ENDDO
SET CURSOR &curset
RETURN UPPER(TRIM(_retval))

DISABLING ESCAPE KEY DURING SCREEN INPUT (Timothy A. Callahan)

The SET ESCAPE and ON ESCAPE are methods on handling escapes during a
program execution, e.g., push a button which executes to loop a 100
times
and press escape to interrupt the loop.  In short, when any code is
executing and escape is pressed the action specified by the ON ESCAPE
is
fired, provided SET ESCAPE ON.

When your program is waiting for input, pressing escape has a
different
result.  The ON ESCAPE is not used in this case.  BTW, this is your
problem,
because the READ from your screen is expecting input.  As you found
out,
escape by default terminates the read.

Three possible solutions come to mind:
1) Use the ON KEY LABEL ESCAPE command.  This is similiar to the ON
ESCAPE,
except ON KEY LABEL... intercepts the escape when your program is
waiting
for input.  ON KEY LABEL... does not interrupt program execution.  I
would
recommend not using ON ESCAPE with ON KEY LABEL ESCAPE.  These two
commands
are mutually exclusive.
ON KEY LABEL ESCAPE *   has the program do nothing when an escape is
encountered.

2) If you have a Cancel push button, you can define it as an Escape
button (\?).  

3) Use read VALID snippet to handle ESCAPE:

IF LASTKEY() = 27
  WAIT WINDOW "Escape pressed!" NOWAIT
  DO resetkey  && Make sure LASTKEY() does not return 27 anymore
  RETURN .F.  && Stay in screen
ENDIF

RETURN .T.  && Terminate read



Sun, 28 Dec 1997 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. FoxFAQ Pt4a Tips etc

2. tool tips on class methods, properties, etc.

3. How can I add tool tip to userdefined classes,Datatypes,Function Etc in Vb.net

4. TIP: Counting instances of variables etc

5. FoxFAQ Pt3 Rushmore

6. FoxFAQ

7. Tips on tips...

8. The 3D Engine (Re: Doom.Bas - a legend etc etc)

9. The 3D Engine (Re: Doom.Bas - a legend etc etc)

10. Accessing XLS, CSV, and tab-delimited files, etc etc using ADO

11. VB/VC/VFP etc etc

 

 
Powered by phpBB® Forum Software