i Search same harbour sample

General Help regarding HMG, Compilation, Linking, Samples

Moderator: Rathinagiri

mbelgrano
Posts: 59
Joined: Sun Aug 03, 2008 8:47 pm

i Search same harbour sample

Post by mbelgrano »

I am searching a sample for my blog on harbour language
http://harbourlanguage.blogspot.com/
I invite everybody post here sample without gui
mrduck
Posts: 497
Joined: Fri Sep 10, 2010 5:22 pm

Re: i Search same harbour sample

Post by mrduck »

Your blog crashes my firefox...
mbelgrano wrote:I am searching a sample for my blog on harbour language
http://harbourlanguage.blogspot.com/
I invite everybody post here sample without gui
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: i Search same harbour sample

Post by Rathinagiri »

Yes, some script is crashing firefox.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: i Search same harbour sample

Post by esgici »

Hi Massimo

Nice blog, thanks to your efforts dedicated to Harbour ( and special thank for your notice about my humble web page ) :)

"Multiple themes" is a nice feature. My favorite is "Sidebar" and I have a little suggestion: because your blog will expand quickly, your sidebar too will be a list long drawn out. Instead of a simple list, ( if possible ) a tree structure may be more convenient. Such as:
  • ...

    Understanding
    • Harbour Class
      Harbour hbxhb
      Harbour MultiThread
      Harbour GT
      ...
    How to
    • Use hbmk2?
      Create harbour documentation?
      Use [x]harbour reference guide with hbide
      Use Hbide doc
      ...
    ...
Regarding your request: me too, I want accompanying to you with a little and humble work.

I'm not sure this is useful and is worth to interest of you and community.

If you have some ideas as sample please inform me; I will be happy if anything I can make for Harbour people.

Here my sample :

Code: Select all

/*
  Understanding 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
  
           
*/

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 22 CENTER
   SET CENTURY ON

   SetMode( 25, 80 )                     // Win-7 ???
      
   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()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._
For build by directly Harbour :

Code: Select all

SET PATH=<...>\HARBOUR\bin;<...>\MINGW\bin;%PATH%
hbmk2 ExFldTps 
IF ERRORLEVEL 1 GOTO ERROR
ExFldTps
GOTO END
:ERROR
PAUSE
:END
( Please fill fields marked as <...> with your actual path infos )

For build via hmg :

Code: Select all

call c:\hmg\build.bat /c ExFldTps
( If your hmg path is different, please correct this path)

Regards

--

Esgici
Viva INTERNATIONAL HMG :D
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: i Search same harbour sample

Post by Rathinagiri »

Quite impressive Esgici.

AutoInc, ModifiedTime, RowVersion I have studied a lot.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: i Search same harbour sample

Post by esgici »

Thanks Rathi

BTW some additions to my post:

Building via HMG-IDE :

AFAIK for now HMG-IDE don't support building "console only" projects.

Some screen shoots:
Menu bar and first sub menu
Menu bar and first sub menu
ExtFldTsSS01.JPG (33.66 KiB) Viewed 5956 times
Numeric limits
Numeric limits
ExtFldTsSS02.JPG (55.02 KiB) Viewed 5956 times
Integers and their limits
Integers and their limits
ExtFldTsSS03.JPG (34.86 KiB) Viewed 5956 times
And a short warn : While running, this program produce some .dbf and .txt file(s) and don't erase its upon close. You may erase or inspect these files arbitrarily.

Regards

--

Esgici
Viva INTERNATIONAL HMG :D
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: i Search same harbour sample

Post by esgici »

rathinagiri wrote:AutoInc, ModifiedTime, RowVersion I have studied a lot.
Yes Rathi

IMHO, these new field types may be useful while importing and exporting .dbf tables to and from modern db servers ;)

Best regards

--

Esgici
Viva INTERNATIONAL HMG :D
User avatar
danielmaximiliano
Posts: 2611
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Contact:

Re: i Search same harbour sample

Post by danielmaximiliano »

esgici wrote: SetMode( 25, 80 ) // Win-7 ???
works also in non-standard modes as setmode (30,100)
Windows 7 home premium 64, Hp4530s I3, HMG3.0.39

but has an error, I made a video to show http://www.youtube.com/watch?v=hN9Ws80o7uo

Esgici very good job. and thanks for sharing


Code: Select all

@echo off
@echo  
SET HMGPATH=C:\HMG.3.0.39\
if "%1"=="" goto Input
call %HMGPATH%build.bat  %*
goto Finish

