Ola
Encontrei nos disquetes antigo um programa que fiz a muito tempo, acho que foi feito no xt 286
Compilei em harbour não e que funciona ainda (rs,rs)

Moderador: Moderadores
CASE local = 1
cart( 19, 1, 23, 8, "clara", CartaNaipe( A ), "x" )
cart( 9, ycol1, 13, ycol1 + 5, CartaSimbolo( A ), CartaNaipe( A ), "a" )
CASE local = 2
cart( 19, 10, 23, 17, "clara", CartaNaipe( B ), "x" )
cart( 9, ycol1, 13, ycol1 + 5, CartaSimbolo( B ), CartaNaipe( B ), "b" )
CASE local = 3
cart( 19, 19, 23, 26, "clara", CartaNaipe( C ), "x" )
cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( C ), CartaNaipe( D ), "c" )
CASE local = 4
cart( 19, 53, 23, 59, "clara", CartaNaipe( E ), "x" )
cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( E ), CartaNaipe( E ), "e" )
CASE local = 5
cart( 19, 62, 23, 68, "clara", CartaNaipe( F ), "x" )
cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( F ), CartaNaipe( F ), "f" )
CASE local = 6
cart( 19, 71, 23, 77, "clara", CartaNaipe( G ), "x" )
cart( 09, ycol1, 13, ycol1 + 5, CartaSimbolo( G ), CartaNaipe( G ), "g" )
ENDCASE
REQUEST HB_CODEPAGE_PTISO
FUNCTION Main()
PUBLIC pontoxc, pontoxh
Set( _SET_CODEPAGE, "PTISO" )
STATIC FUNCTION molduratest( xl, xc, xl2, xc2 )
@ xl, xc CLEAR TO xl2, xc2
@ xl, xc TO xl2, xc2
/*
LOCAL XCOR, XCOR1, XONDE, XONDE2, XC3, XA
xcor = SetColor()
xonde = ( At( "/", xcor ) + 1 )
xonde2 = ( At( ",", xcor ) - xonde )
xcor1 = subs( xcor, xonde, xonde2 ) + "+/" + SUBS( XCOR, XONDE )
xc3 = ( xc2 - 1 - xc )
SET COLOR TO ( XCOR1 )
@ xl, xc - 1 CLEAR TO xl2, xc2 + 1
@ xl, xc SAY "Ú" + replic( "Ä", xc3 )
xa = xl + 1
DO WHILE xa < xl2
@ xa, xc SAY "³ "
xa = xa + 1
ENDDO
IF subs( xcor, xonde, 1 ) = "N" .OR. subs( xcor1, xonde, 1 ) = "n"
XCOR1 = "W/" + SUBS( XCOR, XONDE )
ELSE
XCOR1 = "N/" + SUBS( XCOR, XONDE )
ENDIF
SET COLOR TO ( XCOR1 )
@ xl2, xc SAY "À" + replic( "Ä", xc3 ) + "Ù"
xa = xa - 1
DO WHILE xa > xl
@ xa, xc2 - 1 SAY " ³"
xa = xa - 1
ENDDO
@ xl, xc2 SAY "¿"
@ xl + 1, xc + 1 CLEAR TO xl2 - 1, xc2 - 1
SET COLOR TO ( xcor )
*/
RETURN NIL
STATIC FUNCTION DesenhaCarta( nTop, nLeft, cTipo, nNumeroCarta )
LOCAL aImagemList, cImagem, nBottom, nRight // cCorOld, nBottom, nRight
nBottom := nTop + 4
nRight := nLeft + 6
aImagemList := Directory( "imagem\*.jpg" )
aSort( aImagemList, , , { | a, b | a[ 1 ] < b[ 1 ] } )
IF nNumeroCarta == NIL .OR. nNumeroCarta < 1 .OR. nNumeroCarta > 52 .AND. cTipo == cTipo // so pra nao dar erro
cImagem := aImagemList[ 53, 1 ]
ELSE
cImagem := aImagemList[ nNumeroCarta, 1 ]
ENDIF
wvt_DrawImage( nTop, nLeft, nBottom, nRight, "imagem\" + cImagem )
/*
cCorOld = SetColor()
SET COLOR TO R/W
DO CASE
CASE cTipo == "escura"
molduratest( nTop, nLeft, nBottom, nRight )
FOR xlc = nTop + 1 TO nBottom - 1
@ xlc, nLeft + 1, xlc, nLeft + 5 BOX Replicate( Chr(176), 9 ) // SAY replicate( hb_UTFToStr( Chr(176) ), 5 ) // "±", 5 )
NEXT
CASE cTipo == "clara"
SET COLOR TO N/W
@ nTop, nLeft CLEAR TO nBottom, nRight
OTHERWISE
IF nTop < 10
IF cTipo = "e" .OR. cTipo = "f" .OR. cTipo = "g"
SET COLOR TO W+/R
@ nTop - 1, nLeft + 1 SAY "Hum."
ELSE
SET COLOR TO GR+/R
@ nTop - 1, nLeft + 1 SAY "Comp."
ENDIF
ENDIF
IF CartaNaipe( nNumeroCarta ) = 3 .OR. CartaNaipe( nNumeroCarta ) = 4
SET COLOR TO R/W
ELSE
SET COLOR TO N/W
ENDIF
molduratest( nTop, nLeft, nBottom, nRight )
@ nTop + 1, nLeft+ 1 SAY CartaSimbolo( nNumeroCarta )
@ nTop + 2, nLeft + 3 SAY Chr( CartaNaipe( nNumeroCarta ) )
@ nBottom - 1, nRight - 1 SAY CartaSimbolo( nNumeroCarta )
ENDCASE
// @ 3,0 say "va="+ltrim(str(va)) + " =" + ltrim(str(a)) && sete linhas para verifica‡Æo, retirar ap¢s teste
// @ 4,0 say "vb="+ltrim(str(vb)) + " =" + ltrim(str(b))
// @ 5,0 say "vc="+ltrim(str(vc)) + " =" + ltrim(str(c))
// @ 6,0 say "vd="+ltrim(str(vd)) + " =" + ltrim(str(d))
// @ 7,0 say "ve="+ltrim(str(ve)) + " =" + ltrim(str(e))
// @ 8,0 say "vf="+ltrim(str(vf)) + " =" + ltrim(str(f))
// @ 9,0 say "vg="+ltrim(str(vg)) + " =" + ltrim(str(g))
SET COLOR TO ( cCorOld )
*/
RETURN NIL
Usuários vendo este fórum: Nenhum usuário registrado online e 6 visitantes