Ejemplo RMChart desde DLL

2015-10-23_202626

Descarga Ejemplo Aquí

/*
 * RMChart DLL Demo by (c)2015 MigSoft 
 */

#include "oohg.ch"

#define ID_CHART   1001
#define ID_CHART_2 1002

#define RMC_DEFAULT   O
#define RMC_PORTRAIT  1
#define RMC_LANDSCAPE 2

#define RMC_EMF       1
#define RMC_EMFPLUS   2
#define RMC_BMP       3


Function Main()

  DEFINE WINDOW Win_1 ;
    AT 0,0 ;
    WIDTH 800 ;
    HEIGHT 600 ;
    TITLE 'Test RMChart By (c)2015 MigSoft' ;  
    ON INIT Chart( MyFillData(1) ) ;
    MAIN 
  
    DEFINE MAIN MENU
      DEFINE POPUP 'Test'
        MENUITEM 'Chart 1 View'  ACTION Chart( MyFillData(1) )
        MENUITEM 'Chart 1 Print' ACTION PrintChart( MyFillData(1) ) 
        SEPARATOR
        MENUITEM 'Chart 2 View'  ACTION Chart( MyFillData(2) )
        MENUITEM 'Chart 2 Print' ACTION PrintChart( MyFillData(2) )
        SEPARATOR
        MENUITEM 'Chart 3 View'  ACTION Chart( MyFillData(3) )
        MENUITEM 'Chart 3 Print' ACTION PrintChart( MyFillData(3) )
      END POPUP
    END MENU

  END WINDOW
  
  CENTER WINDOW Win_1
  ACTIVATE WINDOW Win_1

Return

*-----------------------------------------------------------------------------*
Procedure Chart( cData )
*-----------------------------------------------------------------------------*

        CallDll32 ( "RMC_CREATECHARTFROMFILE" , "RMCHART.DLL" , GetFormHandle("Win_1"), ;
                    ID_CHART, 10, 10, 0, cData  )        
        CallDll32 ( "RMC_DRAW" , "RMCHART.DLL" , ID_CHART  )        

Return

*-----------------------------------------------------------------------------*
Procedure PrintChart( cData )
*-----------------------------------------------------------------------------*

    CallDll32 ( "RMC_CREATECHARTFROMFILE" , "RMCHART.DLL" , GetFormHandle("Win_1"), ;
                 ID_CHART_2, 10, 10, 1, cData  )        

    IF CallDll32 ( "RMC_DRAW2PRINTER" , "RMCHART.DLL" , ID_CHART_2, RMC_LANDSCAPE, ;
                   10, 10, 250, 150, RMC_EMFPLUS  )  < 0
       MsgStop("Print error!", "Error")   
       
    ENDIF

    CallDll32 ( "RMC_DELETECHART" , "RMCHART.DLL" , ID_CHART_2  )        

Return


Function MyFillData( nOp )
    Local sData := "" 

  If nOp == 3
    sData += "00003650|00004450|000051|000061|000071|00008-6697831|00009401|00011Tahoma|100011"
    sData += "|1000310|1000410|10005-5|10006-5|1000910|100101|100111|100121|100131|100181|1002"
    sData += "00|100217|1002215|100238|100272|100331|100341|100358|100378|100411|100482|100492"
    sData += "|10051-6751336|10052-15132304|10053-983041|100541|100558|10056-16777077|10057-16"
    sData += "777077|100586|10060-16777077|10061-1468806|100622|10180data source: www.federalr"
    sData += "eserve.gov + www.ecb.int|10181Prime Rates in USA and Euroland|10183 %|101871999*"
    sData += "2000*2001*2002*2003*2004*2005*2006|110011|1100221|110035|1100434|110052|110063|1"
    sData += "10073|1100970|1101312|110171|11019-16744448|1102115|110221|1102396|110262|110521"
    sData += "2|110534.75*4.75*4.75*4.75*4.75*5*5*5.25*5.25*5.25*5.5*5.5*5.5*5.75*6*6*6.5*6.5*"
    sData += "6.5*6.5*6.5*6.5*6.5*6.5*5.5*5.5*5*4.5*4*3.75*3.75*3.5*3*2.5*2*1.75*1.75*1.75*1.7"
    sData += "5*1.75*1.75*1.75*1.75*1.75*1.75*1.75*1.25*1.25*1.25*1.25*1.25*1.25*1.25*1*1*1*1*"
    sData += "1*1*1*1*1*1*1*1*1*1*1.25*1.5*1.75*2*2.25*2.25*2.5*2.75*2.75*3*3.25*3.25*3.5*3.75"
    sData += "*3.75*4*4.25*4.5*4.5*4.75*4.75*5*5.25*5.25*5.25*5.25*5.25*5.25*5.25|120011|12002"
    sData += "21|120035|1200434|120052|120063|120073|1200950|1201312|120171|12019-2448096|1202"
    sData += "115|120221|1202396|120262|1205212|120533*3*3*2.5*2.5*2.5*2.5*2.5*2.5*2.5*3*3*3*3"
    sData += ".25*3.5*3.75*3.75*4.25*4.25*4.5*4.5*4.75*4.75*4.75*4.75*4.75*4.75*4.75*4.5*4.5*4"
    sData += ".5*4.25*3.75*3.75*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3.25*3."
    sData += "25*2.75*2.75*2.75*2.5*2.5*2.5*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*"
    sData += "2*2*2*2*2*2.25*2.25*2.25*2.5*2.5*2.5*2.75*2.75*3*3*3.25*3.25*3.5|010011|010054|0"
    sData += "100721|01014-16744448|010222|01024216*287|01025109*109|010272|010283|010012|0100"
    sData += "51|01010295|01011102|010191|01026USA (Federal Funds Rate)|010013|010054|0100721|"
    sData += "01014-10496|010222|01024260*287|01025192*192|010272|010283|010014|010051|0101029"
    sData += "5|01011185|010191|01026Euroland (Prime Rate)" 
  Endif
  
  If nOp == 2   
    sData := "00003670|00004450|000051|000061|000071|00008-10185235|00009310|00011Tahoma|10001" + ;
             "1|100035|1000410|10005-5|10006-5|1000912|100101|100111|100131|100181|10020100000" + ;
             "|10021250000|1002211|100239|100281|100292|100300|100310|100322|100331|100341|100" + ;
             "3510|100378|100482|100492|10051-32944|10052-1296|10053-983041|100541|100558|1005" + ;
             "6-1828|10057-16777216|100592|10060-1828|10061-16777216|10180data source: F.A.Z|1" + ;
             "0181The world's 10 biggest industrial companies 2003|10183$ |10184Total turnover" + ;
             " in Mill. Dollar|10185 %|10186Net operating margin|10187Exxon Mobil*Royal Dutch " + ;
             "/ Shell*BP*General Motors*Daimler Chrysler*Ford Motor*Toyota Motor*General Elect" + ;
             "ric*TOTAL*Chevron Texaco|110011|110021|110031|110043|110053|11006-1|1100950|1101" + ;
             "31|11014-1|110171|11019-10496|1102111|110221|1102310|11053242365*235598*232571*1" + ;
             "85524*170457*164196*149321*132797*130067*119703|120011|1200221|120035|1200422|12" + ;
             "0052|120061|120071|1200970|120111|120121|120131|1201421|120171|12019-16744448|12" + ;
             "02115|120221|1202310|120261|120538.9*4.1*4.4*2.1*.3*.3*5.9*11.3*6.7*6"
  Endif
  
  If nOp == 1   
    sData := "00003700|00004500|000054|000061|000071|00008-984833|00009310|00011Tahoma|100011|" + ;
             "100032|100042|10005348|10006248|1000910|100101|100111|100181|100200|10021100|100" + ;
             "2211|100238|100331|100341|100355|100378|100481|100491|10051-984833|10052-1677721" + ;
             "6|10053-657956|100541|100558|10056-16777216|10057-16777216|10060-16777216|10061-" + ;
             "16777216|10187Label 1*Label 2*Label 3*Label 4*Label 5|110011|110021|110031|11004" + ;
             "6|110056|11006-1|110091|110131|11014-1|110171|1102111|110221|110235|1105330*40*7" + ;
             "0*60*20|200011|20003352|200042|20005-2|20006248|2000910|200101|200111|200181|200" + ;
             "200|20021100|2002211|200238|200331|200341|200355|200378|200484|200491|20051-9848" + ;
             "33|20052-16777216|20053-657956|200544|200555|20056-16777216|20057-16777216|20060" + ;
             "-16777216|20061-16777216|20187Label 1*Label 2*Label 3*Label 4*Label 5|210011|210" + ;
             "023|210033|210045|210055|21006-1|210091|210101|210131|21014-1|210171|2102111|210" + ;
             "221|210235|2105320*10*15*25*30|220011|220023|220033|220045|220055|22006-1|220091" + ;
             "|220101|220131|22014-1|220171|2202111|220221|220235|2205325*30*10*20*15|230011|2" + ;
             "30023|230033|230045|230055|23006-1|230091|230101|230131|23014-1|230171|2302111|2" + ;
             "30221|230235|2305310*20*40*20*30|240011|240023|240033|240045|240055|24006-1|2400" + ;
             "91|240101|240131|24014-1|240171|2402111|240221|240235|2405340*30*20*30*20|300011" + ;
             "|300032|30004252|30005348|30006-2|3000910|300101|300181|300481|300491|30051-9848" + ;
             "33|30052-16777216|30053-657956|310011|3100251|310031|3100454|310054|310071|31009" + ;
             "1|310121|310151|310161|310171|310182|310211|310221|310235|3105330*50*20*40*60|40" + ;
             "0011|40003352|40004252|40005-2|40006-2|4000910|400101|400111|400131|400181|40020" + ;
             "100|40021250|4002211|400238|400281|400292|400300|400310|400322|400331|400341|400" + ;
             "3510|400378|400482|400492|40051-984833|40052-16777216|40053-984833|400541|400558" + ;
             "|40056-16776961|40057-16777216|400592|40060-16777216|40061-16777216|40183$ |4018" + ;
             "5 %|410011|410021|410031|410043|410053|41006-1|4100950|410131|41014-1|410171|410" + ;
             "19-10496|4102111|410221|4102310|41053240*230*220*180*170*160*145*130*125*115|420" + ;
             "011|4200221|420035|4200422|420052|420061|420071|4200963|420111|420121|420131|420" + ;
             "171|42019-16744448|4202115|420221|4202310|420261|420538.1*6.2*4.3*2.2*1.2*3.1*5." + ;
             "2*11.4*7.3*4.2"
  Endif
    
