Monthly Archives: April 2012

Environment Variables

Posted on by vivaclipper

/*

GETENV() is an environment function that retrieve information
from the DOS environment into an application program.

Typically, this is configuration information, including path names,
that gives the location of files (database, index, label, or reports).

*/

PROCEDURE Main()
 ? " Computer Name:", GETENV( "COMPUTERNAME" )
 ? " Home Drive :", GETENV( "HOMEDRIVE" ) 
 ? " Home Path :", GETENV( "HOMEPATH" ) 
 ? " LogOn Server :", GETENV( "LOGONSERVER" ) 
 ? " Number of Processors :", GETENV( "NUMBER_OF_PROCESSORS" ) 
 ? " Processor Architecture :", GETENV( "PROCESSOR_ARCHITECTURE" ) 
 ? " Processor Identifier :", GETENV( "PROCESSOR_IDENTIFIER" )
 ? " Processor Level :", GETENV( "PROCESSOR_LEVEL" )
 ? " Processor Revision :", GETENV( "PROCESSOR_REVISION" )
 ? " OS :", GETENV( "OS" )
 ? " Session Name :", GETENV( "SESSIONNAME" ) 
 ? " User Domain :", GETENV( "USERDOMAIN" ) 
 ? " User Name :", GETENV( "USERNAME" )
 ? " User Profile :", GETENV( "USERPROFILE" )
 ? " Command Specification:", GETENV( "COMSPEC")
 ? " TEMP Folder :", GETENV( "TEMP" )
 ? " TMP Folder :", GETENV( "TMP" )
 ? " WINDOWS Folder :", GETENV( "WINDIR" )
 ? " Program Files Folder :", GETENV( "PROGRAMFILES" ) 
 ? " Prog. files extentions :", GETENV( "PATHEXT" )
 ? " Default Path :", GETENV( "PATH" )
 ?
RETURN // Main()

Variables

Posted on by vivaclipper

/*

Variables are place-holders for data units with variable values;

their value may change while program running.

Variables have “type”, depending value of holded data item.

Type of variables haven’t be declared or defined previously; type of a variable determined
“on the fly” ( automatically ) by system when a value assigned (even changed by type) to
this variable.

Variables have also “scope” (or visibility) and this is most important issue about variables.

This example demonstrate defining and usage of variables in basic manner.

*/

PROCEDURE Main()

LOCAL cExclusiveForPMain := "The variable 'cExclusiveForPMain' is 'LOCAL' in the " +;
 "Main() procedure; thus inaccessible outside of Main()"

 SETMODE( 60, 300 )
 CLS

 PUBLIC cPublicizedInMain := "The variable 'cPublicizedInMain' declared as 'PUBLIC' "+ ;
 " in the Main () procedure; thus is accessible everywhere"

 PRIVATE cPrivatizedInMain := "The variable 'cPrivatizedInMain' declared as 'PRIVATE' " +;
 " in the Main() procedure;" + ; 
 " thus is accessible everywhere"

 cUndeclaredInMain := "The variable 'cUndeclaredInMain' is UN-declared but assigned value " +;
 " in the Main() procedure;" + ; 
 " thus is PRIVATE (by default) and accessible everywhere"
 ?
 ? "In the procedure", PROCNAME(), ":" 
 ? cExclusiveForPMain
 ? cPublicizedInMain 
 ? cPrivatizedInMain
 ? cUndeclaredInMain 

 SubProcL1()

 ?
 ? "In the procedure", PROCNAME(), "(after returned SubProcL1() ) :" 
 ? "If attempted accessing to 'cExclusiveForPSubProcL1' here, a run time error " + ;
 " occurs: Variable doesn't exist" 
 ? cPublicizedInMain 
 ? cPrivatizedInMain 
 ? cUndeclaredInMain 
 ? "If attempted accessing to 'cExclusiveForPSubProcL1' here, a run time error " +; 
 "occurs: Variable doesn't exist"
? cPublicizedInTheSub

RETURN // Main()
PROCEDURE SubProcL1() // Sub procedure Level : 1
LOCAL cExclusiveForPSubProcL1 := "The variable 'cExclusiveForPSubProcL1' is 'LOCAL' " + ;
 "in the SubProcL1() procedure;" + ; 
 " thus inaccessible outside of SubProcL1()"

 ?
 ? "In the procedure", PROCNAME(), ":" 
 ? "If attempted accessing to 'cExclusiveForPMain' here, a run time error " + ;
 "occurs: Variable doesn't exist"
