Code: Select all

hbcs=hbmxml.hbc hbssl.hbc hbziparc.hbc

Code: Select all

 #include "hmg.ch"
  #define CRLF    HB_OsNewLine()
  #include "FILEIO.CH"

  function Main()
	local temp
	public prating := 8, AND MORE

        REQUEST DBFNTX          
        SET CENTURY ON
        SET DELETED OFF
        SET DATE TO BRITISH
        USE CONTROLS NEW SHARED 
        GO 1
        MSERIAL := ALLTRIM(SERIAL)
        USE
	 HB_LANGSELECT( "EN" )

        // Define the main window.
        DEFINE WINDOW Win_1                  ;
           AT         0,0                    ;
           WIDTH      getdesktopWidth()-25      ;
           HEIGHT     getDeskTopHeight()-45  ;
           TITLE      " Title"   ;
	   MAIN                              ;
           NOMAXIMIZE                        ;
           NOSIZE                            ;
	   ON INIT   {||{ ABOUT()} 
           BACKCOLOR  GRAY ;
	   FONT 'Arial' SIZE 9 
	   ON KEY CONTROL + G action MSGBOX('Series: '+mcod)
	   ON KEY CONTROL + W action ABOUT()   
		   
           DEFINE MAIN MENU OF Win_1
              	  POPUP "    E&xit"
                      ITEM "&Exit Q&A" ;
                              ACTION Win_1.Release
           	      END POPUP
              	      POPUP "   MORE POPUPS"
                      ITEM " MORE POPUPS" ;
                              ACTION MORE FUNCTIONS
           	      END POPUP
          END MENU
		     ON KEY F1 OF WIN_1 ACTION HELPING('q&a.HLP')
		     ON KEY F10 OF WIN_1 ACTION MSGBOX('DATE: 02/20/20')
        END WINDOW
        ACTIVATE WINDOW Win_1
	set helpfile to helping('q&a.hlp')

  return NIL

Code: Select all

*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC Cotizacion_PdfPrint( nOperId , cDocNum , cDocFec )

LOCAL dEmision , cPdfTipo , cPdfRuta , cPdfFile , cPrinter

   IF nOperId > 0
      dEmision := CTOD( cDocFec )
      cPdfRuta := PATHCPE + STR(YEAR(dEmision),4) + '\' + STRZERO(MONTH(dEmision),2) + '\' + STRZERO(DAY(dEmision),2)
      cPdfFile := cPdfRuta + "\" + SIS_RUC + "_00_" + cDocNum + ".pdf"
      IF FILE(cPdfFile)
         cPrinter := GetDefaultPrinter()
         msginfo( cPdfFile + chr(13) + cPrinter )
//         ShellExecute( GetDesktopWindow() , 'printto' , cPdfFile , '"' + cPrinter + '"' , "" , 7 )
//         ShellExecute( 0 , 'printto' , cPdfFile , '"' + cPrinter + '"' ,  , 0 )
         ShellExecute( 0 , "printto" , '"' + cPdfFile + '"' , '"' + cPrinter + '"' , 0 , 0 )
//         wapi_ShellExecute( 0, 'printto' , cPdfFile , cPrinter , , 0 ) 
         MSGINFO( '.pdf enviado a la impresora.')
      ELSE
         msginfo("No existe el archivo "+cPdfFile)
      ENDIF
   ENDIF

RETURN

Code: Select all

msgdebug ( ShellExecute( Nil , "print" , '"' + cPdfFile + '"' , , Nil , Nil ) )

Code: Select all

2482 STATIC PROCEDURE AddNewRec()
2483
2484 LOCAL nRecNo
2485
2486   SELECT 1
2487   ORDSETFOCUS(0)
2488   APPEND BLANK
2489 *  nRecNo := RECNO()
2490
2491   XPPTEL_Store()
2492   nRecNo := RECNO()
2493  
2494   IF SP_Browse() = "BROWSE"
2495      SetProperty( "XPPTEL", "Browse_1", "value", nRecNo )
2496   ELSE
->2497      SetProperty( "XPPTEL", "Browse_1", "RecNo", nRecNo )
2498   ENDIF

Code: Select all

FUNCTION TNR2STR( value )

LOCAL RETVAR := ""
LOCAL nLen   := LEN( value )
LOCAL nSoll  := nLen
LOCAL i, nDiff
LOCAL cStr

   FOR i = 1 TO nLen
      cStr := SUBSTR( value, i, 1 )
      IF cStr == CHR( 32 )
      ELSE
         RETVAR := RETVAR + cStr
      ENDIF
   NEXT

   nDiff := nSoll - LEN( RETVAR )
   FOR i = 1 TO nDiff
      RETVAR := RETVAR + CHR( 32 )
   NEXT

RETURN RETVAR

Code: Select all

PROCEDURE CreateCDX( cCodepage )

LOCAL _tagname, _keyfeld, _cdxname

   USE XPPTEL.DBF VIA "DBFCDX" EXCLUSIVE CODEPAGE (cCodepage)

   _cdxname := "XPPTEL.CDX"                                           // "TELINDEX"

   _tagname := "KDNAME"                                               //zkdname   1
   _KEYFELD := "UPPER(NAME1+NAME2)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "STADT"                                                //zkdort    2
   _KEYFELD := "UPPER(STADT+STRASSE)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "STRASSE"                                              //zstrasse  3
   _KEYFELD := "UPPER(STRASSE+STADT)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "GESCHTEL"                                             //ztelefon  4
   _KEYFELD := "TNR2STR(TELGES)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "FAX"                                                  //ztelfax   5
   _KEYFELD := "TNR2STR(TELFAX)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "1_HANDY"                                              //          6
   _KEYFELD := "TNR2STR(HANDY1)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "2_HANDY"                                              //          7
   _KEYFELD := "TNR2STR(HANDY2)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "3_HANDY"                                              //          8
   _KEYFELD := "TNR2STR(ANHANDY)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "4_HANDY"                                              //          9
   _KEYFELD := "TNR2STR(PVHANDY)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "ANSPVOR"                                              //zansprech 10
   _KEYFELD := "UPPER(ANSPVOR+ANSPNACH)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "ANSPNACH"                                             //zansprech 11
   _KEYFELD := "UPPER(ANSPNACH+ANSPVOR)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "BRANCHE"                                              //zbranche  12
   _KEYFELD := "TKSEL+UPPER(NAME1)"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "KUNDENNO"                                             //zkdnr     13
   _keyfeld := "TKDNR"
   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   _tagname := "ALLETELNO"                                            //zkdnr     14
   _keyfeld := "TNR2STR(VORTELE)+" + ;
               "TNR2STR(TELGES) +" + ;
               "TNR2STR(VORFAX) +" + ;
               "TNR2STR(TELFAX) +" + ;
               "TNR2STR(VORPRIV)+" + ;
               "TNR2STR(TELPRI) +" + ;
               "TNR2STR(HANDY1) +" + ;
               "TNR2STR(HANDY2) +" + ;
               "TNR2STR(ANHANDY)+" + ;
               "TNR2STR(PVVORT1)+" + ;
               "TNR2STR(PVTEL1) +" + ;
               "TNR2STR(PVVORF1)+" + ;
               "TNR2STR(PVFAX1) +" + ;
               "TNR2STR(PVHANDY)"

   ORDCREATE( _cdxname, _tagname, _keyfeld )
   CLOSE INDEX

   CLOSE

RETURN

Code: Select all

******************************
*** COMPILADO EN HMG 3.4.0 ***
******************************

#include "hmg.ch"
#include "inkey.ch"

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()

Public cons_hwnd:=GETCONSOLEWINDOW()
HideConsole(cons_hwnd)

SET CODEPAGE TO UNICODE
SET CURSOR OFF

DEFINE WINDOW SNAKE AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,139,139} MAIN