Return(sData)

Ejemplo [blowfish.prg] – Encriptar mensaje

2015-09-03_131543

 

PROCEDURE Main()

   LOCAL cText := "This is my secret message."
   LOCAL cKey := hb_blowfishKey( "Top Secret ;-)" )

   LOCAL cEncrypted

   ? "Original:", hb_StrToExp( cText )

   /* encrypt data */
   ? "Encrypted:", hb_StrToHex( cEncrypted := hb_blowfishEncrypt( cKey, cText ) )

   /* decrypt data */
   ? "Decrypted:", hb_StrToExp( hb_blowfishDecrypt( cKey, cEncrypted ) )

   RETURN

Ejemplo [array16.prg] – Array multidimensional

2015-09-02_120742

 

// Harbour multidimensional arrays support

PROCEDURE Main()

   LOCAL a := { 100, 200, "Third" }
   LOCAL b := Array( 8832 )

   ? ValType( a )
   ? ValType( { "A" } )

   AAdd( a, "new element" )
   ? Len( a )

   ? a[ 1 ]
   ? a[ 2 ]
   ? a[ 3 ]
   ? a[ 4 ]

   ? ATail( a )

   a[ 3 ] := { "this", { "seems", "to", { "work", "so", "well" } } }
   ? a[ 3 ][ 2 ][ 3 ][ 1 ] // "work"

   a[ 3, 2 ][ 3, 1 ] := "Harbour power!"  // different ways to specify the indexes
   ? a[ 3, 2, 3, 1 ]

   ? ValType( b )
   ? Len( b )

   b[ 8832 ] := "Harbour"

   ? b[ 8832 ]

   ? ATail( b )

   ASize( b, 200 )
   ? Len( b )

   b[ 100 ] := 10
   Test( b[ 100 ]++ )
   ? b[ 100 ]

   b[ 100 ] := 10
   Test( ++b[ 100 ] )
   ? b[ 100 ]

   b := { 1, { 2, { 4, 5 } } }
   Test( b[ 2 ][ 2 ][ 1 ]++ )
   ? b[ 2 ][ 2 ][ 1 ]

   b[ 2 ][ 2 ][ 1 ] := 2
   Test( ++b[ 2 ][ 2 ][ 1 ] )
   ? b[ 2 ][ 2 ][ 1 ]

   ReleaseTest()

   RETURN

STATIC PROCEDURE Test( n )

   ? n

   RETURN

STATIC PROCEDURE ReleaseTest()

   LOCAL a := { 1, 2, 3 }

   HB_SYMBOL_UNUSED( a )

   RETURN

Ejemplo [ains.prg] – Funciones para Arrays

2015-09-02_115458

 

//
// Array test AIns() / ADel() / ASize() / AFill()
//

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

PROCEDURE Main()

   LOCAL aFirst
   LOCAL aSecond
   LOCAL aMore

   aFirst := AClone( { 1, 2, 4 } )
   AIns( aFirst, 3 )
   aFirst[ 3 ] := "3"
   ?? "Testing AIns() ... "
   ADump( aFirst )

   aSecond := { 1, 2, 4 }
   ASize( aSecond, 4 )
   ?? "Testing ASize() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 4 }
   ASize( aSecond, 4 )
   AIns( aSecond, 3 )
   aSecond[ 3 ] := "3"
   ?? "Testing ASize() + AIns() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 3, 3, 4, 5 }
   ADel( aSecond, 3 )
   ?? "Testing ADel() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 3, 3, 4, 5 }
   ADel( aSecond, 3 )
   ASize( aSecond, Len( aSecond ) - 1 )
   ?? "Testing ASize() + ADel() ... "
   ADump( aSecond )

   AFill( aSecond, "!" )
   ?? "Testing AFill() ... "
   ADump( aSecond )

   aMore := { 1, 2, 3, 4, 5, 6 }
   AFill( aMore, "X", 3 )
   ?? "Testing AFill() with start ... "
   ADump( aMore )

   aMore := { 1, 2, 3, 4, 5, 6 }
   AFill( aMore, "X", 3, 2 )
   ?? "Testing AFill() with start and count ... "
   ADump( aMore )

   aMore := { { 1, 2 }, { 3, 4 } }
   ADel( aMore, 1 )
   ADump( aMore )

   RETURN