? cPublicizedInMain 
 ? cPrivatizedInMain 
 ? cUndeclaredInMain 
 ? cExclusiveForPSubProcL1

 cPublicizedInMain := "New value assigned in the SubProcL1() to PUBLIC " + ;
 "variable 'cPublicizedInMain' "
cPrivatizedInMain := "New value assigned in the SubProcL1() to PRIVATE variable " +; 
 "'cPrivatizedInMain' "
cUndeclaredInMain := "New value assigned in the SubProcL1() to UNDECLARED PRIVATE " + ;
 " variable 'cUndeclaredInMain' "
cExclusiveForPSubProcL1 := "New value assigned in the SubProcL1() to LOCAL variable " + ;
 "'cExclusiveForPSubProcL1' " 

 ? cPublicizedInMain 
 ? cPrivatizedInMain 
 ? cUndeclaredInMain 
 ? cExclusiveForPSubProcL1

 PUBLIC cPublicizedInTheSub := "The variable 'cPublicizedInTheSub' declared as 'PUBLIC' "+ ;
 " in the SubProcL1() procedure;" + ; 
 " thus accessible outside of SubProcL1()" + ;
 " (of course AFTER it is builded)"
 ? cPublicizedInTheSub 

RETURN // SubProcL1()

Constants

Posted on by vivaclipper

/*

Constants are data units with fixed values; their value never change while program running.

Format of constants sligthly different depending their data type.

This example demonstrate defining and usage of basic constants.

*/

PROCEDURE Main()

   CLS

   SET DATE GERM

   // String constants are strings enclosed by quotation marks ( "",'',[] )
   ? "String :", "This is a string" 

   // Numeric constants are strings of digits, decimal point (.)
   // and sign mark (+/-)
   ? "Numeric :", -123.56  

   // Logical constants are T or F enclosed by "." 
   ? "Logical :", .T. 

   // String constant converted to date type by CTOD() function
   ? "Date :", CTOD( "23.04.2012" ) 

RETURN // Main()

DO CASE..ENDCASE

Posted on by vivaclipper

Control Structures – Decision making; DO CASE..ENDCASE

Do Case

/*

Control Structures - Decision making; DO CASE..ENDCASE

For more information refer here 

*/

PROCEDURE Main()
   CLS

   nKey := 0

   cDash := ''

   ? "Press a digit key ( Esc for exit ) : " 

   DO WHILE nKey # 27

      nKey := INKEY( 0 )

      IF nKey > 47 .AND. nKey < 58 

         ?? cDash

         DO CASE
            CASE nKey = 48
               ?? "zero"
            CASE nKey = 49
               ?? "one"
            CASE nKey = 50
               ?? "two"
            CASE nKey = 51
               ?? "three"
            CASE nKey = 52
               ?? "four"
            CASE nKey = 53
               ?? "five"
            CASE nKey = 54
               ?? "six"
            CASE nKey = 55
               ?? "seven"
            CASE nKey = 56
               ?? "eight"
            CASE nKey = 57
               ?? "nine"
         ENDCASE

         cDash := '-'

      ENDIF nKey > 47 .AND. nKey > 58 

   ENDDO

RETURN // Main()

IF..ENDIF

Posted on by vivaclipper

Control Structures – Decision making; IF..ENDIF

If Endif

/*

Control Structures - Decision making; IF..ENDIF

For more information refer here 

*/

PROCEDURE Main()
   CLS

   DO WHILE .T.
      ACCEPT "Enter first number : " TO cString1
      ACCEPT "Enter second Number : " TO cString2
      nNumber1 := VAL( cString1 )
      nNumber2 := VAL( cString2 ) 
      IF nNumber1 = 0 .AND. nNumber2 = 0
         EXIT
      ELSE 
         IF nNumber1 > nNumber2 
            ? nNumber1, "is greater than", nNumber2 
         ELSEIF nNumber1 < nNumber2 
            ? nNumber1, "is less than", nNumber2 
         ELSE
            ? nNumber1, "is equal to", nNumber2 
         ENDIF
         ?
      ENDIF
   ENDDO

RETURN // Main()

DO WHILE..ENDDO Loop

Posted on by vivaclipper

Control Structures – DO WHILE..ENDDO Loop

 

/*

Control Structures - DO WHILE..ENDDO Loop

 Second kind of looping structure is DO WHILE..ENDDO Loop. 

 When the repetion count is unknown, FOR...NEXT isn't appropriate for looping; 
 thus, DO WHILE..ENDDO Loop is used for primarily for such situations. 

 Famous 

 DO WHILE .NOT. EOF() 
    ... 
    SKIP 
    ... 
 ENDDO

 loop is probably most used kind of this loop structure. 

 This example is a simple digital watch that run until any key pressed.

 For more information refer here  
*/