DRAW RECTANGLE IN WINDOW SNAKE AT 45,195 TO 105,1028 PENCOLOR GREEN PENWIDTH 5 FILLCOLOR {112,128,144}
@ 50,200 LABEL L1 VALUE "J U E G O      L A      C U L E B R I T A" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 36 FONTCOLOR WHITE BOLD UNDERLINE TRANSPARENT
@150,125 LABEL L2 VALUE "- CON LA CULEBRITA, PASA POR ENCIMA DE CADA NÚMERO QUE APARECE EN PANTALLA, EMPIEZA CON EL #1 HASTA LLEGAR AL #9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@200,125 LABEL L3 VALUE "- DEBES SEGUIR EXTRICTAMENTE EL ORDEN SECUENCIAL 1-2-3-4-5-6-7-8-9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@250,125 LABEL L4 VALUE "- LA CULEBRITA CADA VEZ QUE AVANZA IRÁ CRECIENDO SU CUERPO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@300,125 LABEL L5 VALUE "- PUEDES AVANZAR HACIA CUALQUIER LADO (ARRIBA-ABAJO-DERECHA-IZQUIERDA), UTILIZA LAS FLECHAS DIRECCIONALES," WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@350,125 LABEL L6 VALUE "- SI VAS EN DIRECCIÓN CONTRARIA A LA QUE VAS, TE ELIMINARÁS Y PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@400,125 LABEL L7 VALUE "- SI CHOCAS CONTRA EL MARCO ROJO (LÍMITE DEL CAMPO DE JUEGO), PERDERÁS !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@450,125 LABEL L8 VALUE "- SI PASAS POR ENCIMA DE TU PROPIO CUERPO (COLA), PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@500,125 LABEL L9 VALUE "- SI QUIERES PAUSAR EL JUEGO, PARA RECONSIDERAR UNA ESTRATEGIA, PULSA ESCAPE !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT

