cores no harbour

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

cores no harbour

Mensagem 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()
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

cores no harbour

Mensagem 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
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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
Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

cores no harbour

Mensagem por asimoes »

ABEL,

Segue função RGB:

Código: Selecionar todos

FUNCTION rgb( r,g,b )
   RETURN r + ( g * 256 ) + ( b * 256 * 256 )
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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 )

Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

cores no harbour

Mensagem 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
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem 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 !!!
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

cores no harbour

Mensagem 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 )
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

cores no harbour

Mensagem 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?
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Abel
Usuário Nível 3
Usuário Nível 3
Mensagens: 332
Registrado em: 14 Mar 2012 13:16
Localização: sao paulo / sp

cores no harbour

Mensagem por Abel »

Jose, vc incluiu o hbgtinfo.ch ?

outra coisa,
vc compilou com -gui -gtwvt ?

Abel
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

cores no harbour

Mensagem 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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

cores no harbour

Mensagem 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 
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Responder