STATIC PROCEDURE ADump( aShow )

   LOCAL n

   ?? "Len=", hb_ntos( Len( aShow ) )
   ?? ": "
   FOR n := 1 TO Len( aShow )

      ?? "["
      ?? hb_ntos( n )
      ?? "]= "
      ?? ValType( aShow[ n ] )
      ?? ":"
      IF HB_ISARRAY( aShow[ n ] ) /* Iterate array */
         ?
         ?? "["
         ADump( aShow[ n ] )
         ?? "]"
      ELSE
         ?? iif( HB_ISNUMERIC( aShow[ n ] ), hb_ntos( aShow[ n ] ), aShow[ n ] )
      ENDIF

      IF n != Len( aShow )
         ?? ", "
      ENDIF

   NEXT
   ?

   RETURN

Ejemplo [achoice3.prg] – Selección

2015-09-01_112826

 

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

#include "achoice.ch"
#include "inkey.ch"

/* TOFIX: Code below demonstrates an AChoice() difference between Harbour
          and Clipper it is called with the number of items in the array is
          less than number of rows determined by ( nBottom - nTop + 1 ),
          and a user function is specified for cUserFunction. In the attached
          example, a box is drawn around the area used by AChoice() to make
          it easier to see the difference in action. When cUserFunction is
          not specified, the bottom line of the box is not overwritten.
          In Clipper, the bottom line of the box is not overwritten, but
          in Harbour it is. */

MEMVAR m_aItems

PROCEDURE Main()

   LOCAL nResult

   PRIVATE m_aItems := { ;
      "Apple", ;
      "Blueberry", ;
      "Cashew", ;
      "Grape", ;
      "Hazelnut", ;
      "Jackfruit", ;
      "Kumquat", ;
      "Mulberry" }

   CLS
   @ 7, 25 TO 8 + Len( m_aItems ), 57
   IF ( nResult := AChoice( 8, 26, 8 + Len( m_aItems ), 55, m_aItems,, "HotChoice" ) ) > 0
      Alert( m_aItems[ nResult ] + " selected" )
   ENDIF

   RETURN

FUNCTION HotChoice( nStatus )  /* must be a public function */

   LOCAL nKey, cKey

   DO CASE
   CASE nStatus == AC_EXCEPT
      nKey := LastKey()
      cKey := Upper( hb_keyChar( nKey ) )
      DO CASE
      CASE AScan( m_aItems, {| c | Left( c, 1 ) == cKey } ) > 0
         hb_keyPut( K_ENTER )
         RETURN AC_GOTO
      CASE nKey == K_ENTER
         RETURN AC_SELECT
      CASE nKey == K_ESC
         RETURN AC_ABORT
      OTHERWISE
         ?? Chr( 7 )
      ENDCASE
   CASE nStatus == AC_NOITEM
      RETURN AC_ABORT
   ENDCASE

   RETURN AC_CONT

 

Ejemplo [achoice.prg] – Selección

 

2015-09-01_110829

 

// Released to Public Domain.

#include "achoice.ch"
#include "inkey.ch"

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

PROCEDURE Main()

   LOCAL aPrompts := { ;
      "AGRI-PLANTS"                   , ;
      "ALAN R. SMITH GREENHOUSES"     , ;
      "ALLAN MURRAY NURSERY, INC."    , ;
      "APOPKA FOREST"                 , ;
      "LIGHT HOUSE NURSERIES"         , ;
      "BAUCOM'S"                      , ;
      "BAY HILL NURSERY, INC."        , ;
      "BAYWOOD NURSERIES"             , ;
      "BIG OAK NURSERY"               , ;
      "C & N NURSERY"                 , ;
      "CHARLES QUALITY PLANTS"        , ;
      "CONNELL FARMS"                 , ;
      "DEWAR NURSERIES, INC."         , ;
      "DIAMOND T NURSERY"             , ;
      "DISTINCTIVE PALMS NURSERIES"   , ;
      "DONKAY NURSERY"                , ;
      "DOUG INGRAM & SONS NURSERY"    , ;
      "DRIFTWOOD GARDENS, INC."       , ;
      "ELVA PLANT NURSERY, INC."      , ;
      "ERINON"                        , ;
      "EVANS NURSERY"                 , ;
      "FANCY PLANTS"                  , ;
      "FL.PLANT GROWERSCOOP"          , ;
      "FLORIDA CACTUS INC."           , ;
      "FLOWERING TREE GROWERS, INC."  , ;
      "FLOWERWOOD NURSERY"            , ;
      "FOLIAGE FACTORY TOO"           , ;
      "GATOR GROWERS NURSERY, INC."   , ;
      "GAZEBO LANDSCAPE DESIGN, INC." , ;
      "GEM ORNAMENTALS"               , ;
      "GRANNY'S GARDEN"               , ;
      "GRAY'S ORNAMENTALS"            , ;
      "GREEN MASTERS INC."            , ;
      "GREEN MEADOW NURSERY"          , ;
      "PIXLEY'S PLANT PLACE"          , ;
      "HARRISON'S NURSERY, INC."      , ;
      "G & G FOLIAGE"                 , ;
      "IVEY'S NURSERY, INC."          , ;
      "JB NURSERIES, INC."            , ;
      "JON'S NURSERY"                 , ;
      "JONES & JONES NURSERY, INC."   , ;
      "KAGER'S NURSERY"               , ;
      "KIRKLAND'S NURSERY"            , ;
      "LAND OF BROMELIADS"            , ;
      "LANDSCAPE NURSERY, INC."       , ;
      "LIEWALD'S NURSERY INC."        , ;
      "LLOYD & RINGS NURSERY"         , ;
      "LONG VAN DOUNG"                , ;
      "MAPEL'S LANDSCAPE NURSERY"     , ;
      "MILESTONE AGRICULTURE, INC."   , ;
      "MOJICA NURSERY & FRUITS"       , ;
      "NELSON'S ROSES"                , ;
      "PARK GARDENS"                  , ;
      "PAUL LUKAS INC."               , ;
      "PECKETT'S INC."                , ;
      "PENANG NURSERY, INC."          , ;
      "PINES III NURERIES"            , ;
      "PINEVIEW NURSERY"              , ;
      "POUL JENSEN NURSERY"           , ;
      "R.P. WELKER"                   , ;
      "RICHARD ROGERS NURSERY, INC."  , ;
      "SPRING HILL NURSERY"           , ;
      "T.O. MAHAFFEY, JR."            , ;
      "TUCKER NURSERY"                , ;
      "TURTLE POND NURSERY"           , ;
      "TUTTLE'S NURSERY INC."         , ;
      "VALLEY CACTUS"                 , ;
      "WHISPER WINDS, INC."           , ;
      "WHITE ROSE NURSERIES INC."     , ;
      "WOODWAY"                       , ;
      "FLORI-DESIGN"                  , ;
      "GREEN ACRES FOLIAGE, INC"      , ;
      "FLORAL EXPO"                   , ;
      "TORRES NURSERY"                , ;
      "DARRYL KOON"                   , ;
      "TRISTAR NURSERY"               , ;
      "KAY WEST NURSERY"              , ;
      "JAYMAR NURSERY"                , ;
      "J D F LANDSCAPE NURSERY"       , ;
      "DEROOSE PLANTS, INC."          , ;
      "THE TREEHOUSE"                 , ;
      "COSTELLO'S ARECAS, INC."       , ;
      "FLORICO FOLIAGE"               , ;
      "THE NATIVES"                   , ;
      "GREENS NURSERY"                , ;
      "STEWART NURSERIES"             , ;
      "G & T FOLIAGE, INC."           , ;
      "GOOD TIMES NURSERY"            , ;
      "CONCEPTS IN GREENERY, INC."    , ;
      "DUNN BROTHERS CITRUS, INC."    , ;
      "JOHN PLANK GREENHOUSES"        , ;
      "GREENER PASTURES NURSERY"      , ;
      "MULVEHILL NURSERY"             , ;
      "A NU LEAF"                     , ;
      "IVY DESIGNS, INC."             , ;
      "B & C TROPICALS"               , ;
      "SPANISH RIVER NURSERY, INC."   , ;
      "JACK CHRISTMAS & ASSOCIATES"   , ;
      "SPECIALIST GROWERS"            , ;
      "HOMRICH NURSERY, INC."         , ;
      "COUNTRYSIDE FOLIAGE, INC."     , ;
      "RFJ COMPANY"                   , ;
      "LAKE BRANTLEY PLANT CORP."     , ;
      "MARISTYME"                     , ;
      "MERISTEM NURSERY, INC."        , ;
      "TROPIC DECOR - EARL WILSON"    , ;
      "URQUHART'S NURSERY"            , ;
      "ACE PLANT NURSERY"             , ;
      "HATTAWAYS GREENHOUSE, INC."    , ;
      "Florida Plant Growers"         , ;
      "Junior Nursery"                , ;
      "Fox's Nurseries, Inc."         , ;
      "Vaughan Nursery"               , ;
      "MERRYGRO FARMS"                , ;
      "ALL SEASONS NURSERY"           , ;
      "BENCHMARK FOLIAGE"             , ;
      "SAMMY'S NURSERY"               , ;
      "SUNSHINE GROWERS"              , ;
      "Blooming-Fields Nursery"       }

   LOCAL aPermits := {}
   LOCAL x
   LOCAL nChoice
   LOCAL ncntr

   CLS

   SetColor( "GB+/B,GR+/R,,,W/N" )

   ASize( aPermits, Len( aPrompts ) )

   FOR x := 1 TO Len( aPrompts )
      aPermits[ x ] := !( "V" $ aPrompts[ x ] )
   NEXT