@575,600 BUTTON B1 CAPTION "J U G A R" FONT "ARIAL" SIZE 12 BOLD ONCLICK ENTRADA()


DEFINE PLAYER MUSIC
   ROW    0
   COL    0
   WIDTH  0
   HEIGHT 0
   FILE GetWindowsFolder() + "\Media\TOWN.MID"		// SONIDO DE FONDO PARA HACERLO AMIGABLE
END PLAYER

END WINDOW

SNAKE.MUSIC.PLAY()
SNAKE.MAXIMIZE
SNAKE.ACTIVATE
RETURN


*---------------
FUNCTION ENTRADA
Local i, aCoordinates, FnNum, CnNum, lFound, cBrick

SNAKE.HIDE

MessageBoxTimeout ("LA CULEBRITA NACE EN EL CENTRO DE LA PANTALLA"+CHR(13)+CHR(13)+" Y ESPERA QUE TÚ LE DES MOVIMIENTO"+CHR(13)+"PARA CUALQUIER LADO ╬ ...")

ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )

SETMODE(25,90)
CLEA

SET COLO TO W+/B+

SNAKE.MUSIC.STOP

SET COLO TO R/B
CLEA

DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )

SET COLO TO W+/B

aCoordinates := { { 12, 40 } }		//snake's position
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          IF Empty ( aCoordinates )
	       EXIT
          ELSE
               lFound := .F.
	       AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
               IF .Not. lFound
                    EXIT
               ENDIF
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      @ FnNum, CnNum SAY i PICT "9" COLO ("G+/N")	// MUESTRA LOS # ALEATORIAMENTE DENTRO DEL CUADRO
NEXT i

//nine bricks
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          lFound := .F.
	  AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
          IF .Not. lFound
               EXIT
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )

      IF i%1 = 0 .OR. i%2 = 0 .OR. i%3 = 0
          cBrick := "◙"
      ENDIF

      @ FnNum, CnNum SAY cBrick COLO ("W+/B")	// Brick
NEXT i

DO JUGAR

RETURN

********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, cDirection := "", nSpeed

@ 6,82 SAY "NÚMEROS"
@ 7,82 SAY "TAPADOS"
@ 8,82 SAY "======="

Keyboard CHR( 0 )

F := 12
C := 40

@ F,C SAY "╬"

X=0
INKEY(0)

DO WHILE .T.

DO CASE
   CASE lastkey() = K_RIGHT			// FLECHA A LA DERECHA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╔"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Right"
      C++
      nSpeed := 0.2

   CASE lastkey() = K_LEFT		// FLECHA A LA IZQUIERDA

      DO CASE 
           CASE cDirection = "Up"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Down"
               @ F,C SAY "╝"		//OK
      ENDCASE
      cDirection := "Left"
      C--
      nSpeed := 0.2

   CASE lastkey() = K_UP			// FLECHA ARRIBA

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╝"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╚"		//OK
      ENDCASE
      cDirection := "Up"
      F--
      nSpeed := 0.35

   CASE lastkey() = K_DOWN		// FLECHA ABAJO

      DO CASE 
           CASE cDirection = "Right"				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE cDirection = "Left"
               @ F,C SAY "╔"		//OK
      ENDCASE
      cDirection := "Down"
      F++
      nSpeed := 0.35

   CASE lastkey() = K_ESC		// PAUSA EL JUEGO
      @ 24,28 SAY "UD HA PAUSADO EL JUEGO !"
      INKEY(0)
      @ 24,28 SAY "CONTINÚE EL JUEGO .... !"
      LOOP

   CASE lastkey() != K_RIGHT .OR. lastkey() != K_LEFT .OR. lastkey() != K_UP .OR. lastkey() != K_DOWN
      EXIT

