Estive ontem até às 5 da manhã a tentar resolver e não consegui.
Peço a vocês para que consigam resolver isto por favor.
É assim:
Tenho um programa que tem como objectivo registar os dias em que houve venda de senhas de almoço
Sendo assim tenho uma base de dados chamada SENHAS com os seguintes campos:
MARDES - numérico e de três posições: 1 se marcou esse dia como vendida a senha, 0 se esse dia ainda não foi marcado como venda e 2 se já imprimiu esse dia.
E DATAREFER=Data do dia em que foi marcada a venda.
As cores são:
Se MARDES=1 fundo branco com letras pretas
Se MARDES=0 fundo roxo com letras pretas
Se MARDES=2 fundo verde com letras pretas
Quando mando imprimir os dias que estão com MARDES=1 passam para MARDES=2 e fixa a cor verde
O Dia em que estamos será com fundo do calendário com dia amarelo.
Posteriormente farei isto com um número de processo do aluno.
Depois a pesquisa se o MARDES=1 será também testada qual foi o processo do aluno
Se digitar espaço ou seja caracter 32 então marca esse dia como um dia de venda da senha, se marcar outro dia o programa apresenta os dias que estão marcados para venda.
Farei uma rotina para impressão e é convertido os dias com MARDES=1 para MARDES=2
O Código é este:
Código: Selecionar todos
[procedure calendario
Local telaant,corant,;
getlist := {},;
wCursor
wCursor := SetCursor(0)
Private MMES,;
DT01,DT02,DT03,DT04,DT05,DT06,DT07,DT08,DT09,DT10,;
DT11,DT12,DT13,DT14,DT15,DT16,DT17,DT18,DT19,DT20,;
DT21,DT22,DT23,DT24,DT25,DT26,DT27,DT28,DT29,DT30,;
DT31,DT32,DT33,DT34,DT35,DT36,DT37,DT38,DT39,DT40,;
DT41,DT42,wlin,wcol,cursor,mm,dt,at,wteladata,col,;
lin,kont,kc,data,tcal,t,mensa,mes,kk,wUltima,NLINCOL,NLIN,NCOL,cor,mardes,ZZ
set date brit
set cent on
set epoch to 1970
use senhas
inde on datarefer to idata
wLin=row()
wCol=col()
MMES=' Janeiro FevereiroMar‡o Abril Maio Junho Julho Agosto Setembro Outubro Novembro Dezembro '
DT=date()
TELAANT=savescreen(6,0,24,79)
CORANT=setcolor()
setcolor('w+/br')
@ 06,21 say 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'
@ 07,21 say 'º º'
@ 08,21 say 'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹'
@ 09,21 say 'º Dom Seg Ter Qua Qui Sex Sab º'
@ 10,21 say 'º º'
@ 11,21 say 'º º'
@ 12,21 say 'º º'
@ 13,21 say 'º º'
@ 14,21 say 'º º'
@ 15,21 say 'º º'
@ 16,21 say 'º º'
@ 17,21 say 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'
*sombrear(6,21,17,57)
Mensagem('<'+chr(27)+chr(26)+'>Altera Mˆs, <> Altera Ano, <Ins> Procura Data e <Esc> p/ Sair',1)
TCAL=savescreen(6,21,18,59)
do whil .t.
restscreen(6,21,18,59,TCAL)
T=ltri(str(day(DT)))+' de '+rtri(subs(MMES,val(subs(dtoc(DT),4,2))*9,9))+' de '+ltri(str(year(DT)))+'.'
MENSA=T
setcolor('gr+/br')
@ 07,int((80-len(MENSA))/2) say MENSA
stor ' ' to DT01,DT02,DT03,DT04,DT05,DT06,DT07,DT08,DT09,DT10,DT11,DT12,DT13,DT14,DT15,DT16,DT17,DT18,DT19,DT20,DT21
stor ' ' to DT22,DT23,DT24,DT25,DT26,DT27,DT28,DT29,DT30,DT31,DT32,DT33,DT34,DT35,DT36,DT37,DT38,DT39,DT40,DT41,DT42
DATA=ctod('01/'+subs(dtoc(DT),4,7))
KONT=dow(DATA)
MES=month(DATA)
do whil month(DATA)=MES
KK=strzero(KONT,2)
cc=ltri(strzero(day(dt),2))
dd=ltri(subs(dtoc(dt),4,7))
ee=cc+'/'+dd
@ 1,1 say ee
ff=ctod(ee)
DT&KK.=str(day(DATA),2)
KONT=KONT+1
DATA=DATA+1
end
seek ff
IF found()
* replace mardes with 0
replace datarefer with ff
else
append blank
replace mardes with 0
replace datarefer with ff
endi
seek ff
a1=ltri(strzero(day(datarefer),2))
a2=ltri(subs(dtoc(datarefer),4,7))
a3=cc+'/'+a2
a4=ctod(a3)
@ 2,3 say a4
setcolor('n/br')
@ 11,24 say DT01
@ 11,29 say DT02
@ 11,34 say DT03
@ 11,39 say DT04
@ 11,44 say DT05
@ 11,49 say DT06
@ 11,54 say DT07
@ 12,24 say DT08
@ 12,29 say DT09
@ 12,34 say DT10
@ 12,39 say DT11
@ 12,44 say DT12
@ 12,49 say DT13
@ 12,54 say DT14
@ 13,24 say DT15
@ 13,29 say DT16
@ 13,34 say DT17
@ 13,39 say DT18
@ 13,44 say DT19
@ 13,49 say DT20
@ 13,54 say DT21
@ 14,24 say DT22
@ 14,29 say DT23
@ 14,34 say DT24
@ 14,39 say DT25
@ 14,44 say DT26
@ 14,49 say DT27
@ 14,54 say DT28
@ 15,24 say DT29
@ 15,29 say DT30
@ 15,34 say DT31
@ 15,39 say DT32
@ 15,44 say DT33
@ 15,49 say DT34
@ 15,54 say DT35
@ 16,24 say DT36
@ 16,29 say DT37
@ 16,34 say DT38
@ 16,39 say DT39
@ 16,44 say DT40
@ 16,49 say DT41
@ 16,54 say DT42
KONT=1
for LIN=11 to 16
for col=24 to 54 step 5
KC=strzero(KONT,2)
zz&kc.=str(day(DT),2)
if DT&KC.=str(day(DT),2)
setcolor('gr+/br')
@ LIN,COL say DT&KC.
setcolor('gr+/br')
if cc=a1 .AND. mardes=1
setcolor('n/w+*')
@ LIN,COL say dt&KC.
setcolor('n/w+*')
elseif mardes=0
ll=lin
cl=col
setcolor('gr+/br')
@ LIN,COL say dt&kc.
setcolor('gr+/br')
elseif mardes=2
*setcolor('gr+/g+')
*@ LIN,COL say DT&KC.
*setcolor('gr+/g+')
endif
endif
KONT=KONT+1
next
next
do whil ! str(inke(0),3)$' 27. 19. 4. 32. 22.'
end
wUltima=lastkey()
if wUltima=27
exit
end
if wUltima=19 && SETA P/ <-
if year(DT)=100 .and. mont(DT)=1
loop
endi
IF DT=date()
loop
ELSE
DT=DT-1
ENDIF
IF empt(dt)
wait "entrou no empt(dt)"
ENDIF
do whil empt(DT)
At=AT-1
DT=AT
DT=DT-(20+day(DT))
DT=ctod(subs(dtoc(AT),1,2)+subs(dtoc(DT),3,8))
end
elseif wUltima=4 && SETA P/ ->
if year(DT)=2999 .and. mont(DT)=12
loop
endi
DT=DT+1
elseif wUltima=32
go top
seek ff
if datarefer=ff .AND. mardes=1
replace mardes with 0
elseif datarefer=ff .AND. mardes=0
replace mardes with 1
endif
end
end
@ wLin,wCol say ''
set cent off
restscreen(6,0,24,79,TELAANT)
setcolor(CORANT)
SetCursor( wCursor )
set date amer
retu
*******
func M1
MEMVAR MM
if year(MM)<100 .or. year(MM)>2999
ERRO('Ano da data inv lido.')
retu(.f.)
endi
retu(.t.)
/*Funcao.....: Erro
Proposito..: Emitir uma mensagem de erro na linha 24
e fazer soar o alarme
Parametros.: Mensagem de Erro
Autor......: Walter Goldberg
*/
procedure erro
para wMensagem
priv wCorAnt, wTelaAnt
wCorAnt=setcolor()
setcolor("w+")
wMensagem=wMensagem+' - Tecle <Enter>'
wMensagem=stuff(spac(80),(80-len(wMensagem))/2+1,len(wMensagem),wMensagem)
wTelaAnt=savescreen(24,0,24,79)
set curs off
@ 24,0 say wMensagem
tone(527,1)
tone(727,1)
inke(0)
restscreen(24,0,24,79,wTelaAnt)
setcolor(wCorAnt)
set curs on
return
/*
Procedure......: Mensagem
Objetivo.......: Enviar mensagem para linha 24
Parametros.....: 1§ Mensagem a ser exibida
2§ Status
3§ Cor
Status.........: Status = 1
Exibe mensagem e retorna
Mensagem(Mensagem,1)
Status = 2
Exibe mensagem, da beep e retorna
Mensagem(Mensagem,2)
Status = 3
Exibe mensagem,da beep,espera ®Enter¯,apaga
Mensagem(Mensagem,3)
Status = 4
Apaga linha 24
Mensagem(" ",4)
Cor
Exemplo.: Mensagem('',4)
Mensagem('Arquivo n„o Existe Tecle <cr>',3,'w+/b')
Autor..........: Walter Goldberg
*/
/* ------------- Begin Mensagem Procedure --------------- */
Procedure Mensagem ( cMensagem,cStatus,cCor )
Local cCorAnt ,;
cEspacos := space(80),;
wSalvaLinha24,;
wCh
cCorAnt=setcolor()
*
* Define o status em funcao do parametro cStatus
*
if valtype( cStatus ) == "U"
cStatus = 3
end
*
* Define a Cor em funcao do parametro Cor
*
if valtype( cCor ) == "U"
cCor = "w+/br"
end
setcolor( cCor )
if (len(trim(cMensagem))=0)
setcolor( cCor )
@ 24,00 say cEspacos
setcolor( cCorAnt )
return
endif
cMensagem=stuff(cEspacos,(80-len(cMensagem))/2+1,len(cMensagem),cMensagem)
setcolor( cCor )
wSalvaLinha24 := SaveScreen( 24,0,24,79 )
@ 24,00 say cMensagem
do case
case ( cStatus=2)
BEEP()
case (cStatus=3)
BEEP()
Do While ( ( wCh := InKey( 0 ) ) != K_ENTER ) ; EndDo
SetColor( "N" )
RestScreen( 24,0,24,79,wSalvaLinha24 )
EndCase
setcolor ( cCorAnt )
return
/* -------------- End Mensagem Procedure ---------------- */
/*
Procedure......: Beep
Objetivo.......: Emitir um sinal sonoro
Parametros.....: Nenhum
Author.........: Walter Goldberg
*/
/* --------------- Begin Beep Procedure ----------------- */
Procedure Beep
tone(1001,1)
tone(1501,1)
tone(2001,1)
return
/* ---------------- End Beep Procedure ------------------ */
*]
Muito obrigado
Lapinhazzz
Nota de Moderação:
e depois copie o código que vai aparecer na janela que irá se abrir.