:Input
SET Filename=
SET Parameter=
@cls
@echo ********************************************************************************
@echo   Este Batch pasa informacion a hbmk2 para un compilacion facil y limpia 
@echo   se distribuye como esta y no garantiza que este libre de errores
@echo   si encuentra un error puede escribirme a danielmaximiliano@yahoo.com.ar
@echo   Basado un Build.bat distribuido en el Proyecto HMG de Roberto Lopez
@echo ******************************************************************************
@echo.
@echo Entre solo el nombre del proyecto a compilar, asume la extension .HBP si este existe
@echo en la carpeta del proyecto, sino compila la extension .PRG
@echo. 
@echo "<Enter>" sale del Batch
@echo. 
@Set /p Filename=                        Nombre de la Aplicacion :
@echo.
if {%Filename%}=={} goto :Finish
@if EXIST %Filename%.hbp SET Extension=.HBP
@if EXIST %Filename%.prg SET Extension=.PRG
@echo *******************************************************************************
@echo  Parametros Extras para compilar %Filename%%extension%
@echo. 
@echo                           /n	No EJECUTAR desdepues de compilar
@echo                           /d	Habilita DEBUG
@echo                           /c	Modo CONSOLA DOS
@echo. 
@echo Nota: " Con un <Enter> ningun parametro es pasado "
@echo *******************************************************************************
@echo.
@Set /p Parameter=                      Parametros :
@echo.
If "%Parameter%"=="" goto Continue
@echo compilando con parametros
@if EXIST %Filename%.hbp Goto HBPParameters 
@if EXIST %Filename%.prg Goto PRGParameters
@echo 
@echo No se encuentra Fuentes para compilar !!!!
@echo presione una tecla e intente de nuevo entrar el nombre.....
@Pause >nul
goto Input



:HBPParameters
@Echo Compilando %Filename%.hbp %Parameter%
call %HMGPATH%build.bat %Parameter% %filename%.hbp 
goto Input

:PRGParameters
@Echo Compilando %Filename%.PRG %Parameter%
call %HMGPATH%build.bat %Parameter% %%filename%.prg
@Pause
goto Input


:Continue
@echo no parameters compilation
@if EXIST %Filename%.hbp Goto HBP 
@if EXIST %Filename%.prg Goto PRG
@echo.
@echo 
@echo No se encuentra Fuentes para compilar !!!!
@echo presione una tecla e intente de nuevo entrar el nombre.....
@pause > nul
@goto Input

:HBP
@Echo Compile %Filename%.hbp
call %HMGPATH%build.bat %filename%.hbp 
goto Input

:PRG
@Echo Compile %Filename%.prg
call %HMGPATH%build.bat %filename%.prg
goto Input


:Finish
@exit

Mibuild2.bat is based on build.bat
if you double click on it asked to enter the name of the application to compile
compile the extension .HBP exists by that name if entered, but compiles the extension .PRG if it exists in the current folder

might want to run from the command line, if I enter the name of the application with the required parameters are passed to the same original build.bat.
Mibuild.bat not work
Example: Main.Prg
you income: main
or: Main

Code: Select all

@if EXIST %Filename%.hbp SET Extension=.HBP
@if EXIST %Filename%.prg SET Extension=.PRG
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: i Search same harbour sample

Post by esgici »

Hola Daniel

Thanks to kind words, bug report, SetMode() info and .bat script.
danielmaximiliano wrote: works also in non-standard modes as setmode (30,100)
In my current 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() ).
danielmaximiliano wrote: but has an error, ...
In my machine no such error :)

I can't read error message in your video; could you send me image of only error screen ?
danielmaximiliano wrote:Mibuild2.bat is based on build.bat
Your .bat file too is useful and informative, thanks.

To All

An additional point about ExFldTps.prg : Every time and everywhere Escape key is Exit key.

Saludos / Regards

--

Esgici
Viva INTERNATIONAL HMG :D
User avatar
danielmaximiliano
Posts: 2611
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Contact:

Re: i Search same harbour sample

Post by danielmaximiliano »

esgici wrote: An additional point about ExFldTps.prg : Every time and everywhere Escape key is Exit key.
Hi Esgici

Windows installation is new, as well HMG3 buy the machine for days.
Today just finished updating windows update.

is a bad habit to close applications.
Attachments
Program Error_2011-10-12_19-30-01.png
Program Error_2011-10-12_19-30-01.png (16.64 KiB) Viewed 5910 times
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
Post Reply