ENDCASE

cMessage := CheckCollision ( F /* nRow */ , C /* nCol */, @nNextGoal )
IF Empty ( cMessage )
     @ F,C SAY IF ( cDirection = "Right" .Or. cDirection = "Left", "═", "║" )
ELSE
     MessageBoxTimeout ( cMessage, "Snake" )
     EXIT
ENDIF

INKEY( nSpeed )				// VELOCIDAD DEL JUEGO
  
ENDDO

MessageBoxTimeout ("SALIENDO DE LA CULEBRITA !")
SNAKE.RELEASE
QUIT
RETURN

********************************************************
FUNCTION CheckCollision ( nRow, nCol, nNextGoal )
Local cScrChar := GetCharFromScreen( nRow, nCol ), i

DO CASE
     CASE isDigit ( cScrChar )
          IF Val ( cScrChar ) == nNextGoal
               IF nNextGoal = 9
		    PLAY WAVE GetWindowsFolder() + "\Media\tada.wav"
                    @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
		    RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
               ENDIF
               PLAY WAVE "X.wav"
               //PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
               @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
               nNextGoal ++
          ELSE
               PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
               RETURN "¡ESE NÚMERO NO ERA EL QUE SEGUÍA!"
          ENDIF

      CASE cScrChar $ hb_utf8ToStr ( "☺═║╗╔╚╝", "EN" )
          PLAY WAVE GetWindowsFolder() + "\Media\chord.wav"
          SetColor ( "R+/B" )
          @nRow, nCol SAY "♦"
          RETURN "LO SIENTO UD SE HA SUICIDADO !"

      CASE cScrChar = hb_utf8ToStr ( "█", "EN" )
	  PLAY WAVE GetWindowsFolder() + "\Media\ringout.wav"
          FOR i := 1 TO 99
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "Y+/B" )
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )
          NEXT i
          RETURN "SALIÓ DE LA PISTA DE JUEGO"+CHR(13)+CHR(13)+"HA PERDIDO !!!"
		
      CASE cScrChar <> " "
          PLAY WAVE GetWindowsFolder() + "\Media\chimes.wav"
          RETURN "Collision with " + hb_StrToUTF8 ( cScrChar, "EN" )
ENDCASE
RETURN ""


************************************************
FUNCTION GetCharFromScreen( nRow, nCol )
Local cChars
SET CODEPAGE TO ENGLISH
cChars := SaveScreen (nRow, nCol, nRow, nCol)
SET CODEPAGE TO UNICODE
RETURN Left ( cChars, 1 )


#pragma BEGINDUMP

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

// doesn't work with win32 function GetConsoleWindow()
HWND GetConWin()
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
return hwnd;
}

HB_FUNC( GETCONSOLEWINDOW )
{
hb_retnl ((LONG_PTR) GetConWin());
}

HB_FUNC(HIDECONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_HIDE); // SW_HIDE
}

HB_FUNC(SHOWCONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd ==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_SHOW); // because 1'st time console stays minimized
ShowWindow(hwnd,SW_RESTORE); //SW_SHOW
SetFocus(hwnd);
SetForegroundWindow(hwnd);
}

HB_FUNC(SETCONSOLETITLE)
{ 
SetConsoleTitle( (char *) hb_parc(1) );
}

#pragma ENDDUMP

Code: Select all

******************************
*** COMPILADO EN HMG 3.4.0 ***
******************************

#include "hmg.ch"
#include "inkey.ch"

REQUEST HB_GT_WIN_DEFAULT

FUNCTION MAIN()

Public cons_hwnd:=GETCONSOLEWINDOW(), nLevel := 1, cEgg := "◌"

HideConsole(cons_hwnd)


SET WINDOW MAIN OFF
CreateScreenSplash ()
SET WINDOW MAIN ON

SET CODEPAGE TO UNICODE
SET CURSOR OFF

DEFINE WINDOW SNAKE AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,139,139} MAIN