#define TEST1
#ifdef TEST1
   FOR ncntr := 1 TO 17
      aPermits[ nCntr ]                       := .F.
      aPermits[ Len( aPrompts ) - nCntr + 1 ] := .F.
   NEXT
   aPermits[ 32 ] := .F.
   aPermits[ 33 ] := .F.
   aPermits[ 34 ] := .F.
#endif

   nChoice := AChoice( 5, 10, 20, 70, aPrompts, aPermits, "cUserFunction" )

   SetPos( 0, 0 )
// CLS
   ? nChoice

   IF nChoice > 0
      ? aPrompts[ nChoice ]
   ENDIF
   SetPos( MaxRow() - 2, 0 )

   RETURN

//

FUNCTION cUserFunction( nMode, nCurElement, nRowPos )  /* must be a public function */

   LOCAL nRetVal := AC_CONT                // Default, Continue
   LOCAL nKey    := LastKey()

   LOCAL nRow := Row()
   LOCAL nCol := Col()

   HB_SYMBOL_UNUSED( nRowPos )

   @ 0, 20 SAY Str( nRow, 3 ) + " " + Str( nCol, 3 )

   DO CASE
      // After all pending keys are processed, display message
   CASE nMode == AC_IDLE
      @  0,  0 SAY PadR( hb_ntos( nCurElement ), 10 )
      nRetVal := AC_CONT                   // Continue AChoice()
   CASE nMode == AC_HITTOP                 // Attempt to go past Top
      @  0,  0 SAY "Hit Top   "
      // Tone( 100, 3 )
   CASE nMode == AC_HITBOTTOM              // Attempt to go past Bottom
      @  0,  0 SAY "Hit Bottom"
      // Tone( 100, 3 )
   CASE nMode == AC_EXCEPT                 // Key Exception
      @  0,  0 SAY "Exception "
      DO CASE
      CASE nKey == K_ENTER                 // If RETURN key, select
         nRetVal := AC_SELECT
      CASE nKey == K_ESC                   // If ESCAPE key, abort
         nRetVal := AC_ABORT
      OTHERWISE
         nRetVal := AC_GOTO                // Otherwise, go to item
      ENDCASE
   ENDCASE

   RETURN nRetVal

Ventana Transparente

2015-07-14_125050

 

/*
 * MINIGUI - Harbour Win32 GUI library Demo
 *
 * Copyright 2002-2005 Roberto Lopez <[email protected]>
 * http://www.geocities.com/harbour_minigui/
 *
 * Adapted for ooHG by MigSoft 2007 <migsoft At oohg.org>
*/

#include "oohg.ch"

Function Main()
    Local nTra := 100, hWnd

    DEFINE WINDOW WinTr ;
        AT 0,0 ;
        WIDTH 300 ;
        HEIGHT 300 ;
        TITLE 'Transparent window' ;
        MAIN ;
        NOSIZE NOMAXIMIZE ;
        ON INIT ( hWnd := GetFormHandle('WinTR'), SetTransparent(hWnd, nTra) )

        @ 200,100 BUTTON But1 ;
            CAPTION "Click Me" ;
            HEIGHT 35 WIDTH 100 ;
            ACTION ( nTra := IIF(nTra == 100, 255, 100), SetTransparent(hWnd, nTra) )

    END WINDOW

    CENTER WINDOW WinTR

    ACTIVATE WINDOW WinTR

RETURN NIL


#pragma BEGINDUMP

#define _WIN32_IE 0x0500
#define HB_OS_WIN_32_USED
#define _WIN32_WINNT 0x0400

#define WS_EX_LAYERED 0x80000
#define LWA_ALPHA 0x02

#include <windows.h>
#include "hbapi.h"

HB_FUNC( SETTRANSPARENT )
    {

    typedef BOOL (__stdcall *PFN_SETLAYEREDWINDOWATTRIBUTES) (HWND, COLORREF, BYTE, DWORD);

    PFN_SETLAYEREDWINDOWATTRIBUTES pfnSetLayeredWindowAttributes = NULL;

    HINSTANCE hLib = LoadLibrary("user32.dll");

    if (hLib != NULL)
        {
        pfnSetLayeredWindowAttributes = (PFN_SETLAYEREDWINDOWATTRIBUTES) GetProcAddress(hLib, "SetLayeredWindowAttributes");
        }

    if (pfnSetLayeredWindowAttributes)
        {
        SetWindowLong((HWND) hb_parnl (1), GWL_EXSTYLE, GetWindowLong((HWND) hb_parnl (1), GWL_EXSTYLE) | WS_EX_LAYERED);
            pfnSetLayeredWindowAttributes((HWND) hb_parnl (1), 0, hb_parni (2), LWA_ALPHA);
        }

    if (!hLib)
        {
        FreeLibrary(hLib);
        }

}