PROCEDURE Main()
  CLS

  cTime := TIME()

  nKey := 0

  DO WHILE nKey = 0
    @ 0,70 SAY cTime
    DO WHILE cTime = TIME()
    ENDDO
    cTime := TIME()
    nKey := INKEY()
  ENDDO 

RETURN // Main()

FOR .. NEXT Loop

Posted on by vivaclipper

Control Structures – FOR .. NEXT Loop

 

Nested For..Next loop

/*

Control Structures – FOR .. NEXT Loop

Control structures are code fragments that allow

– execution repeatedly by any number of time or

– if / while a logical condition satisfying by a true value.

All control structures may be nested and always have a beginning  and ending statement.

The first kind of control structures are looping structures and first of them is  FOR..NEXT Loop.

For more information refer here

*/



PROCEDURE Main()


FOR nLines := 1 TO 10
      FOR nColumns := 1 TO 10
         ?? STR( nLines * nColumns, 4 )
      NEXT nColumns 
      ?
   NEXT nLines

   WAIT

RETURN // Main()

			

	
	



		
			


	

		
UDFs_02 : Calling by reference


		

		Posted on  by vivaclipper		

	


		

		
/*


UDFs_02 : Calling by reference


In the previous example “cCurrent” was an “argument” ( or actual parameter ), in caller side. In called (invoked / recevied ) side “cTime” is a parameter ( or “formal” parameter).


Though two variables has same value (at the beginning of called function), nothing changed in these definitions, though if two variables has the same name.


In the previous example, “cCurrent” passed by value by caller and “cTime” is a “local” variable as a (“formal”) parameter. So, after terminated the “AmPm” function, “cTime” too erased from memory and became inaccessible.


There is one another method: passing by reference. In this method, caller routine passes (sent) the argument by its reference, not value. In this case called routin uses this formal parameter by its reference, can change  its value and after termination of called routine, argument left alive for caller.


For passing an argument by reference only requirement is adding a “@” sign at the beginning of variable name: AmPm( @cCurrent ), instead of AmPm( cCurrent ).


In this case we haven’t need a return value by called routine, and so called routine haven’t being a FUNCTION.


For more information refer here:


*/


PROCEDURE Main()
cCurrent := "01:43" 

 AmPm( @cCurrent )

 ? cCurrent

 WAIT

RETURN // Main()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.
PROCEDURE AmPm( cTime )
IF VAL( cTime ) < 12
 cTime += " am"
 ELSEIF VAL( cTime ) = 12
 cTime += " pm"
 ELSE 
 cTime += STR( VAL( cTime ) - 12, 2 ) +;
 SUBSTR( cTime, 3 ) + " pm"
 ENDIF

RETURN // AmPm()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

			

	
	



		
			


	

		
UDFs_01 : Defining and calling


		

		Posted on  by vivaclipper		

	


		

		
/*


UDFs_01 : Defining and calling


Functions and Procedures ( sometimes referred as User Defined Function : UDF )

are basic building block of Harbour programs.


Functions and Procedures are similar, only diffrence is requirments of return value;

by definition, procedures return NIL and functions have a return value.


Practically no difference between two; functions and procedures both may or may not

return value and undefined return value is NIL.


This is a typical example of a user-defined function definition and calling it.


For more information refer here.


*/


PROCEDURE Main()

   cCurrent:= "01:43" 

   ? AmPm( cCurrent)

   WAIT

RETURN // Main()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

FUNCTION AmPm( cTime )

   IF VAL( cTime ) < 12
      cTime += " am"
   ELSEIF VAL( cTime ) = 12
      cTime += " pm"
   ELSE 
      cTime += STR( VAL( cTime ) - 12, 2 ) +;
               SUBSTR( cTime, 3 ) + " pm"
   ENDIF

RETURN cTime // AmPm()


*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.

			

	
	



		
			


	

		
Extended Field Types


		

		Posted on  by vivaclipper		

	


		

		
