PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

cores no harbour

https://pctoledo.org/viewtopic.php?t=13195

Página 1 de 2

cores no harbour

Enviado: 13 Jun 2012 00:33
por Abel
ola pessoal,
agora que consegui compilar meu sistema clipper procedural em harbour com a opcao -gui gostaria de saber se é possivel ampliar o leque de cores que havia disponivel no clipper, pois poderia melhorar o visual de mensagens e fundos de telas.

andei vendo uns exemplos, vi o comando RGB, mas nao consegui usa-lo.

#define RGB(r,g,b) ( r + ( g * 256 ) + ( b * 256 * 256 ) )
hb_gtinfo( hb_gti_palette, 02, rgb(000,096,180))

se alguem puder me dar umas dicas, agradeco.
ABEL

cores no harbour

Enviado: 13 Jun 2012 10:06
por Pablo César
No Clipper, sempre usei VGAPALETTE que é uma função da CT.LIB e a sua sintaxe é:

VGAPALETTE([<cColor|nColor>, [<nRedValue>,<nGreenValue>, <nBlueValue>]]) --> lValid

Ontem a noite a pedido de um colega, disponibilizei um exemplo compilado, veja em: https://pctoledo.org/forum/viewto ... TTE#p24394

Estou sem tempo de testar aqui, mas acredito que seja da mesma forma em Harbour da hbCT e senão procure também sobre HB_COLORTON ou talvez hb_gtColorToN()

cores no harbour

Enviado: 14 Jun 2012 11:54
por asimoes
Eu uso assim:

Código: Selecionar todos

FUNCTION Cores
LOCAL aPalette:=hb_gtInfo( HB_GTI_PALETTE )

   aPalette[ 8 ] := RGB( 211, 237, 250 )

   hb_gtInfo( HB_GTI_PALETTE, aPalette )

RETURN Nil

cores no harbour

Enviado: 14 Jun 2012 21:25
por Abel
asimoes, quais libs ou includes vc acrescenta
coloquei a sua funcao e deu erro de compilacao

undefined reference to "hb_fun_rgb"

Abel

cores no harbour

Enviado: 14 Jun 2012 21:45
por Abel
Pablo, gostei muito do seu exemplo, nem sabia q isso era possivel no antigo clipper, sempre usei as cores
padroes...rs rs rs

o outro EXE, o problema é que ele roda em tela cheia e meu sistema agora so vai rodar em janela mesmo.
tentei compilar em harbour mas da erro por causa da lib.

quanto ao comando hb_colorton() no harbour compila sem erros , mas nao consegui descobrir qual a sintaxe.
hb_gtcolorton() da erro de compilacao e nao descobri qual lib q tenho q acrescentar.

vc tem algum exemplo usando hb_colorton() ?

valeu,
ABEL

cores no harbour

Enviado: 15 Jun 2012 06:49
por asimoes
ABEL,

Segue função RGB:

Código: Selecionar todos

FUNCTION rgb( r,g,b )
   RETURN r + ( g * 256 ) + ( b * 256 * 256 )

cores no harbour

Enviado: 16 Jun 2012 10:09
por Abel
asimoes,
montei o codigo abaixo usando suas dicas, mas nao consegui fazer a barra mudar o tom,
se puder verificar o q esta errado, me avise..
desde ja agradeco.

Código: Selecionar todos

// COMPILADO COM HBMK2 CORGT -GUI -GTWVT   
//
// harbour nigthy 3.1

#include "hbgtinfo.ch"

REQUEST HB_GT_WVT_DEFAULT

FUNCTION MAIN()
CLEAR
SET COLOR TO R/W+*
P1=0
P2=0
P3=0
do while .t.
    CORES(P1,P2,P3)
    @ 1,1 SAY REPL("Û",80)
    @ 2,1 SAY 'R='+str(P1,3)+' tecla a '
    @ 3,1 SAY 'G='+str(P2,3)+' tecla b '
    @ 4,1 SAY 'B='+str(P3,3)+' tecla c '
    @ 24,0 SAY 'Pressione Q para encerrar ...'
    INKEY(0)

    //
    IF LASTKEY()=65 .or. LASTKEY()=97 // A
       P1++
    ELSEIF LASTKEY()=66 .OR. LASTKEY()=98 // B
       P2++
    ELSEIF LASTKEY()=67 .OR. LASTKEY()=99 // C
       P3++
    ELSEIF LASTKEY()=81 .OR. LASTKEY()=113 // Q
       QUIT
    ENDIF
enddo
RETURN


FUNCTION CORES(P1,P2,P3)
LOCAL aPalette:=hb_gtinfo( HB_GTI_PALETTE )

      aPalette[ 8 ]:= RGB( P1,P2,P3 )

      RN_T=HB_GTINFO( HB_GTI_PALETTE, aPalette )
      //
      rA_T="TESTE DE CORES"
      HB_GTINFO(HB_GTI_WINTITLE,rA_T)
      //
RETURN NIL

FUNCTION RGB( R,G,B )
RETURN R + ( G * 256 ) + ( B * 256 * 256 )

cores no harbour

Enviado: 16 Jun 2012 12:17
por Abel
achei o exemplo abaixo em um post,

alguem sabe dizer o que esta sendo definido quando coloca-se apalette[ 2 ], [ 4 ] , [ 8 ] , [ 10 ] , [ 13 ] ?

aPalette[01] := GetSysColor( COLOR_WINDOWTEXT ) // N Black
aPalette[02] := RGB( 0, 51, 153 )
aPalette[04] := RGB( 0, 255, 255 )
aPalette[08] := GetSysColor( COLOR_BTNFACE ) // W White
aPalette[10] := RGB( 100, 135, 220 )
aPalette[13] := RGB( 227, 92, 47 )

Abel

cores no harbour

Enviado: 16 Jun 2012 12:51
por asimoes
Abel,