DRAW RECTANGLE IN WINDOW SNAKE AT 45,195 TO 105,1028 PENCOLOR GREEN PENWIDTH 5 FILLCOLOR {112,128,144}
@ 50,200 LABEL L1 VALUE "J U E G O      L A      C U L E B R I T A" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 36 FONTCOLOR WHITE BOLD UNDERLINE TRANSPARENT
@150,125 LABEL L2 VALUE "- CON LA CULEBRITA, PASA POR ENCIMA DE CADA NÚMERO QUE APARECE EN PANTALLA, EMPIEZA CON EL #1 HASTA LLEGAR AL #9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@200,125 LABEL L3 VALUE "- DEBES SEGUIR EXTRICTAMENTE EL ORDEN SECUENCIAL 1-2-3-4-5-6-7-8-9  !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@250,125 LABEL L4 VALUE "- LA CULEBRITA CADA VEZ QUE AVANZA IRÁ CRECIENDO SU CUERPO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@300,125 LABEL L5 VALUE "- PUEDES AVANZAR HACIA CUALQUIER LADO (ARRIBA-ABAJO-DERECHA-IZQUIERDA), UTILIZA LAS FLECHAS DIRECCIONALES," WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@350,125 LABEL L6 VALUE "- SI VAS EN DIRECCIÓN CONTRARIA A LA QUE VAS, TE ELIMINARÁS Y PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@400,125 LABEL L7 VALUE "- SI CHOCAS CONTRA EL MARCO ROJO (LÍMITE DEL CAMPO DE JUEGO), PERDERÁS !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@450,125 LABEL L8 VALUE "- SI PASAS POR ENCIMA DE TU PROPIO CUERPO (COLA), PERDERÁS EL JUEGO !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT
@500,125 LABEL L9 VALUE "- SI QUIERES PAUSAR EL JUEGO, PARA RECONSIDERAR UNA ESTRATEGIA, PULSA ESCAPE !" WIDTH 999 HEIGHT 50 FONT "ARIAL" SIZE 14 BOLD FONTCOLOR WHITE TRANSPARENT

@575,600 BUTTON B1 CAPTION "J U G A R" FONT "ARIAL" SIZE 12 BOLD ONCLICK ENTRADA()

DEFINE PLAYER MUSIC
   ROW    0
   COL    0
   WIDTH  0
   HEIGHT 0
   FILE GetWindowsFolder() + "\Media\TOWN.MID"		// SONIDO DE FONDO PARA HACERLO AMIGABLE
END PLAYER

END WINDOW

DoMethod ( "SplashScreen", "HIDE" )

SNAKE.MUSIC.PLAY()
SNAKE.MAXIMIZE
SNAKE.ACTIVATE
RETURN


*-------------------------------------------------------------------------------------------*
PROCEDURE CreateScreenSplash ()
*-------------------------------------------------------------------------------------------*

   DEFINE WINDOW SplashScreen;
         AT 0,0;  
         WIDTH 400;
         HEIGHT 200;
         BACKCOLOR WHITE; 
         NOSYSMENU;
         NOSIZE;
         NOMINIMIZE;
         NOMAXIMIZE; 
         NOCAPTION ;
         CHILD

         SET WINDOW SplashScreen TRANSPARENT TO COLOR WHITE

         @   0,   0 LABEL Frame_1 VALUE "" WIDTH 400 HEIGHT 200 BACKCOLOR NAVY
         @  15,  15 LABEL Frame_2 VALUE "" WIDTH 370 HEIGHT 170 BACKCOLOR WHITE
                 
         @  45,  20 LABEL Label_1 VALUE "S N A K E" WIDTH 360 HEIGHT 60 TRANSPARENT FONT "Times New Roman" SIZE 36 FONTCOLOR NAVY CENTERALIGN 
         @ 105,  20 LABEL Label_2 VALUE "Loading ..." WIDTH 360 HEIGHT 60 TRANSPARENT FONT "Times New Roman" SIZE 36 FONTCOLOR NAVY CENTERALIGN 
         
   END WINDOW

SplashScreen.CENTER
SplashScreen.SHOW

 
RETURN


*---------------
FUNCTION ENTRADA
Local i, aCoordinates, FnNum, CnNum, lFound, cBrick := "◙"

SNAKE.HIDE