/*
 Harbour extended Field Types 

 Type Short
 Code Name Width (Bytes) Description
 ---- ------- ----------------- -------------------------------------------------------------------
 D Date 3, 4 or 8 Date
 M Memo 4 or 8 Memo
 + AutoInc 4 Auto increment
 = ModTime 8 Last modified date & time of this record
 ^ RowVers 8 Row version number; modification count of this record
 @ DayTime 8 Date & Time
 I Integer 1, 2, 3, 4 or 8 Signed Integer ( Width : )" },;
 T Time 4 or 8 Only time (if width is 4 ) or Date & Time (if width is 8 ) (?)
 V Variant 3, 4, 6 or more Variable type Field
 Y Currency 8 64 bit integer with implied 4 decimal
 B Double 8 Floating point / 64 bit binary
Program : ExFldTps.prg
 Author : Bicahi Esgici ( esgici <at> gmail.com )

 All rights reserved.

 2011.10.12

 A warn : While running, this program produce some .dbf and .txt file(s) and don't erase its upon close. 
 This is because you may want inspect its. 
 You may erase these files arbitrarily.

*/
PROCEDURE Main()
LOCAL aOperations := { { "Width", "Testing Field Widths" },;
 { "Numeric Limits", "Determining Numeric Limits" },;
 { "Integer Limits", "Determining Integer Limits" },;
 { "Set/Get", "Set & read back field values" },; 
 { "Conversion", "Convert and test signed to integer" }},; 
 a1Oper := {},;
 n1Oper := 1

 LOCAL aFldTypes := { { "D", "Date", "Date ( Width : 3, 4 or 8 )" } ,;
 { "M", "Memo", "Memo ( Width : 4 or 8 )" },;
 { "+", "AutoInc", "Auto increment ( Width : 4 )" },;
 { "=", "ModTime", "Last modified date & time of this record ( Width : 8 )" },;
 { "^", "RowVers", "Row version number; modification count of this record ( Width : 8 )" },;
 { "@", "DayTime", "Date & Time ( Width : 8 )" },;
 { "I", "Integer", "Signed Integer ( Width : 1, 2, 3, 4 or 8 )" },;
 { "T", "Time", "Only time (if width is 4 ) or Date & Time (if width is 8 )" },;
 { "V", "Variant", "Variable type (!) Field ( Width : 3, 4, 6 or more)" },;
 { "Y", "Currency", "Integer 64 bit with implied 4 decimal" },; 
 { "B", "Double", "Floating point / 64 bit binary ( Width : 8 )" } },; 
 a1Type := {},;
 n1Type := 1,; 
 n2Type := 1 

 LOCAL nMColumn := 0,; // Menu Column No
 nMRow := 0 // Menu Row No 

 SET WRAP ON
 SET MESSAGE TO 58 CENTER
 SET CENTURY ON
* In screen resolution 1440 * 900 SetMode( 60, 150 ) seem good. 
 * In this case value of SET MESSAGE TO will be 58 ( less 2 than nRow specified in SetMod() ).
SetMode( 60, 150 )

 WHILE n1Oper > 0

 CLS 

 nMSutn := 0

 FOR EACH a1Oper IN aOperations
 @ 0, nMSutn PROMPT a1Oper[ 1 ] MESSAGE a1Oper[ 2 ]
 nMSutn += LEN( a1Oper[ 1 ] ) + 1
 NEXT 

 MENU TO n1Oper

 SWITCH n1Oper 

 CASE 0
 EXIT

 CASE 1 // Testing Field Widths
 n1Type := 1
 WHILE n1Type > 0

 @ 1,0 CLEAR TO 24, 80
 nMRow := 2
 FOR EACH a1Type IN aFldTypes 
 @ nMRow++, 0 PROMPT a1Type[ 2 ] MESSAGE a1Type[ 3 ]
 NEXT a1Type

 MENU TO n1Type

 IF n1Type > 0
 @ 1,0 CLEAR TO 24, 80
 @ 1, 0 SAY aFldTypes[ n1Type, 2 ] COLOR "B/W"
 FT_Widths( aFldTypes[ n1Type ] ) 
 ENDIF

 ENDDO n1Type
 EXIT

 CASE 2 // Determining Numeric Limits
 NumLimits()
 EXIT

 CASE 3 // Determining Integer Limits
 IntLimits()
 EXIT 

 CASE 4 // Set & read back field values
 n2Type := 1
 WHILE n2Type > 0

 @ 1,0 CLEAR TO 24, 80
 nMRow := 2
 FOR EACH a1Type IN aFldTypes 
 @ nMRow++, 36 PROMPT a1Type[ 2 ] MESSAGE a1Type[ 3 ] 
 NEXT 

 MENU TO n2Type

 IF n2Type > 0
 V_SetGet( aFldTypes[ n2Type ] ) 
 ENDIF

 ENDDO n1Type
 EXIT

 CASE 5 // Convert and test signed to integer
 SignChng()
 EXIT

 END SWITCH 

 ENDDO n1Oper

