cores no harbour
Moderador: Moderadores
cores no harbour
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
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
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
cores no harbour
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()
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.
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.
cores no harbour
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)
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)
cores no harbour
asimoes, quais libs ou includes vc acrescenta
coloquei a sua funcao e deu erro de compilacao
undefined reference to "hb_fun_rgb"
Abel
coloquei a sua funcao e deu erro de compilacao
undefined reference to "hb_fun_rgb"
Abel
cores no harbour
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
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
ABEL,
Segue função RGB:
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)
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)
cores no harbour
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.
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
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
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
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
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)
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)
cores no harbour
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 !!!
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
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 )
É 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)
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)
- JoséQuintas
- Administrador

- Mensagens: 20267
- Registrado em: 26 Fev 2007 11:59
- Localização: São Paulo-SP
cores no harbour
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?
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/
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/
- JoséQuintas
- Administrador

- Mensagens: 20267
- Registrado em: 26 Fev 2007 11:59
- Localização: São Paulo-SP
cores no harbour
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/
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/
cores no harbour
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:


scolor.hbp
scolor.prg
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:


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