MessageBoxTimeout ("LA CULEBRITA NACE EN EL CENTRO DE LA PANTALLA"+CHR(13)+CHR(13)+" Y ESPERA QUE TÚ LE DES MOVIMIENTO"+CHR(13)+"PARA CUALQUIER LADO " + cEgg + " ...")

SNAKE.MUSIC.STOP

ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )

SETMODE(25,90)

SET COLO TO R/B
CLEA

DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )

SET COLO TO W+/B

aCoordinates := { { 12, 40 } }		//snake egg position
FOR i := 1 TO 9
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          IF Empty ( aCoordinates )
	       EXIT
          ELSE
               lFound := .F.
	       AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
               IF .Not. lFound
                    EXIT
               ENDIF
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )
      @ FnNum, CnNum SAY i PICT "9" COLO ("G+/N")	// MUESTRA LOS # ALEATORIAMENTE DENTRO DEL CUADRO
NEXT i

//nine bricks
FOR i := 1 TO 9 + ( nLevel - 1 ) * 3
     DO WHILE .T.
          FnNum := HB_RANDOMINT(1,23)
          CnNum := HB_RANDOMINT(1,78)
          lFound := .F.
	  AEval ( aCoordinates, { | x | IF ( x [ 1 ] == FnNum .And. x [ 2 ] == CnNum, lFound := .T., Nil ) } ) 
          IF .Not. lFound
               EXIT
          ENDIF
      ENDDO
      AAdd ( aCoordinates, { FnNum, CnNum } )

      @ FnNum, CnNum SAY cBrick COLO ("W+/B")	// Brick

NEXT i

DO JUGAR

RETURN

********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, nDirection := 0, nSpeed
Local cHead := "", cUp_Head := "▲", cDown_Head := "▼", cRight_Head := "►", cLeft_Head := "◄"
Local nSpeed_X := 0.2, nSpeed_Y := 0.35

@ 3,82 SAY " LEVEL "
@ 4,82 SAY PADC (AllTrim (Str ( nLevel ) ), 7 )
@ 5,82 SAY "-------"

@ 6,82 SAY "NÚMEROS"
@ 7,82 SAY "TAPADOS"
@ 8,82 SAY "======="

DO WHILE NEXTKEY() # 0 .OR. LASTKEY() # 0   //Reset last and next key buffer
     KEYBOARD CHR(0)
     INKEY(0.1)
     DO EVENTS
ENDDO

F := 12
C := 40

@ F,C SAY cEgg

X=0
INKEY(0)

DO WHILE .T.

DO CASE
   CASE lastkey() = K_RIGHT			// FLECHA A LA DERECHA

      DO CASE 
           CASE nDirection = K_UP				// PARA ARRIBA
               @ F,C SAY "╔"		//OK
           CASE nDirection = K_DOWN
               @ F,C SAY "╚"		//OK
           OTHER
               @ F,C SAY "═"		//OK
      ENDCASE
      nDirection := K_RIGHT
      cHead := cRight_Head
      C++
      nSpeed := nSpeed_X

   CASE lastkey() = K_LEFT		// FLECHA A LA IZQUIERDA

      DO CASE 
           CASE nDirection = K_UP				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE nDirection = K_DOWN
               @ F,C SAY "╝"		//OK
           OTHER
               @ F,C SAY "═"		//OK
      ENDCASE
      nDirection := K_LEFT
      cHead := cLeft_Head
      C--
      nSpeed := nSpeed_X

   CASE lastkey() = K_UP			// FLECHA ARRIBA

      DO CASE 
           CASE nDirection = K_RIGHT				// PARA ARRIBA
               @ F,C SAY "╝"		//OK
           CASE nDirection = K_LEFT
               @ F,C SAY "╚"		//OK
           OTHER
               @ F,C SAY "║"		//OK
      ENDCASE
      nDirection := K_UP
      cHead := cUp_Head
      F--
      nSpeed := nSpeed_Y

   CASE lastkey() = K_DOWN		// FLECHA ABAJO

      DO CASE 
           CASE nDirection = K_RIGHT				// PARA ARRIBA
               @ F,C SAY "╗"		//OK
           CASE nDirection = K_LEFT
               @ F,C SAY "╔"		//OK
           OTHER
               @ F,C SAY "║"		//OK
      ENDCASE
      nDirection := K_DOWN
      cHead := cDown_Head
      F++
      nSpeed := nSpeed_Y

   CASE lastkey() = K_ESC		// PAUSA EL JUEGO
      @ 24,28 SAY "UD HA PAUSADO EL JUEGO !"
      INKEY(0)
      @ 24,28 SAY "CONTINÚE EL JUEGO .... !"
      LOOP

   CASE lastkey() != K_RIGHT .OR. lastkey() != K_LEFT .OR. lastkey() != K_UP .OR. lastkey() != K_DOWN
      MsgStop ("SALIENDO DE LA CULEBRITA !")
      SNAKE.RELEASE
      QUIT