RETURN // Main()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE FT_Widths( a1Type ) // Testing Field Widths
LOCAL cType := a1Type[ 1 ],;
 nFldNo := 0,;
 aStru1 := {},;
 aStru2 := {},;
 aStru3 := { { 'FldType', "C", 1, 0 },; // Type of field
 { 'WidtSpec', "N", 2, 0 },; // Specified width
 { 'Dec_Spec', "N", 2, 0 },; // Specified decimal
 { 'WidtAppl', "N", 2, 0 },; // Applied (by Harbour) width 
 { 'Dec_Max', "N", 2, 0 },; // Computed maximum dec
 { 'Result', "C", 1, 0 } }
FOR nFldNo := 1 TO 32
 AADD( aStru1, { "X" + STRZERO( nFldNo, 2 ), cType, nFldNo, 0 } )
 NEXT nFldNo
DBCREATE( "Widths", aStru1 )
 USE Widths

 aStru2 := DBSTRUCT()

 IF cType $ "IYB"
 AEVAL( aStru2, { | a1, i1 | aStru2[ i1, 4 ] := aStru2[ i1, 3 ] - 1 } )
 ENDIF

 USE
 DBCREATE( "Widths", aStru2 )
 USE Widths

 aStru2 := DBSTRUCT()
USE 

 DBCREATE( "Widths", aStru3 )

 USE Widths

 FOR nFldNo := 1 TO 32
 DBAPPEND()

 REPLACE FldType WITH aStru1[ nFldNo, 2 ],;
 WidtSpec WITH aStru1[ nFldNo, 3 ],;
 Dec_Spec WITH aStru1[ nFldNo, 4 ],;
 WidtAppl WITH aStru2[ nFldNo, 3 ],;
 Dec_Max WITH aStru2[ nFldNo, 4 ],;
 Result WITH IF( aStru1[ nFldNo, 3 ] # aStru2[ nFldNo, 3 ], "-", "+" )

 NEXT nFldNo

 DBGOTOP() 
 BROWSE()
USE

RETURN // FT_Widths()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE NumLimits() // Determining Numeric Limits
LOCAL mBayt := 0,;
 nBit := 0,;
 nExpo := 0

* nExpos := { 8, 16, 24, 32, 64 }

 SET ALTE TO N_Limits
 SET ALTE ON

 ? SPACE(9), "Unsigned ( Always + )"
 ? "-- ------ ---------------------------"
FOR nBayt := 1 TO 8
 nBit := nBayt * 8
 nExpo := 2^nBit
 ? STR( nBayt, 2 ), "2^" + PADL( nBit, 2) + " : ", TRANSFORM( nExpo, "99,999,999,999,999,999,999" )
 NEXT nBayt
?
 ? 
 ? PADC( "Signed ( - / + )", 80 )
 ? "-- ------ -----------------------------------------------------"
FOR nBayt := 1 TO 8
 nBit := nBayt * 8
 nExpo := 2^nBit
 ? STR( nBayt, 2 ), "2^" + PADL( nBit, 2) + " : ", TRANSFORM( - nExpo / 2, "99,999,999,999,999,999,999" )+;
 ".."+;
 LTRIM( TRANSFORM( nExpo / 2 - 1, "99,999,999,999,999,999,999" ) )
 NEXT nBayt 

 SET ALTE OFF
 SET ALTE TO
MEMOEDIT( MEMOREAD( "N_Limits.TXT" ) )

RETURN // NumLimits()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE IntLimits() // Determining Integer Limits
LOCAL nFldNo := 0,;
 aStru4 := { { 'MNMX', "C", 7, 0 },;
 { 'INT1', "I", 1, 0 },;
 { 'INT2', "I", 2, 0 },;
 { 'INT3', "I", 3, 0 },;
 { 'INT4', "I", 4, 0 },;
 { 'INT8', "I", 8, 0 } }

 DBCREATE( "IntLimits", aStru4 )

 USE IntLimits

 DBAPPEND()
 REPLACE MNMX WITH "Minimum" ,;
 INT1 WITH -2^7 ,;
 INT2 WITH -2^15 ,;
 INT3 WITH -2^23 ,;
 INT4 WITH -2^31 ,;
 INT8 WITH -2^63

 DBAPPEND()
 REPLACE MNMX WITH "Maximum" ,;
 INT1 WITH 2^7 - 1 ,;
 INT2 WITH 2^15 - 1 ,;
 INT3 WITH 2^23 - 1 ,;
 INT4 WITH 2^31 - 1 ,; 
 INT8 WITH 2^63 - 513 // < 513 ---> "Error DBFNTX/1021 Data width error" 

 DBGOTOP()

 @ 1,0 CLEAR TO 24, 80
SET ALTE TO IntLimits
 SET ALTE ON

 WHILE !EOF()
 ?
 ? MNMX 
 ? '--------'
 FOR nFldNo := 2 TO 6
 ? FIELDNAME( nFldNo ), ": ", LTRIM( TRANSFORM( FIELDGET( nFldNo ), "99,999,999,999,999,999,999" ) )
 NEXT nFldNo
 ?
 SKIP 
 ENDDO

 SET ALTE OFF
 SET ALTE TO
MEMOEDIT( MEMOREAD( "IntLimits.txt" ) )

 USE

RETURN // IntLimits()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_NoType() // Testing NoType ( Variant ) field type
LOCAL aStru5 := { { "Initial", "C", 19, 0 },;
 { "Internal", "V", 19, 0 },; 
 { "ReadBack", "C", 19, 0 },;
 { "ReadBackTp", "C", 1, 0 } }

 DBCREATE( "SG_NoType", aStru5 )

 USE SG_NoType

 DBAPPEND()
 REPLACE Initial WITH "String", Internal WITH "String"
 DBAPPEND()
 REPLACE Initial WITH "12345", Internal WITH 12345
 DBAPPEND()
 REPLACE Initial WITH DTOC( DATE() ), Internal WITH DATE()
 DBAPPEND()
 REPLACE Initial WITH ".T.", Internal WITH .T.

 REPLACE ALL ReadBack WITH HB_ValToStr( Internal ), ReadBackTp WITH VALTYPE( Internal )

 DBGOTOP()

 BROWSE()
 USE

RETURN // SG_NoType()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE V_SetGet( aType ) // Set & read back field values
LOCAL cType := aType[ 1 ]

 @ 1,0 CLEAR TO 24, 80

 SWITCH cType

 CASE "D" // Date 
 SG_Date()
 EXIT

 CASE "M" // Memo 
 SG_Memo()
 EXIT

 CASE "+" // AutoInc 
 Alert( "Read Only" )
 EXIT

 CASE "=" // ModTime 
 Alert( "Read Only" )
 EXIT

 CASE "^" // RowVers 
 Alert( "Read Only" )
 EXIT

 CASE "@" // DayTime 
 SG_DayTime()
 EXIT

 CASE "I" // Integer 
 SG_Integers()
 EXIT

 CASE "T" // Time 
 SG_DayTime()
 EXIT

 CASE "V" // Variant 
 SG_NoType()
 EXIT

 CASE "Y" // Currency 
 SG_Currency()
 EXIT

 CASE "B" // Double 
 SG_Double()
 EXIT

 END SWITCH 

RETURN // V_SetGet()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_Date() // Date : Compare set / get
LOCAL aStru6 := { { "Initial", "D", 8, 0 } ,;
 { "Internal3", "D", 3, 0 } ,; 
 { "Internal4", "D", 4, 0 } ,; 
 { "Internal8", "D", 8, 0 } ,; 
 { "ReadBack3", "C", 12, 0 } ,;
 { "ReadBack4", "C", 12, 0 } ,;
 { "ReadBack8", "C", 12, 0 } }

 DBCREATE( "SG_Date", aStru6 )

 USE SG_Date

 DBAPPEND()
 REPLACE Initial WITH DATE() - ( 66 * 365 + 66 / 4 ),; 
 Internal3 WITH Initial ,; 
 Internal4 WITH Initial ,; 
 Internal8 WITH Initial ,; 
 ReadBack3 WITH HB_ValToStr( Internal3 ) ,; 
 ReadBack4 WITH HB_ValToStr( Internal4 ) ,; 
 ReadBack8 WITH HB_ValToStr( Internal8 )
 DBGOTOP()

 BROWSE()
 USE
RETURN // SG_Date()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_Memo() // Set / Get test for MEMO fields
LOCAL aStru7 := { { "MEMO_4", "M", 4, 0 } ,;
 { "MEMO_10", "M", 10, 0 } }

 DBCREATE( "SG_Memo", aStru7 )

 USE SG_Memo

 DBAPPEND()
 REPLACE MEMO_4 WITH "MEMO field with width 4",; 
 MEMO_10 WITH "MEMO field with width 4"

 DBGOTOP()

 BROWSE()
 USE
RETURN // SG_Date()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_DayTime() // Set / Get test for DayTime fields
LOCAL aStru8 := { { "ModTim", "=", 8, 0 } ,;
 { "DaTime", "@", 8, 0 } ,; // 
 { "Time_8", "T", 8, 0 } ,;
 { "Time_4", "T", 4, 0 } ,;
 { "Time_C", "C", 12, 0 } }
DBCREATE( "SG_Datime", aStru8 )

 USE SG_Datime

 DBAPPEND()

* REPLACE DaTime WITH DATE() // ==> Error DBFNTX/1020 Data type error: DATIME 
* REPLACE Time_4 WITH SECO() / TIME() // ==> Error DBFNTX/1020 Data type error: DATIME
* REPLACE Time_8 WITH TIME() // ==> Error DBFNTX/1020 Data type error: TIME_8 

* DBAPPEND()

* REPLACE DaTime WITH ModTim // ==> 0000-00-00 00:00:00.000 
* REPLACE Time_4 WITH ModTim // ==> Error DBFNTX/1020 Data type error: TIME_4 
* REPLACE Time_8 WITH ModTim // ==> 0000-00-00 00:00:00.000 

 REPLACE DaTime WITH ModTim,; // ==> > 0000-00-00 00:00:00.000 
 Time_8 WITH ModTim,; // ==> > 0000-00-00 00:00:00.000 
 Time_C WITH TIME() 

 DBGOTOP()

 BROWSE()
 USE

RETURN // SG_DayTime()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_Integers() // Set / Get test for INTEGER fields
LOCAL nRecno := 0,;
 aStru9 := { { 'INT1', "I", 1, 0 },;
 { 'NUM1', "N", 4, 0 },;
 { 'EQL1', "L", 1, 0 },; 
 { 'INT11', "I", 1, 1 },;
 { 'NUM11', "N", 5, 1 },;
 { 'EQL11', "L", 1, 0 },; 
 { 'INT2', "I", 2, 0 },;
 { 'NUM2', "N", 8, 0 },;
 { 'EQL2', "L", 1, 0 },; 
 { 'INT22', "I", 8, 2 },;
 { 'NUM22', "N",12, 2 },;
 { 'EQL22', "L", 1, 0 },; 
 { 'INT3', "I", 3, 0 },;
 { 'NUM3', "N", 8, 0 },;
 { 'EQL3', "L", 1, 0 },; 
 { 'INT32', "I", 3, 2 },;
 { 'NUM32', "N",12, 2 },;
 { 'EQL32', "L", 1, 0 },; 
 { 'INT4', "I", 4, 0 },;
 { 'NUM4', "N",12, 0 },;
 { 'EQL4', "L", 1, 0 },; 
 { 'INT42', "I", 4, 2 },;
 { 'NUM42', "N",14, 2 },;
 { 'EQL42', "L", 1, 0 },; 
 { 'INT8', "I", 8, 0 },;
 { 'NUM8', "N",21, 0 },;
 { 'EQL8', "L", 1, 0 },; 
 { 'INT84', "I", 8, 4 },;
 { 'NUM84', "N",21, 4 },;
 { 'EQL84', "L", 1, 0 } } 

 DBCREATE( "SG_Integers", aStru9 )
 USE SG_Integers

 FOR nRecno := 1 TO 18
 DBAPPEND()
 NEXT nRecno

 REPL ALL INT1 WITH INT( HB_RANDOM( -2^7 , 2^7 - 1 )) ,;
 INT11 WITH INT( HB_RANDOM( -2^7 , 2^7 - 1 )) / 10 ,;
 INT2 WITH INT( HB_RANDOM( -2^15, 2^15 - 1 )) ,;
 INT22 WITH INT( HB_RANDOM( -2^15, 2^15 - 1 )) ,;
 INT3 WITH INT( HB_RANDOM( -2^23, 2^23 - 1 )) ,;
 INT32 WITH INT( HB_RANDOM( -2^23, 2^23 - 1 )) / 100 ,;
 INT4 WITH INT( HB_RANDOM( -2^31, 2^31 - 1 )) ,;
 INT42 WITH INT( HB_RANDOM( -2^31, 2^31 - 1 )) / 100 ,;
 INT8 WITH INT( HB_RANDOM( -2^63, 2^63 - 513 )) ,;
 INT84 WITH INT( HB_RANDOM( -2^63, 2^63 - 513 )) / 10000 

 REPL ALL NUM1 WITH INT1, EQL1 WITH NUM1 = INT1 ,; 
 NUM11 WITH INT11, EQL11 WITH NUM11 = INT11 ,;
 NUM2 WITH INT2, EQL2 WITH NUM2 = INT2 ,;
 NUM22 WITH INT22, EQL22 WITH NUM22 = INT22 ,;
 NUM3 WITH INT3, EQL3 WITH NUM3 = INT3 ,;
 NUM32 WITH INT32, EQL32 WITH NUM32 = INT32 ,;
 NUM4 WITH INT4, EQL4 WITH NUM4 = INT4 ,;
 NUM42 WITH INT42, EQL42 WITH NUM42 = INT42 ,;
 NUM8 WITH INT8, EQL8 WITH NUM8 = INT8 ,;
 NUM84 WITH INT84, EQL84 WITH NUM84 = INT84
DBGOTOP()

 BROWSE() 
 USE

RETURN // SG_Integers()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._

PROCEDURE SG_Currency() // Set / Get test for CURRENCY fields
LOCAL aStru10 := { { "Currenc", "Y", 8, 4 } ,;
 { "NUM2D", "N", 21, 2 } ,;
 { "NUM4D", "N", 21, 4 } ,;
 { "NUM6D", "N", 23, 6 } ,;
 { "NUM8D", "N", 25, 8 } }
DBCREATE( "SG_Curncy", aStru10 )

 USE SG_Curncy

 FOR nRecno := 1 TO 100
 DBAPPEND()
 REPLACE Currenc WITH HB_RANDOM( -2^53, 2^53 ) / 10000 ,; 
 NUM2D WITH Currenc ,;
 NUM4D WITH Currenc ,;
 NUM6D WITH Currenc ,;
 NUM8D WITH Currenc 

 NEXT nRecno

 DBGOTOP() 
 BROWSE() 
 USE
RETURN // SG_Currency()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SG_Double() // Set / Get test for DOUBLE ( BINARY ) fields
LOCAL nRecno := 0

 LOCAL aStru11 := { { "Double", "B", 8, 4 } ,;
 { "NUM2D", "N", 21, 2 } ,;
 { "NUM4D", "N", 21, 4 } ,;
 { "NUM6D", "N", 23, 6 } ,;
 { "NUM8D", "N", 25, 8 } }
DBCREATE( "SG_Double", aStru11 )

 USE SG_Double

 FOR nRecno := 1 TO 100
 DBAPPEND()
 REPLACE Double WITH HB_RANDOM( -2^53, 2^53 ) / 10000 ,; 
 NUM2D WITH Double ,;
 NUM4D WITH Double ,;
 NUM6D WITH Double ,;
 NUM8D WITH Double 

 NEXT nRecno

 DBGOTOP() 
 BROWSE() 
 USE
RETURN // SG_Double()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
PROCEDURE SignChng() // Convert and test signed to integer
LOCAL nRecno := 0
LOCAL aStru12 := { { 'NUM1', "N", 3, 0 },;
 { 'INT1', "I", 1, 0 },;
 { 'RET1', "N", 3, 0 },;
 { 'EQL1', "L", 1, 0 },;
 { 'NUM2', "N", 6, 0 },;
 { 'INT2', "I", 2, 0 },;
 { 'RET2', "N", 6, 0 },;
 { 'EQL2', "L", 1, 0 },;
 { 'NUM3', "N", 9, 0 },;
 { 'INT3', "I", 3, 0 },;
 { 'RET3', "N", 9, 0 },;
 { 'EQL3', "L", 1, 0 },;
 { 'NUM4', "N", 11, 0 },;
 { 'INT4', "I", 4, 0 },;
 { 'RET4', "N", 11, 0 },;
 { 'EQL4', "L", 1, 0 },;
 { 'NUM8', "N", 21, 0 },;
 { 'INT8', "I", 8, 0 },;
 { 'RET8', "N", 21, 0 },;
 { 'EQL8', "L", 1, 0 } }

 DBCREATE( "SignChng", aStru12 )
 USE SignChng

 FOR nRecno := 1 TO 100

 DBAPPEND()

 REPLACE NUM1 WITH HB_RANDOM( 0, 2^8 - 1 ), INT1 WITH NUM1 - 2^7 , RET1 WITH INT1 + 2^7, EQL1 WITH NUM1 = RET1 ,;
 NUM2 WITH HB_RANDOM( 0, 2^16 - 1 ), INT2 WITH NUM2 - 2^15, RET2 WITH INT2 + 2^15, EQL2 WITH NUM2 = RET2 ,;
 NUM3 WITH HB_RANDOM( 0, 2^24 - 1 ), INT3 WITH NUM3 - 2^23, RET3 WITH INT3 + 2^23, EQL3 WITH NUM3 = RET3 ,;
 NUM4 WITH HB_RANDOM( 0, 2^32 - 1 ), INT4 WITH NUM4 - 2^31, RET4 WITH INT4 + 2^31, EQL4 WITH NUM4 = RET4 ,;
 NUM8 WITH HB_RANDOM( 0, 2^64 - 1 ), INT8 WITH NUM8 - 2^63, RET8 WITH INT8 + 2^63, EQL8 WITH NUM8 = RET8 

 NEXT nRecno

 DBGOTOP() 
 BROWSE() 
 USE

RETURN // SignChng()
*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._






Download Source File