Conforme sequencia abaixo veja que no vetor aPalette[ 8 ] corresponde a N+

No seu código experimente:

SET COLOR TO R/N+
P1=211
P2=237
P3=250

No seu código se quiser trocar as cores de R
SET COLOR TO R/W+*
aPalette[ 4 ]:=RGB(255,255,255) // O vermelho trocará para a cor branca.

Cores(P1,P2,P3)

B = 1
G = 2
BG = 3
R = 4
BR = 5
GR = 6
W = 7
N+ = 8
B+ = 9
G+ = 10
BG+= 11
R+ = 12
BR+= 13
GR+= 14
W+ = 15
N = 16

cores no harbour

Enviado: 16 Jun 2012 14:46
por Abel
asimoes, valeu pelas dicas, pois ja esta me dando o caminho a seguir ....
entendi inclusive que quando altero a palette, altera o tom de todas as telas sem necessidade de um @ say

so achei engraçado uma coisa, agora q entendi como funciona o esquema de cores.

pela sua tabela as minhas palettes nao funcionam corretamente.

B = 1 para mim é apalette [ 2 ]
G = 2 para mim é apalette [ 3 ] e assim por diante, a apalette [ 1 ] se refere a cor N
BG = 3
R = 4
BR = 5
GR = 6
W = 7
N+ = 8
B+ = 9
G+ = 10
BG+= 11
R+ = 12
BR+= 13
GR+= 14
W+ = 15
N = 16

outra coisa, tem como saber os codigo RGB das cores que sao padrao no clipper/harbour caso eu tenha necessidade de voltar ao tom de cor padrao ?

Abracos e valeu mesmo !!!

cores no harbour

Enviado: 16 Jun 2012 17:08
por asimoes
Abel,

É simples antes de trocar as cores, salve o palete com

aPaletteAntes:=hb_gtInfo( HB_GTI_PALETTE )

e para voltar:

hb_gtInfo( HB_GTI_PALETTE, aPaletteAntes )

cores no harbour

Enviado: 20 Jun 2012 02:24
por JoséQuintas
Compilei o fonte mais acima, com os parâmetros indicados pra hbmk2, mas fica sempre a mesma cor.
Isso vale para o Harbour oficial do site?

cores no harbour

Enviado: 21 Jun 2012 22:28
por Abel
Jose, vc incluiu o hbgtinfo.ch ?

outra coisa,
vc compilou com -gui -gtwvt ?

Abel

cores no harbour

Enviado: 22 Jun 2012 13:57
por JoséQuintas
Sim fiz isso, mas uso o harbour 3.1 do site. No fonte mostra Harbour nightly, não sei se faz diferença.

cores no harbour

Enviado: 22 Jun 2012 18:53
por asimoes
José esse exemplo que estou postando aqui, está funcionando, faça o teste:
Compile o exemplo com a função cores comentada, execute o programa veja as cores ou save a tela para comparar depois.
remova o comentário da chamada da função compile e veja a diferença.
Veja a 8ª coluna na segunda imagem:
Imagem
Imagem

scolor.hbp

Código: Selecionar todos

#---------------------------
# Nome do Execut vel
# ---------------------------
-oscolor
# ---------------------------
# Bibliotecas
# ---------------------------
-lhwgui
-lprocmisc
-lhbgt
-lgtwvg
-lgtwvt
-lhbct
-lhbwin
-lhbnf
-lxhb
-lhbblink
# ---------------------------
# Caminhos dos Includes
# ---------------------------
-incpath=D:\HARBOUR32\hwgui\include;
# ---------------------------
# Caminho da Lib HPROC 
# ---------------------------
-Ld:\HARBOUR32\hwgui\lib;
# ---------------------------
# Outros Parƒmetros
# ---------------------------
-gtgui
-workdir=.\OBJ\
-head=full
-n
-nowarn
-inc
-b
-dHARBOUR
#-icon=power2.ico
# ---------------------------
# Prg(s) e Rc(s)
# ---------------------------
scolor.prg
scolor.prg

Código: Selecionar todos

#include "inkey.ch"
#include "wvtwin.ch"
#include "hbcompat.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "dbinfo.ch"
#include "fileio.ch"
#include "hbdyn.ch"
#include "common.ch"

FUNCTION MAIN
PRIVATE cNome1:="", cNome2:="", cMens:={"",""}   
DO WHILE .T. 
   SET COLOR TO
   CLEAR
   @10,00 SAY "INICIAR"
   INKEY(0)
   IF LastKey() = 27
      EXIT
   ENDIF
   INICIAJANELA(00,00,40,110)
   //Cores()
   sColor()
   INICIAJANELA(00,00,24,80)
ENDDO
RETURN Nil

FUNCTION Cores
LOCAL aPalette:=hb_gtInfo( HB_GTI_PALETTE )

   aPalette[ 8 ] := RGB( 255, 0, 0 ) //Vermelho

   hb_gtInfo( HB_GTI_PALETTE, aPalette )

RETURN Nil