ENDCASE

cMessage := CheckCollision ( F /* nRow */ , C /* nCol */, @nNextGoal )

IF Empty ( cMessage )
     @ F,C SAY cHead
ELSE
     MessageBoxTimeout ( cMessage, "Snake" )
     EXIT
ENDIF

INKEY( Max ( nSpeed - (nLevel - 1) * .05, .03 ) )				// VELOCIDAD DEL JUEGO
  
ENDDO

IF MsgYesNo ( "¿Quieres jugar de nuevo?", "Snake" )
     ENTRADA()
ENDIF

SNAKE.RELEASE
QUIT

RETURN

********************************************************
FUNCTION CheckCollision ( nRow, nCol, nNextGoal )
Local cScrChar := GetCharFromScreen( nRow, nCol ), i

DO CASE
     CASE isDigit ( cScrChar )
          IF Val ( cScrChar ) == nNextGoal
               IF nNextGoal = 9
		    PLAY WAVE GetWindowsFolder() + "\Media\tada.wav"
                    @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
                    nLevel ++
		    RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
               ENDIF
               PLAY WAVE "X.wav"
               //PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
               @ nNextGoal+8,85 SAY ALLTRIM(STR(nNextGoal))
               nNextGoal ++
          ELSE
               PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
               RETURN "¡ESE NÚMERO NO ERA EL QUE SEGUÍA!"
          ENDIF

      CASE cScrChar $ hb_utf8ToStr ( cEgg + "═║╗╔╚╝", "EN" )
          PLAY WAVE GetWindowsFolder() + "\Media\chord.wav"
          @nRow, nCol SAY "♦" COLO ("R+/B")
          RETURN "LO SIENTO UD SE HA SUICIDADO !"

      CASE cScrChar = hb_utf8ToStr ( "█", "EN" )
	  PLAY WAVE GetWindowsFolder() + "\Media\ringout.wav"
          FOR i := 1 TO 99
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "Y+/B" )
               DispBox( 0,0,24,79, hb_utf8ToStr ( "█", "EN" ), "R/B" )
          NEXT i
          RETURN "SALIÓ DE LA PISTA DE JUEGO"+CHR(13)+CHR(13)+"HA PERDIDO !!!"
		
      CASE cScrChar <> " "
          PLAY WAVE GetWindowsFolder() + "\Media\chimes.wav"
          RETURN "Oh, no, no te golpees la cabeza contra la pared."
ENDCASE
RETURN ""

************************************************
FUNCTION GetCharFromScreen( nRow, nCol )
Local cChars
SET CODEPAGE TO ENGLISH
cChars := SaveScreen (nRow, nCol, nRow, nCol)
SET CODEPAGE TO UNICODE
RETURN Left ( cChars, 1 )


#pragma BEGINDUMP

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

// doesn't work with win32 function GetConsoleWindow()
HWND GetConWin()
{
HWND hwnd;
AllocConsole();
hwnd = FindWindowA("ConsoleWindowClass",NULL);
return hwnd;
}

HB_FUNC( GETCONSOLEWINDOW )
{
hb_retnl ((LONG_PTR) GetConWin());
}

HB_FUNC(HIDECONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_HIDE); // SW_HIDE
}

HB_FUNC(SHOWCONSOLE )
{
HWND hwnd;
hwnd = (HWND) hb_parnl (1);

if (hwnd ==NULL)
	hwnd = GetConWin();
ShowWindow(hwnd,SW_SHOW); // because 1'st time console stays minimized
ShowWindow(hwnd,SW_RESTORE); //SW_SHOW
SetFocus(hwnd);
SetForegroundWindow(hwnd);
}

HB_FUNC(SETCONSOLETITLE)
{ 
SetConsoleTitle( (char *) hb_parc(1) );
}

#pragma ENDDUMP