#pragma ENDDUMP

Agenda de Contactos MySQL

En esta oportunidad mostraremos el código para gestionar una agenda de contactos que utiliza una base de datos MySQL, se usa como recursos OOHG y TMySQL que viene como contribución por defecto, con Harbour.

2015-06-06_131341
2015-06-06_131412
2015-06-06_131435
2015-06-06_131456

/*
 *  Agenda de Contactos 2
 *  Humberto Fornazier - Marzo 2003 <[email protected]>
 *
 *  Agenda de Contactos 2 ADO
 *  Adapted by Ivanil Marcelino <[email protected]>
 *
 *  Agenda de Contactos 2 MySQL
 *  Adapted and Enhanced by MigSoft - 2015 <migsoft at oohg.org>
 *
 */

#Include "oohg.ch"

#define DARKCYAN   { 0,139,139 }

*------------------------------------------------------------*
Function Main()
*------------------------------------------------------------*
    Local i := 0
    PUBLIC cServer := "localhost"
    PUBLIC cUser   := "root"
    PUBLIC cPaswd  := ""

    oServer := TMySQLServer():New( cServer, cUser, cPaswd )
    if oServer:NetErr()
        oServer := Nil
        msgstop( "Conexión no establecida","Error !!! ONE")
        Return Nil
    ENDIF

    Prepare_Data( oServer )

    SET CENTURY ON
    Private lNuevo := .F.
    DEFINE WINDOW Form_1   ;
        AT 0,0               ;
        WIDTH 450  ;
        HEIGHT 470 ;
        TITLE "Agenda de Contactos MySQL";
        MAIN                 ;
        ICON "AGENDA"  ;
        NOMAXIMIZE ;
        NOSIZE     ;
        ON RELEASE Finaliza_Sistema(oServer) ;
        BACKCOLOR DARKCYAN

        @ 010,415 Grid GIndice Of Form_1 WIDTH 20 ;
            HEIGHT 360 HEADERS {""} WIDTHS { 16 } ;
            FONT "Arial" SIZE 07.5 ;
            TOOLTIP "Click en Letra Deseada"  ;
            ON DBLCLICK captura_Agenda()

        @ 010,010 GRID Grid_Agenda        ;
            WIDTH  398           ;
            HEIGHT 360           ;
            HEADERS {"Código","Nombre"}    ;
            WIDTHS  {53,324}     ;
            FONT "Arial" SIZE 09     ;
            ON DBLCLICK Nuevo_Registro(.F.)

        @ 385,010  BUTTON Btn_Nuevo Of Form_1  ;
            CAPTION '&Nuevo'       ;
            ACTION Nuevo_Registro(.T.)       ;
            WIDTH 120 HEIGHT 27     ;
            FONT "Arial" SIZE 09      ;
            TOOLTIP "Nuevo Registro"       ;
            FLAT

        @ 385,165  BUTTON Btn_Imprimir Of Form_1  ;
            CAPTION '&Imprimir'       ;
            ACTION Imprimir()       ;
            WIDTH 120 HEIGHT 27     ;
            FONT "Arial" SIZE 09      ;
            TOOLTIP "Imprime Contactos"    ;
            FLAT

        @ 385,318  BUTTON Btn_Salir Of Form_1  ;
            CAPTION '&Salir'       ;
            ACTION  Finaliza_Sistema( oServer )   ;
            WIDTH 120 HEIGHT 27     ;
            FONT "Arial" SIZE 09      ;
            TOOLTIP "Finalizar Sistema"   ;
            FLAT

    END WINDOW
    For i := 1 To 26
        ADD ITEM { CHR(i+64) } TO GIndice OF Form_1
    Next
    MODIFY CONTROL GIndice OF Form_1 VALUE 1
    captura_Agenda()
    CENTER WINDOW   Form_1
    ACTIVATE WINDOW Form_1
Return
*------------------------------------------------------------*
Function Finaliza_Sistema(oServer)
*------------------------------------------------------------*
    oServer := Nil
    Form_1.Release
Return .t.
*------------------------------------------------------------*
Function captura_Agenda()
*------------------------------------------------------------*
    Local cPesq

    cPesq  := ValorDeColumna("GIndice","Form_1",1)
    cPesq  := IIf( Empty(cPesq), "A" , cPesq )
    oQuery := oServer:Query("Select * from agenda where nombre like '"+;
              cPesq+"%'"+" order by nombre")
    IF !(oQuery:Neterr())
        DELETE ITEM ALL FROM Grid_Agenda OF Form_1
        Do While ! oQuery:Eof()
            ADD ITEM {oQuery:FieldGet("codigo"),oQuery:FieldGet("nombre")} ;
                     TO Grid_Agenda OF Form_1
            oQuery:Skip()
        EndDo
    ELSE
        msgstop( "Conexión no establecida","Error!!! TWO")
    ENDIF