******************************************************************************
FUNCTION SColor
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : Configuracao de cores a serem usadas no sistema            *
* Observacao    :                                                            *
* Cores Padroes : CorS01W      -> frente das caixas dos menus                *
* =============   CorS02W      -> fundo das caixas dos menus                 *
*                 CorS03W      -> frente dos dados dos menus                 *
*                 CorS04W      -> fundo dos dados dos menus                  *
*                 CorS05W      -> frente da barra de selecao                 *
*                 CorS06W      -> fundo da barra de selecao                  *
*                 CorSSombraW  -> cor da sombra das caixas                   *
*                 CorSFundoW   -> fundo da tela padrao (reticula)            *
*                 CorSMoldW    -> moldura da tela padrao                     *
*                 CorSTitW     -> titulo do sistema e mensagens da linha 22  *
*                 CorSOldMW    -> cor dos menus anteriores                   *
*                 CorSBMoldW   -> moldura das caixas de entrada de dados     *
*                 CorSBTitW    -> titulo dos campos das entradas de dados    *
*                 CorSBEntW    -> cor da entrada de dados                    *
*                 CorSBCMoldW  -> moldura das caixas de consultas            *
*                 CorSBCDadoW  -> dados das caixas de consultas              *
*                 CorSBExDadoW -> display de confirmacao em caixa            *
*                 CorSExDadoW  -> display de confirmacao fora da caixa       *
* Sintaxe       : SColor()                                                   *
* Parametros    :                                                            *
* Retorno       : .T.                                                        *
* Fun. chamadas : Masc()                                                     *
*                 SetC()                                                     *
*                 Box()                                                      *
*                 GetColor()                                                 *
*                 COLORWIN()                                                 *
*                 ReSetC()                                                   *
* Arquivo fonte : SColor.prg                                                 *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

LOCAL nPosicao, nConta,;
      cTelaAnt := SaveScreen(0, 0, MaxRow(), MaxCol())

RESTORE FROM BCOR000.SYS ADDITIVE


CorS01W     := CorS01W 
CorS02W     := CorS02W
CorS03W     := CorS03W
CorS04W     := CorS04W
CorS05W     := CorS05W
CorS06W     := CorS06W

CorSSombraW := CorSSombra
CorSFundoW  := CorSFundoW
CorSMoldW   := CorSMoldW
CorSTitW    := CorSTitW
CorSOldMW   := CorSOldMW
CorSBMoldW  := CorSBMoldW
CorSBTitW   := CorSBTitW
CorSBEntW   := CorSBEntW
CorSBCMoldW := CorSBCMold
CorSBCDadoW := CorSBCDado
CorSBExDadoW:= CorSBExDad
CorSExDadoW := CorSExDado

//IF !Type(PRGV)=="U"
//ENDIF

SET COLOR TO &corsfundow

SET COLOR TO &corsmoldw

@03,53 TO 35,53

TecValidW := Chr(4) + Chr(19) + Chr(5) + Chr(24) + Chr(18) + Chr(3) + Chr(13)

SET COLOR TO N/W

@00,00 SAY PADC('* DEFINIۂO DE CORES PARA SISTEMAS *',MaxCol()+1) COLOR "R+/W*"

SET COLOR TO

SetC(0,1)

@02,02 TO 36,51 COLOR "+W"

nCol:=3
nLin:=4

FOR FundoW:=0 TO 15

    ColW := (FundoW * 3) + nCol

    FOR FrenteW:=0 TO 15

        CorW:=Transform(FrenteW,'99') + '/' + Transform(FundoW,'99')

        SET COLOR TO &CorW

        IF FrenteW = 0
           @nLin-1,ColW SAY '   '
        ENDIF

        LinW := (FrenteW * 2) + nLin

        @LinW,  ColW SAY '  '

        @LinW+1,ColW SAY '   '

    NEXT

NEXT

BoxNew(17,56,21,MaxCol()-2,CorSBCMoldW)

BoxNew(05,56,07,MaxCol()-2,CorSBCMoldW)

SET COLOR TO &CorSBCDadoW

@18,57 SAY ' SETAS       - Alterar padrÆo de cor    '

@19,57 SAY ' Pg Up/Pg Dn - Op‡äes                   '

@20,57 SAY ' ENTER       - Real‡ado / ESC - Termina '

SET COLOR TO

TelaCorW = SaveScreen(00,00,MaxRow(),54)

TelaAuxW = SaveScreen(00,60,MaxRow()-1,MaxCol())

LinW := 00

ColW := 00

OpW  := 1

IniW := .T.

Keyboard Chr(5)+Chr(24)

