Same here!
Same here!
I guess "Goat" is too much!Rathinagiri wrote: ↑Wed Sep 04, 2024 5:18 am Wow. Hearty welcome the Goat Father of HMG!
So happy to see you again sir. How are you?
I guess "Goat" is too much!Rathinagiri wrote: ↑Wed Sep 04, 2024 5:18 am Wow. Hearty welcome the Goat Father of HMG!
So happy to see you again sir. How are you?
Hi Again!
Hi Again!
Code: Select all
hbcs=hbmxml.hbc
hbcs=hbssl.hbc
hbcs=hbziparc.hbc
or
Code: Select all
hbcs=hbmxml.hbc hbssl.hbc hbziparc.hbc
Code: Select all
hbcs=hbmxml.hbc
hbcs=hbssl.hbc
hbcs=hbziparc.hbc
or
Code: Select all
hbcs=hbmxml.hbc hbssl.hbc hbziparc.hbc
Code: Select all
dbcloseall()
RELEASE MEMORY
UnloadAllDll()
ExitProcess(0)
]]>Code: Select all
dbcloseall()
RELEASE MEMORY
UnloadAllDll()
ExitProcess(0)
]]>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
#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
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
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
msgdebug ( ShellExecute( Nil , "print" , '"' + cPdfFile + '"' , , Nil , Nil ) )
Application Internal Error - C:\hmg.3.4.4\1\HBTEL\HBTEL.exe
Terminated at: 2024-09-01 12:17:25
Nicht zu behebender Fehler 9201: hb_cdxPageKeyIntBalance: index corrupted.
Called from ORDFOR(0)
Called from SETDATAGRIDRECNO(2204) in source\h_grid.prg
Called from SETPROPERTY(7969) in source\h_controlmisc.prg
Called from ADDNEWREC(2497) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
Called from (b)MAIN(321) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
Called from _DOCONTROLEVENTPROCEDURE(6033) in source\h_windows.prg
Called from EVENTS(1794) in source\h_windows.prg
Called from DOMESSAGELOOP(0)
Called from _ACTIVATEWINDOW(5694) in source\h_windows.prg
Called from MAIN(404) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
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
Application Internal Error - C:\hmg.3.4.4\1\HBTEL\HBTEL.exe
Terminated at: 2024-09-01 12:17:25
Nicht zu behebender Fehler 9201: hb_cdxPageKeyIntBalance: index corrupted.
Called from ORDFOR(0)
Called from SETDATAGRIDRECNO(2204) in source\h_grid.prg
Called from SETPROPERTY(7969) in source\h_controlmisc.prg
Called from ADDNEWREC(2497) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
Called from (b)MAIN(321) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
Called from _DOCONTROLEVENTPROCEDURE(6033) in source\h_windows.prg
Called from EVENTS(1794) in source\h_windows.prg
Called from DOMESSAGELOOP(0)
Called from _ACTIVATEWINDOW(5694) in source\h_windows.prg
Called from MAIN(404) in C:\hmg.3.4.4\1\HBTEL\HBTEL.PRG
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
#translate TNR2STR( <cString> ) => Pad( StrTran ( <cString>, " " ), Len( <cString> )
If you use a UDF in an index key, other programs that do not contain the used UDF will not be able to retrieve the index key.]]>Code: Select all
#translate TNR2STR( <cString> ) => Pad( StrTran ( <cString>, " " ), Len( <cString> )
If you use a UDF in an index key, other programs that do not contain the used UDF will not be able to retrieve the index key.]]>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 Y ESPERA QUE TÚ LE DES MOVIMIENTO PARA CUALQUIER LADO")
ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )
SETMODE(25,80)
CLEA
SET COLO TO W+/B+
SNAKE.MUSIC.STOP // AQUÍ NO SÉ CÓMO DETENER EL SONIDO
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
//some 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
cBrick := "░"
ENDIF
IF i%2 = 0
cBrick := "▓"
ENDIF
IF i%3 = 0
cBrick := "▒"
ENDIF
@ FnNum, CnNum SAY cBrick COLO ("R+/N") // Brick
NEXT i
DO JUGAR
RETURN
********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, cDirection := "", nSpeed
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"
RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
ENDIF
PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
nNextGoal ++
ELSE
PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
RETURN "¡Orden equivocado!"
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()
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 Y ESPERA QUE TÚ LE DES MOVIMIENTO PARA CUALQUIER LADO")
ShowConsole(cons_hwnd)
SetConsoleTitle( "Snake" )
SETMODE(25,80)
CLEA
SET COLO TO W+/B+
SNAKE.MUSIC.STOP // AQUÍ NO SÉ CÓMO DETENER EL SONIDO
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
//some 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
cBrick := "░"
ENDIF
IF i%2 = 0
cBrick := "▓"
ENDIF
IF i%3 = 0
cBrick := "▒"
ENDIF
@ FnNum, CnNum SAY cBrick COLO ("R+/N") // Brick
NEXT i
DO JUGAR
RETURN
********************************
FUNCTION JUGAR
********************************
Local cScrChar, nNextGoal := 1, cMessage, F, C, cDirection := "", nSpeed
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"
RETURN "LO HA LOGRADO ! ... INTÉNTELO DE NUEVO !!!"
ENDIF
PLAY WAVE GetWindowsFolder() + "\Media\ding.wav"
nNextGoal ++
ELSE
PLAY WAVE GetWindowsFolder() + "\Media\notify.wav"
RETURN "¡Orden equivocado!"
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
]]>Attachments
Attachments
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
Attachments
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
Attachments
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
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
Attachments
Attachments