Return Nil
*------------------------------------------------------------*
Function Nuevo_Registro( lNuevo_Registro  )
*------------------------------------------------------------*
    Local cCodigo	:= ""
    Local cNombre       := ""
    Local cFone1	:= ""
    Local cFone2	:= ""
    Local cFone3        := ""
    Local cFone4	:= ""
    Local cEmpresa	:= ""
    Local cDireccion	:= ""
    Local cPais	        := ""
    Local cEmail	:= ""

    cCodigo := ValorDeColumna( "Grid_Agenda" ,  "Form_1" , 1 )

    IF  oServer  != NIL
        Form_1.Btn_Nuevo.Enabled	:= .F.
        Form_1.Btn_Salir.Enabled	:= .F.

        lNuevo := lNuevo_Registro

        If ! lNuevo
            oQuery := oServer:Query("Select * from agenda where codigo='"+cCodigo+"'")
            if oQuery:Eof()
                Release Window ALL
                Return
            endif
            cNombre      := oQuery:FieldGet("Nombre")
            cFone1       := oQuery:FieldGet("Fono1")
            cFone2       := oQuery:FieldGet("Fono2")
            cFone3       := oQuery:FieldGet("Fono3")
            cFone4       := oQuery:FieldGet("Fono4")
            cEmpresa     := oQuery:FieldGet("Empresa")
            cDireccion   := oQuery:FieldGet("Direccion")
            cEmail       := oQuery:FieldGet("Email")
            cPais        := oQuery:FieldGet("Pais")
        EndIf

        DEFINE WINDOW Form_2   ;
            AT 0,0	              ;
            WIDTH 528	;
            HEIGHT 344	;
            TITLE "Agenda de Contactos - " + ;
                   Iif( lNuevo , "Nuevo Registro" , "Modificando Registro");
            ICON "AGENDA"	       ;
            MODAL		       ;
            NOSIZE		       ;
            ON RELEASE  Salida_F2()    ;
            BACKCOLOR WHITE

            DEFINE FRAME Frame_1
            ROW    10
            COL    10
            WIDTH  500
            HEIGHT 250
            OPAQUE .T.
            END FRAME

            @ 30,20 LABEL Label_Codigo	;
                VALUE 'Código'		;
                WIDTH 140		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @ 60,20 LABEL Label_Nombre	;
                VALUE 'Nombre'		;
                WIDTH 80		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @ 90,20 LABEL Label_Fone1	;
                VALUE 'Teléfono 1'		;
                WIDTH 80		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @120,20 LABEL Label_Fone2	;
                VALUE 'Teléfono 2'		;
                WIDTH 80		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @90,270 LABEL Label_Fone3       ;
                VALUE 'Teléfono 3'		;
                WIDTH 80			;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @120,270 LABEL Label_Fone4	;
                VALUE 'Teléfono 4'		;
                WIDTH 80		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @150,20 LABEL Label_Empresa	;
                VALUE 'Empresa'		;
                WIDTH 80			;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @180,20 LABEL Label_Direccion ;
                VALUE 'Dirección'		;
                WIDTH 80			;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @210,20 LABEL Label_Email ;
                VALUE 'E-Mail'		;
                WIDTH 80			;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @210,325 LABEL Label_Estado	;
                VALUE 'País'		;
                WIDTH 50		;
                HEIGHT 30		;
                FONT 'Arial' SIZE 09      ;
                BACKCOLOR WHITE   ;
                FONTCOLOR DARKCYAN BOLD

            @ 30,120 TEXTBOX T_Codigo		;
                WIDTH 80			;
                VALUE cCodigo      ;
                TOOLTIP 'Código de Contacto'

            @ 60,120 TEXTBOX T_Nombre      ;
                OF Form_2		;
                WIDTH 370		;
                VALUE cNombre		;
                TOOLTIP 'Nombre de Contacto'	;
                MAXLENGTH 40		;
                UPPERCASE		;
                ON ENTER Iif( ! Empty( Form_2.T_Nombre.Value ) , ;
                   Form_2.T_Direccion.SetFocus , Form_2.T_Nombre.SetFocus )

            @ 90,120 TEXTBOX T_Fone1   ;
                OF Form_2      ;
                WIDTH 120        ;
                VALUE cFone1      ;
                TOOLTIP 'Teléfono de Contacto';
                MAXLENGTH 10     ;
                UPPERCASE        ;
                ON GOTFOCUS Form_2.Btn_Salvar.Enabled := .T.  ;
                ON ENTER Form_2.T_Fone2.SetFocus

            @120,120 TEXTBOX T_Fone2     ;
                OF Form_2      ;
                WIDTH 120		;
                VALUE cFone2		;
                TOOLTIP 'Teléfono de Contacto'	;
                MAXLENGTH 10		;
                UPPERCASE		;
                ON ENTER Form_2.T_Fone3.SetFocus

            @90,370 TEXTBOX T_Fone3       ;
                OF Form_2     ;
                WIDTH 120      ;
                VALUE cFone3		;
                TOOLTIP 'Teléfono de Contacto'	;
                MAXLENGTH 10		;
                UPPERCASE		;
                ON ENTER Form_2.T_Empresa.SetFocus

            @120,370 TEXTBOX T_Fone4     ;
                OF Form_2     ;
                WIDTH 120		;
                VALUE cFone4		;
                TOOLTIP 'Teléfono de Contacto'	;
                MAXLENGTH 10		;
                UPPERCASE		;
                ON ENTER Form_2.T_Empresa.SetFocus

            @150,120 TEXTBOX T_Empresa    ;
                OF Form_2     ;
                WIDTH 370		;
                VALUE cEmpresa		;
                TOOLTIP 'Empresa';
                MAXLENGTH 40		;
                UPPERCASE		;
                ON ENTER Form_2.T_Direccion.SetFocus

            @180,120 TEXTBOX T_Direccion      ;
                OF Form_2       ;
                WIDTH 370		;
                VALUE cDireccion		;
                TOOLTIP 'Dirección de Contacto';
                MAXLENGTH 40		;
                UPPERCASE		;
                ON ENTER Form_2.T_Email.SetFocus

            @210,120 TEXTBOX T_Email ;
                OF Form_2     ;
                WIDTH 180		;
                VALUE cEmail		;
                TOOLTIP 'E-Mail de Contacto';
                MAXLENGTH 30		;
                ON ENTER Form_2.T_Pais.SetFocus

            @210,370 TEXTBOX T_Pais      ;
                OF Form_2       ;
                WIDTH 120		;
                VALUE cPais		;
                TOOLTIP 'País de Contacto'	;
                MAXLENGTH 02		;
                UPPERCASE		;
                ON ENTER Form_2.Btn_Salvar.SetFocus

            @ 270,150 BUTTON Btn_Salvar Of Form_2	;
                CAPTION '&Salvar'     ;
                ACTION Salvar_Registro()        ;
                WIDTH 100 HEIGHT 28     ;
                FONT "Arial" SIZE 09      ;
                TOOLTIP "Salvar Registro" ;
                FLAT

            @ 270,280  BUTTON Btn_Excluir Of Form_2   ;
                CAPTION '&Eliminar'        ;
                ACTION Excluir_Registro()   ;
                WIDTH 100 HEIGHT 28     ;
                FONT "Arial" SIZE 09      ;
                TOOLTIP "Excluir Registro"    ;
                FLAT

            @ 270,410  BUTTON Btn_Cancelar Of Form_2  ;
                CAPTION '&Cancelar'       ;
                ACTION Salir_do_Form2()      ;
                WIDTH 100 HEIGHT 28     ;
                FONT "Arial" SIZE 09      ;
                TOOLTIP "Cancelar Operación"   ;
                FLAT

        END WINDOW
        Form_2.T_Codigo.Enabled := .F.

        If lNuevo
            Form_2.Btn_Salvar.Enabled := .F.
            Form_2.Btn_Excluir.Enabled := .F.
        EndIf

        CENTER WINDOW   Form_2
        ACTIVATE WINDOW Form_2

    ELSE
        msgstop( "Conexión no establecida","Error!!! NUEVO")
    ENDIF
Return Nil
*------------------------------------------------------------*
Procedure Salida_F2
*------------------------------------------------------------*
    Form_1.Btn_Nuevo.Enabled    := .T.
    Form_1.Btn_Salir.Enabled    := .T.
    Form_2.Btn_Excluir.Enabled := .T.
    captura_Agenda()
    Form_1.Grid_Agenda.SetFocus()
Return
*------------------------------------------------------------*
Function Salvar_Registro()
*------------------------------------------------------------*
    Local ProximoCodigo := "", cSQL
    Local cCodigo := ""

    If Empty( Form_2.T_Nombre.Value )
        MsgINFO( "Se debe Indicar Nombre!!!" , "Agenda" )
        Form_2.T_Nombre.SetFocus
        Return Nil
    EndIf

    oQuery := oServer:Query("Select Codigo from agenda order by codigo desc")
    oQuery:GoTop()

    IF !(oQuery:Neterr())

        If  lNuevo

            if oQuery:Eof()
                ProximoCodigo:="0001"
            else
                ProximoCodigo := StrZero( Val(oQuery:FieldGet("Codigo")) + 1 , 4 )
            endif

            Form_2.T_Codigo.Value := ProximoCodigo

            cSql:="INSERT INTO AGENDA (Codigo,Nombre,Fono1,Fono2,Fono3,Fono4,";
                  +"Empresa,Direccion,Email,Pais) VALUES ('"
            cSql+=ProximoCodigo             +"','"
            cSql+=Form_2.T_Nombre.Value     +"','"
            cSql+=Form_2.T_Fone1.Value      +"','"
            cSql+=Form_2.T_Fone2.Value      +"','"
            cSql+=Form_2.T_Fone3.Value      +"','"
            cSql+=Form_2.T_Fone4.Value      +"','"
            cSql+=Form_2.T_Empresa.Value    +"','"
            cSql+=Form_2.T_Direccion.Value  +"','"
            cSql+=Form_2.T_Email.Value      +"','"
            cSql+=Form_2.T_Pais.Value       +"')"
        Else
            cSql:="UPDATE AGENDA SET "
            cSql+="Nombre='"+Form_2.T_Nombre.Value        +"',"
            cSql+="Fono1='"+Form_2.T_Fone1.Value          +"',"
            cSql+="Fono2='"+Form_2.T_Fone2.Value          +"',"
            cSql+="Fono3='"+Form_2.T_Fone3.Value          +"',"
            cSql+="Fono4='"+Form_2.T_Fone4.Value          +"',"
            cSql+="Empresa='"+Form_2.T_Empresa.Value      +"',"
            cSql+="Direccion='"+Form_2.T_Direccion.Value  +"',"
            cSql+="Email='"+Form_2.T_Email.Value          +"',"
            cSql+="Pais='"+Form_2.T_Pais.Value            +"'"
            cSql+=" Where codigo='"+Form_2.T_Codigo.Value +"'"
        Endif

        oServer:Query( cSQL )

        If !( oServer:NetErr() )
            MsgInfo( "Registo "+Iif( lNuevo , "Incluído" ,"Modificado!!" )  )
        Endif

    ELSE
        msgstop( "Conexión no establecida","Error!!! SAVE")
    ENDIF

    PosicionaIndice( Left(Form_2.T_Nombre.Value,1) )
    captura_Agenda()
    Form_2.Release

Return Nil
*------------------------------------------------------------*
Function Salir_do_Form2()
*------------------------------------------------------------*
    Form_1.Btn_Nuevo.Enabled	:= .T.
    Form_1.Btn_Salir.Enabled	:= .T.
    Form_2.Btn_Excluir.Enabled := .T.
    Form_2.Release
    captura_Agenda()
    Form_1.Grid_Agenda.SetFocus()
Return Nil
*------------------------------------------------------------*
Function Excluir_Registro()
*------------------------------------------------------------*
    Local cCodigo:=Form_2.T_Codigo.Value,cSql
    If MsgOkCancel ("Confirma Exclusión de Registro??", "Excluir "+cCodigo)
        cSql:="DELETE FROM AGENDA WHERE CODIGO='"+cCodigo+"'"
        oServer:Query( cSQL )
    EndIf
    PosicionaIndice( Left(Form_2.T_Nombre.Value,1) )
    captura_Agenda()
    Form_2.Release
    Form_1.Grid_Agenda.SetFocus
Return Nil
*------------------------------------------------------------*
Function ValorDeColumna( ControlName, ParentForm , nCol )
*------------------------------------------------------------*
    Local aRet := {}
    If GetControlType (ControlName,ParentForm) != "GRID"
        MsgBox( "Objeto no esta en un Grid!!")
        Return( aRet )
    EndIf
    nCol := Iif( nCol == Nil .Or. nCol == 0 , 1 , nCol )
    aRet := GetProperty (  ParentForm  , ControlName , 'Item' ,;
            GetProperty( ParentForm , ControlName , 'Value' ) )
Return( aRet[ nCol ] )
*------------------------------------------------------------*
Function PosicionaIndice(cLetra)
*------------------------------------------------------------*
    Local i := 0
    For i := 1 To 26
        If CHR(i+64) == cLetra
            MODIFY CONTROL GIndice OF Form_1 VALUE i
        EndIf
    Next
    Form_1.GIndice.SetFocus
Return Nil
*------------------------------------------------------------*
Function Imprimir()
*------------------------------------------------------------*
    Local nLinea:=i:=nReg:=0,cLetra:="",oQuery,Handle,cLinea,Cr:=Chr(13)+chr(10)
    Private nFont := 11
    Private cArquivo := ""

    IF  oServer != NIL
        Handle:=fCreate("Rel.tmp")
        if Handle<=0
            Return
        endif
        cLetra := ValorDeColumna( "GIndice" ,  "Form_1" , 1 )
        oQuery := oServer:Query("Select * from agenda where nombre like '"+;
                  cLetra+"%'"+" order by nombre")
        Do While ! oQuery:Eof()
            If nLinea == 0.or.nLinea>55
                cLinea := PadC(" Agenda de Contactos",78)+Cr
                cLinea += PadC("Contactos por letra "+cLetra,78)+Cr
                cLinea += "Código  Nombre"+Cr
                cLinea += Replicate("-",78)+cr
                Fwrite(Handle,cLinea)
                nLinea:=5
            EndIf
            nLinea += 1
            nReg   += 1
            Fwrite(Handle,"  "+oQuery:FieldGet("Codigo") +;
                     "   "+oQuery:FieldGet("Nombre")+Cr)
            oQuery:Skip()
        EndDo
        cLinea := Replicate("-",78)+cr
        cLinea+="Registros Impresos: "+StrZero(nReg,4)
        Fwrite(Handle,cLinea)
        fClose(Handle)
        cArquivo :=memoRead("REL.TMP")
        Define Window Form_3;
            At 0,0              ;
            Width 450        ;
            Height 500       ;
            Title "Contactos por Letra "+cLetra;
            ICON "AGENDA";
            CHILD ;
            NOSYSMENU;
            NOSIZE       ;
            BACKCOLOR WHITE

            @20,-1 EDITBOX Edit_1 ;
                WIDTH 460 ;
                HEIGHT 510 ;
                VALUE cArquivo ;
                TOOLTIP "Contactos por Letra "+cLetra ;
                MAXLENGTH 255

            @ 01,01 BUTTON Bt_Zoom_mas  ;
                CAPTION '&Zoom(+)'             ;
                WIDTH 120 HEIGHT 17    ;
                ACTION ZoomLabel(1);
                FONT "MS Sans Serif" SIZE 09 FLAT

            @ 01,125 BUTTON Bt_Zoom_menos  ;
                CAPTION '&Zoom(-)'             ;
                WIDTH 120 HEIGHT 17    ;
                ACTION ZoomLabel(2);
                FONT "MS Sans Serif" SIZE 09 FLAT

            @ 01,321 BUTTON Salir_1  ;
                CAPTION '&Salir'             ;
                WIDTH 120 HEIGHT 17    ;
                ACTION Form_3.Release;
                FONT "MS Sans Serif" SIZE 09 FLAT

        End window
        MODIFY CONTROL Edit_1 OF Form_3 FONTSIZE nFont
        Center Window Form_3
        Activate Window Form_3
    ELSE
        msgstop( "Conexión no establecida", "Error!!! IMPRIMIR")
    ENDIF

Return Nil
*------------------------------------------------------------*
Function ZoomLabel(nmm)
*------------------------------------------------------------*
    If nmm == 1
        nFont++
    Else
        nFont--
    Endif
    MODIFY CONTROL Edit_1 OF Form_3 FONTSIZE nFont
Return Nil
*------------------------------------------------------------*
Function Prepare_data( oServer )
*------------------------------------------------------------*
    Local lResp1 := .F., lResp2 := .F.

    Database_Create( "test", oServer )
    Database_Connect( "test", oServer )
    Table_Create( "agenda", oServer )

Return Nil
*------------------------------------------------------------*
Function Database_Connect( cDatabase, oServer )
*------------------------------------------------------------*
    Local i:= 0
    Local aDatabaseList:= {}

    cDatabase:= Lower(cDatabase)
    If oServer == Nil
        MsgInfo("No conectado con Servidor MySQL!")
        Return Nil
    EndIf

    aDatabaseList:= oServer:ListDBs()
    If oServer:NetErr()
        MsgInfo("Error verificando lista de bases de datos: " + oServer:Error())
        Return Nil
    Endif

    If AScan( aDatabaseList, Lower(cDatabase) ) == 0
        MsgInfo( "Base de Datos "+cDatabase+" no existe!")
        Return Nil
    EndIf

    oServer:SelectDB( cDatabase )
    If oServer:NetErr()
        MsgInfo("Error conectando con base de datos "+cDatabase+": "+oServer:Error() )
        Return Nil
    Endif

Return Nil
*------------------------------------------------------------*
Function  Database_Create( cDatabase, oServer )
*------------------------------------------------------------*
    Local aDatabaseList := {}, lResp := .F.

    cDatabase := Lower( cDatabase )

    If oServer == Nil
        MsgInfo("No conectado con Servidor MySQL!")
        lResp := .F.
        Return lResp
    EndIf

    aDatabaseList := oServer:ListDBs()

    If oServer:NetErr()
        MsgInfo("Error verificando lista de base de datos: " + oServer:Error())
        lResp := .F.
        Return lResp
    Endif

    If AScan( aDatabaseList, Lower(cDatabase) ) != 0
        //MsgInfo( "Base de Datos ya existe!")
        lResp := .F.
        aDatabaseList := {}
        Return lResp
    EndIf

    oServer:CreateDatabase( cDatabase )

    If oServer:NetErr()
        MsgInfo("Error creando Base de Datos: " + oServer:Error() )
        lResp := .F.
    Else
        lResp := .T.
    Endif

Return( lResp )
*------------------------------------------------------------*
Function Table_Create( cTable, oServer )
*------------------------------------------------------------*
    Local aTableList := {}
    Local cQuery, lResp := .F.

    If oServer == Nil
        MsgStop("No conectado con Servidor MySQL...")
        lResp := .F.
        Return lResp
    EndIf

    aTableList := oServer:ListTables()
    If oServer:NetErr()
        MsgStop("Error verificando lista de tablas: " + oServer:Error() )
        lResp := .F.
        Return lResp
    Endif

    If AScan( aTableList, Lower(cTable) ) != 0
        //MsgStop( "Tabla "+cTable+" ya existe!")
        lResp := .F.
        Return lResp
    EndIf

    cQuery:= "CREATE TABLE "+cTable+" ( CODIGO Char(4), NOMBRE Char(40),"+ ;
             "FONO1 Char(10), FONO2 Char(10), FONO3 Char(10), FONO4 Char(10),"+ ;
             "EMPRESA Char(40), DIRECCION Char(40), EMAIL Char(30), PAIS Char(2) ) "

    oQuery := oServer:Query( cQuery )

    If oServer:NetErr()
        MsgStop("Error creando tabla "+cTable+": "+oServer:Error() )
        lResp := .F.
    Else
        lResp := .T.
    Endif

    oQuery:Destroy()

Return lResp

 

Abrir Aplicaciones Externas

2015-04-04_182346

 

2015-04-04_182326

2015-04-04_183249

 

/*
 * (c)2015 MigSoft Test Execute Functions
 *
 */

#include 'oohg.ch'

FUNCTION Main()
   Public nHdl := 0

   DEFINE WINDOW Form_1 ;
      AT 0, 0 ;
      WIDTH 600 ;
      HEIGHT 500 ;
      TITLE 'Open Applications by MigSoft' ;
      MAIN

      DEFINE STATUSBAR
         STATUSITEM 'OOHG Power !!!'
      END STATUSBAR

      @ 70, 20 BUTTON Button_1 ;
         WIDTH 180 THEMED ;
         CAPTION 'Google Chrome' ;
         ACTION AbreChrome()

      @ 100, 20 BUTTON Button_2 ;
         WIDTH 180 THEMED ;
         CAPTION 'ShellExecute' ;
         ACTION AbreProg()

      @ 130, 20 BUTTON Button_3 ;
         WIDTH 180 THEMED ;
         CAPTION 'Teclado ON' ;
         ACTION Teclado1(1)

      @ 160, 20 BUTTON Button_4 ;
         WIDTH 180 THEMED ;
         CAPTION 'Teclado OFF' ;
         ACTION Teclado1(0)

      @ 190, 20 BUTTON Button_5 ;
         WIDTH 180 THEMED ;
         CAPTION 'Calculadora ON' ;
         ACTION Calculadora(1)

      @ 220, 20 BUTTON Button_6 ;
         WIDTH 180 THEMED ;
         CAPTION 'Calculadora OFF' ;
         ACTION Calculadora(0)

      @ 250, 20 BUTTON Button_7 ;
         WIDTH 180 THEMED ;
         CAPTION 'Word' ;
         ACTION EnviaFile()

      ON KEY ESCAPE ACTION Form_1.Release()

   END WINDOW

   CENTER WINDOW Form_1
   ACTIVATE WINDOW Form_1

RETURN NIL


Function AbreChrome()

   oShell1 := CreateObject('WScript.Shell')
   oShell1:Exec ('C:\Program Files (x86)\Google\Chrome\' + ;
      'Application\chrome.exe -url http:www.mig2soft.com')

Return Nil

Function AbreProg()

   cFileName := 'C:\Program Files (x86)\Google\' + ;
                'Chrome\Application\chrome.exe'
   cParams   := '-url http:www.mig2soft.com'
   cAction   := 'open'   // 'play' , 'properties', 'PrintTo'
   ShellExecute( 0, cAction, cFileName, cParams, '', 1 )

Return Nil

Function EnviaFile()     // Change path and file
    nRes := ShellExecute( 0, 'open', ;
            'c:\Users\Usuario1\Documents\Balance de situacion.rtf')
    If nRes < 33
       MsgInfo('Error en conexión')
    Endif
Return Nil


#define WM_CLOSE                        0x0010

Function Teclado1( nOp )
   LOCAL cKeyboard := GetEnv( 'windir' ) + '\system32\osk.exe'

   If nOp = 1
      ShellExecute( 0, 'open', cKeyboard, , , 1 )
   Endif

   If nOp = 0
      //SendMessage( GetForegroundWindow(), WM_CLOSE )
      SendMessage( FindWindowEx( Nil,Nil,Nil, ;
            'On-Screen Keyboard' ) , WM_CLOSE )
      SendMessage( FindWindowEx( Nil,Nil,Nil, ;
            'Teclado en Pantalla' ), WM_CLOSE )

   Endif

Return Nil

Function Calculadora( nOp )
   If nOp = 1
      ShellExecute( 0, 'open', 'calc' )
   Endif

   If nOp = 0
      SendMessage( FindWindowEx( Nil,Nil,Nil, ;
                  'Calculator' ), WM_CLOSE )
      SendMessage( FindWindowEx( Nil,Nil,Nil, ;
                 'Calculadora' ), WM_CLOSE )
   Endif

Return Nil