DO WHILE .T.

   DO CASE
   CASE (OpW > 0 .AND. OpW < 6) .OR. OpW = 8
        ExibeCaixa()
   CASE OpW = 6 .OR. OpW = 7
        ExibeTit()
   CASE OpW = 9 .OR. OpW = 10 .OR. OpW = 11
        ExibeGet()
   CASE OpW = 12 .OR. OpW = 13
        ExibeCons()
   CASE OpW = 14
        ExibeMensC()
   CASE OpW = 15
        ExibeMens()
   ENDCASE

   IF '+' $ GetColor(LinW+1,ColW+1)
      SET COLOR TO N*/W
      @10,56 SAY ' REALCADO '
      SET COLOR TO
   ELSE
      SET COLOR TO &CorSFundoW
      @10,56 SAY Space(9) //'°°°°°°°°°°'
      SET COLOR TO
   ENDIF

   Inkey(0)

   IF LastKey() = 27
   
      IF MsgNaoSim("Salvar Altera‡äes?", "Aten‡Æo")
      
         SET COLOR TO
         CLEAR
    
         nPosicao    := At(',',CorSBCDadoW)
    
         IF nPosicao > 0
            CorSBCDadoW := Left(CorSBCDadoW,nPosicao - 1)
         ENDIF
    
         cCorAux     := SubStr(CorSBCDadoW, At('/', CorSBCDadoW))
         CorSBCDadoW := CorSBCDadoW + ',n/w'
         CorSBrowseW := CorSBCDadoW + ',,' + CorSBCMoldW + ',r+' + cCorAux
          
         fErase("bcor000.ini")
         
         StrFile("CorS01W="     +'"'+CorS01W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorS02W="     +'"'+CorS02W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorS03W="     +'"'+CorS03W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorS04W="     +'"'+CorS04W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorS05W="     +'"'+CorS05W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorS06W="     +'"'+CorS06W     +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSSombraW=" +'"'+CorSSombraW +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSFundoW="  +'"'+CorSFundoW  +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSMoldW="   +'"'+CorSMoldW   +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSTitW="    +'"'+CorSTitW    +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSOldMW="   +'"'+CorSOldMW   +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBMoldW="  +'"'+CorSBMoldW  +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBTitW="   +'"'+CorSBTitW   +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBEntW="   +'"'+CorSBEntW   +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBCMoldW=" +'"'+CorSBCMoldW +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBCDadoW=" +'"'+CorSBCDadoW +'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSBExDadoW="+'"'+CorSBExDadoW+'"'+HB_EOL(),"bcor000.ini",.T.)
         StrFile("CorSExDadoW=" +'"'+CorSExDadoW +'"'+HB_EOL(),"bcor000.ini",.T.)
    
         SAVE ALL LIKE CorS* TO BCOR000.SYS
      ENDIF
      EXIT 
   ENDIF

   IF ! Chr(LastKey()) $ TecValidW
      LOOP
   ENDIF

   IF LastKey() = 18 .AND. OpW > 1
      IniW:=.T.
      OpW--
      LOOP
   ENDIF

   IF LastKey() = 3 .AND. OpW < 15
      IniW:=.T.
      OpW++
      LOOP
   ENDIF

   IF LastKey() <> 13
      RestScreen(00,00,MaxRow(),54,TelaCorW)
   ENDIF

   DO CASE
   CASE LastKey() = 19  .AND. ColW > 3
        ColW := ColW - 3
   CASE LastKey() = 4  .AND. ColW < 48
        ColW := ColW + 3
   CASE LastKey() = 5  .AND. LinW > 3
        LinW := LinW - 2
   CASE LastKey() = 24 .AND. LinW < 33
        LinW := LinW + 2
   ENDCASE

   
   CorW   := GetColor(LinW+1,ColW+1)

   //@MaxRow()-1,00 CLEAR TO MaxRow(),MaxCol()
   //@MaxRow()-1,00 SAY corw
   //@MaxRow()  ,00 SAY LinW
   //@MaxRow()  ,Col()+2 SAY ColW
   
   IF ColW >= 27   
      CorW   := StrTran(CorW,"+","*")
      IF LinW >= 19
         PosW  := At('*',CorW)
         CorW  = '+'+SubStr(CorW,PosW+1)
      ENDIF
   ENDIF

   @MaxRow(),00 SAY PADR(" Cor: "+CorW,MaxCol()+1) COLOR "B/W*"
   
   PosW   := At('/',CorW)

   CorFrW := Left(CorW,PosW - 1)

   CorFuW := SubStr(CorW,PosW + 1)

   IF LastKey() = 13

      IF ! '+' $ CorW
         CorFrW := '+' + CorFrW
      ELSE
         CorFrW := SubStr(CorFrW,2)
      ENDIF

      CorW := CorFrW + '/' + CorFuW
      
      COLORWIN(LinW+1,ColW+1,LinW+1,ColW+1,CorW)

   ENDIF

   PosW  := At('/',CorW)
   
   CorAW := CorW
   
   IF ColW < 47
      CorW  = 'W+' + SubStr(CorW,PosW)
   ELSE
      CorW  = 'R+' + SubStr(CorW,PosW)
   ENDIF

   SET COLOR TO &CorW
   
   @LinW,ColW TO LinW + 2, ColW + 2 color CorW

   DO CASE
      CASE OpW = 1
           CorS01W      :=Left(CorAW,PosW-1)
           CorS02W      :=SubStr(CorAW,PosW+1)
      CASE OpW = 2
           CorS03W      :=Left(CorAW,PosW-1)
           CorS04W      :=SubStr(CorAW,PosW+1)
      CASE OpW = 3
           CorS05W      :=Left(CorAW,PosW-1)
           CorS06W      :=SubStr(CorAW,PosW+1)
      CASE OpW = 4
           CorSSombraW  :=CorAW
      CASE OpW = 5
           CorSFundoW   :=CorAW
      CASE OpW = 6
           CorSMoldW    :=CorAW
      CASE OpW = 7
           CorSTitW     :=CorAW
      CASE OpW = 8
           CorSOldMW    :=CorAW
      CASE OpW = 9
           CorSBMoldW   :=CorAW
      CASE OpW = 10
           CorSBTitW    :=CorAW
      CASE OpW = 11
           CorSBEntW    :=CorAW
      CASE OpW = 12
           CorSBCMoldW  :=CorAW
      CASE OpW = 13
           CorSBCDadoW  :=CorAW
      CASE OpW = 14
           CorSBExDadoW :=CorAW
      CASE OpW = 15
           CorSExDadoW  :=CorAW
   ENDCASE

ENDDO

ResetC()

RESTSCREEN(0, 0, MaxRow(), MaxCol(), cTelaAnt)

RETURN Nil

FUNCTION InformaCor

   CorW   := GetColor(LinW+1,ColW+1)

   IF ColW >= 27   
      CorW   := StrTran(CorW,"+","*")
      IF LinW >= 19
         PosW  := At('*',CorW)
         CorW  = '+'+SubStr(CorW,PosW+1)
      ENDIF
   ENDIF

   @MaxRow(),00 SAY PADR(" Cor: "+CorW,MaxCol()+1) COLOR "B/W*"

RETURN Nil

*
FUNCTION VerCor(A,B)
*
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : verifica cor atual do ponto indicado                       *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

CorAtuW := GetColor(A,B)

TeclaW := LastKey()

IF TeclaW = 19 .OR. TeclaW = 4 .OR. TeclaW = 5 .OR. TeclaW = 24
   RETURN .T.
ENDIF

PosAtuW := At('/',CorAtuW)

CorFrW  := Left(CorAtuW,  PosAtuW - 1)

CorFuW  := SubStr(CorAtuW,PosAtuW + 1)

IF '+' $ CorFrW
   //CorFrW:=SubStr(CorFrW,2)
   HW:=.T.
ELSE
   HW:=.F.
ENDIF

nLin:=3

DO CASE
   CASE upper(CorFrW) == 'N'
        LinW:= nLin
   CASE upper(CorFrW) == 'B'
        LinW:= nLin+2
   CASE upper(CorFrW) == 'G'
        LinW:= nLin+4
   CASE upper(CorFrW) == 'BG'
        LinW:= nLin+6 
   CASE upper(CorFrW) == 'R'
        LinW:= nLin+8 
   CASE upper(CorFrW) == 'RB'
        LinW:= nLin+10
   CASE upper(CorFrW) == 'GR'
        LinW:= nLin+12
   CASE upper(CorFrW) == 'W'
        LinW:= nLin+14
   CASE upper(CorFrW) == '+N'
        CorFrW:="*N"
        LinW  := nLin+16
   CASE upper(CorFrW) == '+B'
        CorFrW:="*B"
        LinW  := nLin+18
   CASE upper(CorFrW) == '+G'
        CorFrW:="*G"
        LinW  := nLin+20
   CASE upper(CorFrW) == '+BG'
        CorFrW:='*BG'
        LinW  := nLin+22
   CASE upper(CorFrW) == '+R'
        CorFrW:='*R'
        LinW  := nLin+24
   CASE upper(CorFrW) == '+RB'
        CorFrW:='*RB'
        LinW  := nLin+26
   CASE upper(CorFrW) == '+GR'
        CorFrW:='*GR'
        LinW  := nLin+28
   CASE upper(CorFrW) == '+W'
        CorFrW:='*W'
        LinW  := nLin+30
ENDCASE

nCol:=3

DO CASE
   CASE upper(CorFuW) == 'N'
        ColW := nCol * 1
   CASE upper(CorFuW) == 'B'
        ColW := nCol * 2
   CASE upper(CorFuW) == 'G'
        ColW := nCol * 3
   CASE upper(CorFuW) == 'BG'
        ColW := nCol * 4
   CASE upper(CorFuW) == 'R'
        ColW := nCol * 5
   CASE upper(CorFuW) == 'RB'
        ColW := nCol * 6
   CASE upper(CorFuW) == 'GR'
        ColW := nCol * 7
   CASE upper(CorFuW) == 'W'
        ColW := nCol * 8
   CASE upper(CorFuW) == '+N'
        CorFuW:='*N'
        ColW  := nCol * 9
   CASE upper(CorFuW) == '+B'
        CorFuW:='*B'
        ColW  := nCol * 10
   CASE upper(CorFuW) == '+G'
        CorFuW:='*G'
        ColW  := nCol * 11
   CASE upper(CorFuW) == '+BG'
        CorFuW:='*BG'
        ColW  := nCol * 12
   CASE upper(CorFuW) == '+R'
        CorFuW:='*R'
        ColW  := nCol * 13
   CASE upper(CorFuW) == '+RB'
        CorFuW:='*RB'
        ColW  := nCol * 14
   CASE upper(CorFuW) == '+GR'
        CorFuW:='*GR'
        ColW  := nCol * 15
   CASE upper(CorFuW) == '+W'
        CorFuW:='*W'
        ColW  := nCol * 16
ENDCASE

IF LastKey() <> 13
   RestScreen(00,00,MaxRow(),54,TelaCorW)
   SET COLOR TO W+/&CorFuW
   @LinW,ColW TO LinW + 2, ColW + 2
   SET COLOR TO
ENDIF

IF HW
   COLORWIN(LinW+1,ColW+1,LinW+1,ColW+1,'+' + CorFrW + '/' + CorFuW)
ENDIF

RETURN .T.
*
**********************
PROCEDURE ExibeCaixa
**********************
*
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : seleciona a cor da caixa                                   *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

COLORWIN(09,66,16,95,CorSFundoW)

SET COLOR TO &CorS01W/&CorS02W

@10,70 TO 14,91

SET COLOR TO &CorS03W/&CorS04W

@11,71 CLEAR TO 13,90

@11,71 SAY '   DADOS  / MENU    '

SET COLOR TO &CorS05W/&CorS06W

@12,71 SAY '  BARRA DE SELEۂO  '

SET COLOR TO &CorS03W/&CorS04W

@13,71 SAY '   DADOS  / MENU    '

COLORWIN(15,72,15,93,CorSSombraW)

COLORWIN(11,92,15,93,CorSSombraW)

DO CASE
   CASE OpW = 1
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'MOLDURA DAS CAIXAS'
        SET COLOR TO W+*
        @10,68 SAY chr(26)
        SET COLOR TO
        VerCor(10,72)
   CASE OpW = 2
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'DADOS DA CAIXA'
        SET COLOR TO W+*
        @13,88 SAY chr(27)
        SET COLOR TO
        VerCor(11,71)
   CASE OpW = 3
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'COR DA BARRA DE SELEۂO'
        SET COLOR TO W+*
        @11,90 SAY chr(25)
        SET COLOR TO
        VerCor(12,71)
   CASE OpW = 4
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'COR DA SOMBRA'
        SET COLOR TO W+*
        @16,80 SAY chr(24)
        SET COLOR TO
        VerCor(15,72)
   CASE OpW = 5
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'COR DO FUNDO'
        SET COLOR TO W+*
        @16,96 SAY chr(27)
        SET COLOR TO
        VerCor(16,66)
   CASE OpW = 8
        COLORWIN(10,70,14,91,CorSOldMW)
        COLORWIN(12,71,12,90,'n/w')
        SET COLOR TO &CorSBCDadoW
        @06,58 SAY 'COR DOS MENUS ANTERIORES'
        SET COLOR TO W+*
        @12,93 SAY chr(27)
        SET COLOR TO
        VerCor(10,70)
ENDCASE

RETURN Nil
*
*********************
PROCEDURE ExibeCons
*********************
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : exibe a tela de consulta                                   *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************
RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

SET COLOR TO &CorSBCMoldW

@10,70 TO 14,91

SET COLOR TO &CorSBCDadoW

@11,71 CLEAR TO 13,90

@11,71 SAY '       DADOS   '

@12,71 SAY '       DADOS   '

@13,71 SAY '       DADOS   '

SET COLOR TO

COLORWIN(15,72,15,93,CorSSombraW)

COLORWIN(11,92,15,93,CorSSombraW)

DO CASE
CASE OpW = 12
     SET COLOR TO &CorSBCDadoW
     @06,58 SAY 'MOLDURA DAS CAIXAS DE CONSULTA'
     SET COLOR TO W+*
     @10,68 SAY chr(26)
     SET COLOR TO
     VerCor(10,72)
CASE OpW = 13
     SET COLOR TO &CorSBCDadoW
     @06,58 SAY 'DADOS DAS CAIXAS'
     SET COLOR TO W+*
     @12,71 SAY chr(26)
     SET COLOR TO
     VerCor(12,72)
ENDCASE

RETURN Nil
*
*******************
PROCEDURE ExibeGet
*******************
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : cor da entrada de dados                                    *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

SET COLOR TO &CorSBMoldW

@10,70 TO 14,91

SET COLOR TO &CorSBTitW

@11,71 CLEAR TO 13,90

@11,71 SAY ' Campo 1 : '

@12,71 SAY ' Campo 2 : '

@13,71 SAY ' Campo 3 : '

SET COLOR TO &CorSBEntW

@11,83 SAY 'DADO 1'

@12,83 SAY 'DADO 2'

@13,83 SAY 'DADO 3'

SET COLOR TO

DO CASE
   CASE OpW = 9
        set color to &CorSBCDadoW
        @06,58 SAY 'MOLDURA DAS CAIXAS DE ENTRADA DE DADOS'
        set color to w+*
        @10,68 SAY chr(26)
        set color to
        VerCor(10,72)
   CASE OpW = 10
        set color to &CorSBCDadoW
        @06,58 SAY 'TITULO DO CAMPOS'
        set color to w+*
        @12,71 SAY chr(26)
        set color to
        VerCor(12,72)
   CASE OpW = 11
        set color to &CorSBCDadoW
        @06,58 SAY 'ENTRADA DE DADOS'
        set color to w+*
        @13,90 SAY chr(27)
        set color to
        VerCor(13,87)
ENDCASE

RETURN Nil
*
**********************
PROCEDURE ExibeMens
**********************
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : display de confirmacao do dado digitado                    *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

SET COLOR TO &CorSExDadoW

@ 12,76 SAY ' DESCRIۂO '

SET COLOR TO

SET COLOR TO &CorSBCDadoW

@06,58 SAY 'DESC. DO DADO DIGITADO (FORA DA CAIXA)'

SET COLOR TO w+*

@12,74 SAY chr(26)

SET COLOR TO

VerCor(12,76)

RETURN Nil
*
***********************
PROCEDURE ExibeMensC
***********************
*
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : exibe mensagem dentro das caixas                           *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

SET COLOR TO &CorSBMoldW

@10,70 TO 14,91

SET COLOR TO &CorSBTitW

@11,71 CLEAR TO 13,90

@11,71 SAY ' Campo 1 : '

@12,71 SAY ' Campo 2 : '

@13,71 SAY ' Campo 3 : '

set color to &CorSBExDadoW

@11,83 SAY 'DADO 1'

@12,83 SAY 'DADO 2'

@13,83 SAY 'DADO 3'

SET COLOR TO

COLORWIN(15,72,15,93,CorSSombraW)

COLORWIN(11,92,15,93,CorSSombraW)

SET COLOR TO &CorSBCDadoW

@06,58 SAY 'DESCRIۂO DO DADO DIGITADO  (NA CAIXA)'

SET COLOR TO w+*

@13,90 SAY chr(27)

SET COLOR TO

VerCor(13,87)

RETURN Nil
*
*********************
PROCEDURE ExibeTit
*********************
*
******************************************************************************
* Autor         : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Objetivo      : exibe o titulo selecionado                                 *
* Funcionamento : chamada pela procedure scolor()                            *
* Parametro(s)  :                                                            *
* Chamada       :                                                            *
******************************************************************************

RestScreen(00,60,MaxRow()-1,MaxCol(),TelaAuxW)

SET COLOR TO &CorSMoldW

@11,70 TO 14,91 DOUBLE

SET COLOR TO &CorSTitW

@12,71 CLEAR TO 13,90

@12,71 SAY ' TITULO DO SISTEMA  '

@13,71 SAY ' LINHA DE MENSAGEM  '

DO CASE
CASE OpW = 6
     SET COLOR TO &CorSBCDadoW
     @06,58 SAY 'MOLDURA DA TELA PRINCIPAL'
     SET COLOR TO w+*
     @11,68 SAY chr(26)
     SET COLOR TO
     VerCor(11,72)
CASE OpW = 7
     SET COLOR TO &CorSBCDadoW
     @06,58 SAY 'TITULO DO SISTEMA E LINHA DE MENSAGEM'
     SET COLOR TO W+*
     @12,90 SAY chr(27)
     SET COLOR TO
     VerCor(13,71)
ENDCASE

RETURN Nil
*
*---------------------------------------------------------------------------*
*---------------------------------------------------------------------------*


FUNCTION MsgNaoSim(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgNoYes(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION MsgSimNao(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgYesNo(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION MsgSimNaoCancela(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgYesNoCancel(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION Info(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgInfo(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION Pare(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgStop(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION Exclama(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN MsgExclamation(HB_OemToAnsi(cMensagem),Hb_OemToAnsi(cTitulo))

FUNCTION MsgOkCancela(cMensagem,cAviso)
DEFAULT cMensagem TO "",;
        cAviso    TO "Aviso do Sistema"
RETURN MsgOkCancel(HB_OemToAnsi(cMensagem),HB_OemToAnsi(cAviso))


******************************************************************************
STATIC FUNCTION GetColor
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          :                                                            *
*----------------------------------------------------------------------------*
* Objetivo      : Retorna a cor de uma posicao da tela                       *
* Observacao    :                                                            *
* Sintaxe       : GetColor(nLin, nCol)                                       *
* Parametros    : <nLin> - Numero da linha na tela                           *
*                 <nCol> - Numero da coluna na tela                          *
* Retorno       : <cCor> - String de cor da posicao da tela informada        *
* Fun. chamadas :                                                            *
* Arquivo fonte : GetColor()                                                 *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

Parameters nLin, nCol
Private cPosicao

cPosicao = SaveScreen(nLin,nCol,nLin,nCol)

RETURN HexCor(DecHex(Asc(SubStr(cPosicao,2,1))))

******************************************************************************
STATIC FUNCTION DecHex
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          :                                                            *
*----------------------------------------------------------------------------*
* Objetivo      : Converte decimal para hexa                                 *
* Observacao    :                                                            *
* Sintaxe       : DecHex(nNumero)                                            *
* Parametros    : <nNumero> - Numero decimal                                 *
* Retorno       : <cNumero> - Numero hexadecimal                             *
* Fun. chamadas :                                                            *
* Arquivo fonte : GetColor.prg                                               *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

Parameters nNumero
Private nInt, nDec, cInt, cDec

nInt = Int(nNumero / 16)
nDec = (nNumero / 16) - nInt
nDec = nDec * 16

cInt = IF(nInt < 10,str(nInt,1),chr(55 + nInt))
cDec = IF(nDec < 10,str(nDec,1),chr(55 + nDec))

RETURN cInt + cDec

******************************************************************************
STATIC FUNCTION HexCor
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          :                                                            *
*----------------------------------------------------------------------------*
* Objetivo      : Converte valor hexa para string de cor                     *
* Observacao    :                                                            *
* Sintaxe       : HexCor(cNumero)                                            *
* Parametros    : <cNumero> - Numero hexadecimal                             *
* Retorno       : <cCor> - String de cor                                     *
* Fun. chamadas :                                                            *
* Arquivo fonte :                                                            *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

Parameters cNumero
Private cBac, cFor, cCor

cFor = right(cNumero,1)
cBac = Left(cNumero ,1)

RETURN ConvCor(cFor) + '/' + ConvCor(cBac)

******************************************************************************
STATIC FUNCTION ConvCor
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          :                                                            *
*----------------------------------------------------------------------------*
* Objetivo      : Acha as cores para um determinda valor                     *
* Observacao    :                                                            *
* Sintaxe       : ConvCor(cVal)                                              *
* Parametros    : <cVal> - Valor da cor                                      *
* Retorno       : <cCor> - Cor                                               *
* Fun. chamadas :                                                            *
* Arquivo fonte : GetColor()                                                 *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

Parameters cVal
Private cDec, nVal, cCor, nDec

nVal = val(cVal)
nDec = IF(nVal <> 0 .OR. cVal = '0',nVal,asc(cVal) - 55)

DO CASE

   CASE nDec = 0
        cCor = 'n'
   CASE nDec = 1
        cCor = 'b'
   CASE nDec = 2
        cCor = 'g'
   CASE nDec = 3
        cCor = 'bg'
   CASE nDec = 4
        cCor = 'r'
   CASE nDec = 5
        cCor = 'rb'
   CASE nDec = 6
        cCor = 'gr'
   CASE nDec = 7
        cCor = 'w'
   CASE nDec = 8
        cCor = '+n'
   CASE nDec = 9
        cCor = '+b'
   CASE nDec = 10
        cCor = '+g'
   CASE nDec = 11
        cCor = '+bg'
   CASE nDec = 12
        cCor = '+r'
   CASE nDec = 13
        cCor = '+rb'
   CASE nDec = 14
        cCor = '+gr'
   CASE nDec = 15
        cCor = '+w'
ENDCASE

RETURN cCor

******************************************************************************
FUNCTION BoxNew
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Ojetivo       : Exibicao de caixa com simulacao de sombra e explosao       *
*                 movimentada                                                *
* Observacao    :                                                            *
* Sintaxe       : BoxNew(nLl,nCI,nLF,nCF,[cCor], [lMold])                       *
* Parametros    : <nLI>   - Linha Inicial                                    *
*                 <nCI>   - Coluna Inicial                                   *
*                 <nLF>   - Linha Final                                      *
*                 <nCF>   - Coluna Final                                     *
*                 <cCor>  - Cor (OPCIONAL)                                   *
*                 <lMold> - .T. para moldura dupla e .F. para simples        *
*                           (DEFAULT: .F.)                                   *
* Retorno       : .T.                                                        *
* Fun. chamadas : COLORWIN()                                                 *
* Arquivo fonte : Box.prg                                                    *
* Arq. de dados :                                                            *
* Veja tamb‚m   :                                                            *
******************************************************************************

*---------------------------------------------------------------------------*
Parameters li, ci, lf, cf, Co, Mo
*---------------------------------------------------------------------------*

DEFAULT Mo to .F.

save screen to TelaTempW

CAuxW  = setcolor()

if type('TESTATEMPOW') <> 'N'
   public TestaTempoW
   TestaTempoW = 70
endif

if type('LQIW') <> 'N' .or. type('LQFW') <> 'N' .or. type('CQIW') <> 'N' .or. type('CQFW') <> 'N'
   public LQIW, LQFW, CQIW, CQFW
   LQIW  = 0
   LQFW  = 0
   CQIW  = 0
   CQFW  = 0
endif

if LQIW <> Li .or. LQFW <> Lf .or. CQIW <> Ci .or. CQFW <> Cf

   do case
      case TestaTempoW <= 70
           FatorW = 4
      case TestaTempoW <= 120
           FatorW = 3
      case TestaTempoW <= 180
           FatorW = 2
      otherwise
           FatorW = 1
   endcase

   LQIW  = int((Li + Lf) / 2)
   CQIW  = int((Ci + Cf) / 2)
   LQFW  = LQIW
   CQFW  = CQIW
   LQIAW = LQIW
   LQFAW = LQFW

   if Co = NIL
      set color to &CorS03W/&CorS04W,&CorS05W/&CorS06W
   else
      set color to &Co
  endif

   do while .T.

      if Mo
         @LQIAW,CQIW to LQFAW,CQFW double
      else
         @LQIAW,CQIW to LQFAW,CQFW
      endif

      @LQIAW,CQIW clear to LQFAW,CQFW

      if LQIAW > Li
         LQIW  = LQIW - (0.2 * FatorW)
         LQIAW = int(LQIW)
      endif

      if LQFW < Lf
         LQFW  = LQFW + (0.2 * FatorW)
         LQFAW = int(LQFW)
      endif

      if CQIW > Ci
         CQIW = CQIW - FatorW
      endif

      if CQFW < Cf
         CQFW = CQFW + FatorW
      endif

      if LQIAW <= Li .and. LQFAW >= Lf .and. CQIW <= Ci .and. CQFW >= Cf
         exit
      endif

   enddo

endif

restore screen from TelaTempW

if Co = NIL
   set color to &CorS03W/&CorS04W,&CorS05W/&CorS06W
else
   set color to &Co
endif

@li,ci clear to lf,cf

if Co = NIL
   set color to &CorS01W/&CorS02W
endif

if Mo
   @li,ci to lf,cf double
else
   @li,ci to lf,cf
endif

COLORWIN(LF+1,CI+2,LF+1,CF+2,"N+/N")
COLORWIN(LI+1,CF+1,LF+1,CF+2,"N+/N")

set color to &CAuxW

return .T.

******************************************************************************
FUNCTION ReSetC
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Ojetivo       : Retorna o cursor ao Status anterior ao ultimo "SetC"       *
* Observacao    :                                                            *
* Sintaxe       : ReSetC()                                                   *
* Parametros    :                                                            *
* Retorno       : .T.                                                        *
* Fun. chamadas :                                                            *
* Arquivo fonte : Cursor.prg                                                 *
* Arq. de dados :                                                            *
* Veja tamb‚m   : SetC()                                                     *
******************************************************************************
if type('PilhaCurW') <> 'A' .or. type('IDXCURSORW') <> 'N'
   Public PilhaCurW[30], IdxCursorW
   afill(PilhaCurW,0)
   IdxCursorW = 1
endif

IDXCursorW = IDXCursorW - if(IDXCursorW > 1,1,0)

if PilhaCurW[IDXCursorW] = 0
   set cursor off
else
   set cursor on
endif

return .T.

******************************************************************************
FUNCTION SetC
******************************************************************************
* Autor(es)     : Alexandre Simões                                           *
* Data          : Outubro/93                                                 *
*----------------------------------------------------------------------------*
* Ojetivo       : Seta o cursor                                              *
* Observacao    : Para o correto funcionamento da funcao, o cursor deve ser  *
*                 setado para OFF no inicio do programa                      *
* Sintaxe       : SetC(nLiga, nStatus)                                       *
* Parametros    : <nLiga> - 1 -> Liga cursor, 0 -> Desliga cursor            *
*                 <nStatus> - 0 -> Inicializa a pilha com o novo Status;     *
*                             1 -> Acrescenta Status `a pilha;               *
*                             2 -> Substitui status atual                    *
* Retorno       : .T.                                                        *
* Fun. chamadas :                                                            *
* Arquivo fonte : Cursor.prg                                                 *
* Arq. de dados :                                                            *
* Veja tamb‚m   : ReSetC()                                                   *
******************************************************************************
Parameters A, B

if type('PilhaCurW') <> 'A' .or. type('IDXCURSORW') <> 'N'
   Public PilhaCurW[30], IdxCursorW
   afill(PilhaCurW,0)
   IdxCursorW = 1
endif

if A = 1
   set cursor on
else
   set cursor off
endif

do case
   case B = 0
        IDXCursorW = 1
        PilhaCurW[IDXCursorW] = A
   case B = 1
        IDXCursorW = IDxCursorW + 1
        PilhaCurW[IDXCursorW] = A
   otherwise
        PilhaCurW[IDXCursorW] = A
endcase

return .T.

INIT FUNCTION AppSetup()
     REQUEST HB_LANG_PT
     REQUEST HB_CODEPAGE_PT850
     REQUEST HB_GT_GUI_DEFAULT
     REQUEST HB_GT_WVG
     REQUEST HB_GT_WVT
     REQUEST HB_GT_WGU
     HB_LANGSELECT("PT")
     HB_CDPSELECT( "PT850" )
     SET(_SET_DBFLOCKSCHEME,DB_DBFLOCK_DEFAULT)
     INICIAJANELA(00,00,24,80)
RETURN Nil

FUNCTION IniciaJanela(nLi,nCi,nLf,nCf)
LOCAL oCrt
DEFAULT nLi TO 0,;
        nCi TO 0,;
        nLf TO MaxRow(),;
        nCf TO MaxCol()  
    
     oCrt := WvgCrt():New( , , { nLi,nCi }, { nLf,nCf}, , .T. )
     oCrt:lModal := .F.
     oCrt:icon := "HARB_WIN.ICO"
     oCrt:create()
     oCrt:resizable :=.F.
     WVT_SetFont("Lucida Console")
     WVT_SetTitle("Sistema de Cores")
     WVT_SetAltF4Close(.F. )
     HB_gtInfo( HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
     hb_gtInfo( HB_GTI_COMPATBUFFER, .T. )
RETURN Nil
Todos os horários são UTC-03:00
Página 1 de 2

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB