Porque Harbour?

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

Moderador: Moderadores

clrod
Usuário Nível 2
Usuário Nível 2
Mensagens: 79
Registrado em: 17 Nov 2009 13:42
Localização: São Paulo - SP

Re: Porque Harbour?

Mensagem por clrod »

Olá

O que posso dizer com minha experiência recente é que você fica maluco (no bom sentido) com tanta coisa disponível Harbour. Dá para dizer que hoje temos uma linguagem moderna não devendo nada às mais modernas e mantendo a sintaxe e a semântica que já conhecemos do Clipper.

O Sérgio que estava preocupada se dava para se virar com Harbour é a prova que todos podem fazer a transição tranquila e sem medo de ter que voltar atrás. Eu já estou conseguindo fazer uma sistema extremamente complexo rodar em Harbour com mais velocidade, estabilidade, em qualquer sistema operacional mainstream, 32 ou 64 bits com tela DOS ou Gráfica (Windows, KDE, Gnome, etc), dá até para ter telas híbridas embora eu ache que fica uma coisa porca :-) E já vou testar o uso como servidor de aplicação web pra rodar c/ Apache ou IIS.

Sugiro a todos dar uma olhada na HbIDE escrita em... Harbour. Se não contar, tem gente acredita que é feito em C ou sei lá o que.

Dêem uma olhada na página http://www.harbour-project.org e se souber um pouco de inglês, aproveite para se inscrever nas listas.Não sei se tem alguém mantendo um blog em português sobre o Harbour, mas tem informações na Wikipédia também: http://pt.wikipedia.org/wiki/Projeto_Harbour.

Não acho possível continuar usando Clipper quase 15 anos depois de sua última versão e de ter uma quantidade de bugs absurda que nunca foram ou serão corrigidos. Harbour é muito limpo apesar de ter tantos recursos extras. :)Pos
Avatar do usuário
Itamar M. Lins Jr.
Administrador
Administrador
Mensagens: 7928
Registrado em: 30 Mai 2007 11:31
Localização: Ilheus Bahia
Curtiu: 1 vez

Re: Porque Harbour?

Mensagem por Itamar M. Lins Jr. »

Ola!
Gostaria de saber se consigo com o Harbour obter tela com visual igual a do Windows?
Usando as funções do clipper/harbour não é possivel.
Para ter visual gráfico terás que usar uma lib gráfica. Por exemplo Hwgui.
Não é só compilar com o [x]Harbour que suas telas estarão em modo gráfico.

Saudações,
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
gilsonpaulo
Usuário Nível 3
Usuário Nível 3
Mensagens: 135
Registrado em: 02 Fev 2008 11:30
Localização: Quatro Barras

Re: Porque Harbour?

Mensagem por gilsonpaulo »

Olha, eu tambem tive problemas para compilar com xharbour ou harbour em linha de comando, ai eu conheci a xdev, uma mãe.
http://www.sqllib.com.br/v4/index.php?a ... e=Download

Exemplo de um sistema em xharbour com wvw rodando em modo janela , mas com cara de ms-dos

Código: Selecionar todos

/******************************************************************************  
 * Sistema .....: GS INFORMATICA
 * Programa ....:   
 * Autor .......: Gilson Paulo Schuck  
 * Sintese .....: 
 * Data ........: 28/9/2009 às 19:31:36  
 * Revisado em .: 28/9/2009 às 19:31:36  
 ******************************************************************************/  
#include 'common.ch'  
#include 'sqllib.ch'

request sqllib
request mysql
request HB_LANG_PT
//request dbfcdx
//request HB_GT_WIN


function main()
HB_LANGSELECT( 'PT' )
set epoch to 1960
set scoreboard off
set date british
set century on
set deleted on
set softseek on
set wrap on
setblink(.f.)
set message to 31
clear screen

/*SQL CONNECT ON "mysql.onda.com.br" ;
     DATABASE "M240539_01";
     USER "M240539_01";
     PASSWORD "lXiKeeGZ";
     OPTIONS SQL_NO_WARNING;
     LIB "MySQL"


SQL CONNECT ON "localhost" ;
     DATABASE "eleitor";             	
     USER "root";
     PASSWORD "";
     OPTIONS SQL_NO_WARNING;
     LIB "MySQL"
*/
SQL CONNECT ON "dominio.com.br";
     DATABASE "gs";             	
     USER "xxxx";
     PASSWORD "xxxxxx";
     OPTIONS SQL_NO_WARNING;
     LIB "MySQL"

rddsetdefault("mysql")

*************************************************************************************************

public 	funcionario:=space(15),psenha:=space(1),pindu:=space(1),pcusto:=SPACE(1),pcadcli:=space(1),;
			firma:="GS INFORMATICA - COMERCIO E SERVIÇOS"
public	rodape1:=" ³ ESC - Sair ³ GS INFORMATICA ³ (41) 3672-4071 / (41) 8802-3828 ³",;
			rodape2:="³ ESC - Retorna ³"

*************************************************************************************************

 	Setup()
	IF SQLErrorNO() > 0
		MsgBox1("BASE DE DADOS OFF-LINE","VERIFIQUE O SERVIDOR")
		return
	endif
	arquivos()
	acesso()
   Desktop()
	menu_p()

*************************************************************************************************
function menu_p()
do while .t.
set color to "0/15,0/3"
@ 00,00 say replicate(" ",98)
@ 00,85 say netname()

@ 00,00 prompt " Cadastro "
@ 00,10 prompt " Usuarios "


menu to menu_p

    if lastkey() = 27
        op = Msgbox2("FINALIZAR O SISTEMA.")
           do case
              case op = 1
                  set color to 7/0
                  clear screen
                  commit
   					close databases
   					close all
   					//sql disconnect all
   					setcolor( '' )
   					clear screen
   					setcolor( "GR+/N" )
   					@ 01,10 say "GS Informatica"
   					@ 02,10 say "Quatro Barras - Pr (41) 8802-3828 / (41) 3672-4071"
   					setcolor("")
   					@ row()+2, col() say ""
   					quit
                  exit
               endcase
     endif


do case
   case menu_p = 1
		menu1()
   case menu_p = 2

   case menu_p = 3

   case menu_p = 4

   case menu_p = 6


endcase
enddo        

return nil

*************************************************************************************************
FUNCTION Setup()
   SetDefaultWindowSize()  // e a outra função é chamada aqui.
   WvW_SetMainCoord( .T. )
   WvW_SetPaintRefresh( 100 )
   WvW_SetVertCaret( .F. )
   WvW_SetAltF4Close( .F. )
   WvW_SetMouseMove( .F. )
   WvW_SetDefLineSpacing( 0 )
   WvW_SetMaxBMcache( 20 )
   WvW_SetLineSpacing( 0, 0 )
   WvW_SetPointer( 0, 1 )
//   WvW_SetTitle(, "ITUPAVA LAR CONSTRUۂO & CONSTRUۂO" )
   WvW_Maximize(0)
	WvW_sbcreate()
	WvW_NoClose()
   RETURN (.T.)
*************************************************************************************************
FUNCTION SetDefaultWindowSize()
LOCAL Result:= .T.
Local ScreenWidth
SetMode(32,98)
  IF Result
     screenWidth := Wvw_GetScreenWidth()
     DO CASE
        CASE  screenWidth >=1024
          Result:= Wvw_SetFont(,'Terminal',20,10)
        CASE  screenWidth >= 800
          Result:= Wvw_SetFont(,'Terminal',16,-8)
        OTHERWISE
          Result:= Wvw_SetFont(,'Terminal',12,6)
     ENDCASE
     IF Result
        Wvw_SetCodePage(,255)
        CLS
     ENDIF
  ENDIF
RETURN(Result)
*************************************************************************************************
function acesso()

i=0
i1=0
sen=""
psw=0
psenha=space(1)
pindu = space(1)
pcusto = space(1)

save screen to anh

select 1
use cadfun shared alias cadfun new
if neterr()
	MsgBox1("ERRO DE ABERTURA DO BANCO DE USUARIOS")
	return
endif
set index to cadfun
go top

do while .t.

set color to N/W
@ 12,25 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" color "n/w"
@ 13,25 say "³                       ³" color "n/w"
@ 14,25 say "³ Nome.:               :³" color "n/w"
@ 15,25 say "³                       ³" color "n/w"
@ 16,25 say "³ Senha:  * * * * * *   ³" color "n/w"
@ 17,25 say "³                       ³" color "n/w"
@ 18,25 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" color "n/w"

	tn=1200

	funcionario = SPACE(15)

	setcolor("R/W,R/W")
	@ 14,33 get funcionario picture "@! XXXXXXXXXXXXXXX"
	set cursor on
	read
	set cursor off
	if lastkey() = 27
		loop
	endif


	go top
	seek funcionario
	if .not. found()
		tone(1000,2)
		loop
	endif


	set color to W/R,W/R

	sen=""
	i=0
	i1 = 0
	psw=" "


 	do while len(sen)<6
		setcolor("W/W,W/W")
		psw = space(1)
		i1=i1+2
		@ 16,33+i1-1 get psw picture "@K! X"
		read
		if lastkey() = 27
			set cursor on
			quit
			exit
		endif

		sen=sen+psw
		//setcolor("W/R,W/R")
  		@ 16,33+i1 say CHR(2) color "R/W" //CHR(2)
		tone(tn,2)
		tn = tn - 200
	enddo
	tone(2000,5)
	tone(1500,5)
	restore screen from anh
   exit
enddo
select cadfun
unlock
select 1
use
set confirm on
setcolor("W/N,N/W")
return
*************************************************************************************************
function arquivos()

if !index("cadfun.cdx")
	Msg("INDEXANDO BANCO DE DADOS","CADFUN")	
	select 1
	use cadfun exclusive alias cadfun new
	index on login tag login to cadfun
	pack
endif

if !index("clientes.cdx")
	Msg("INDEXANDO BANCO DE DADOS","CLIENTES")
	select 2
	use clientes exclusive alias clientes new
	index on clibloq tag clibloq to clientes
	index on clitippes tag clitippes to clientes
	index on clidescli tag clidescli to clientes
	index on clicpf tag clicpf to clientes
	index on clicnpj tag clicnpj to clientes
	index on clicodigo tag clicodigo to clientes
	pack
endif

select 1
use
select 2
use
close all

Código: Selecionar todos

function cliente()

select 1
use clientes shared alias clientes new
if neterr()
	MsgBox1("ERRO NA ABERTURA DO BANCO, CLIENTES")
	close all
	return
endif
set index to clientes
go top

select 2
use remoto shared alias remoto new
if neterr()
	MsgBox1("ERRO NA ABERTURA DO BANCO, REMOTO")
	close all
	return
endif
go top

telcliente=savescreen(00,00,31,97)

@ 00,00 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" color "15/1"
@ 01,00 say "³                                                                                                ³" color "15/1"
@ 01,35 say "CADASTRO DE CLIENTES" color "14/1"
@ 02,00 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" color "15/1"
@ 03,00 say "³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿³" color "15/1"
//				 01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
@ 04,00 say "³³ Bloqueado.: : Tipo Pessoa J/F.: : Data Cadastro.:          : Cadastrado Por.:               :³³" color "15/1"
@ 05,00 say "³³ Codigo.:     : Cliente.:                                                                    :³³" color "15/1"
@ 06,00 say "³³ Endereco.:                                                    : Numero.:    : Cep.:         :³³" color "15/1"
@ 07,00 say "³³ Bairro...:                              : Cidade.:                              : UF.:  :    ³³" color "15/1"
@ 08,00 say "³³ Cpf/Cnpj.:                  : Insc/Rg.:                    : Contato.:                      :³³" color "15/1"
@ 09,00 say "³³ Fone.....:             : Fax.:             : Celular.:             :                        :³³" color "15/1"
@ 10,00 say "³³ Data Nascimento.:          : Ultimo Servico.:          : Ultima Compra.:          :          ³³" color "15/1"
@ 11,00 say "³³                                                                                              ³³" color "15/1"
@ 12,00 say "³³                                                                                              ³³" color "15/1"
@ 13,00 say "³³                                                                                              ³³" color "15/1"
@ 14,00 say "³³                                                                                              ³³" color "15/1"
@ 15,00 say "³³                                                                                              ³³" color "15/1"
@ 16,00 say "³³                                                                                              ³³" color "15/1"
@ 17,00 say "³³                                                                                              ³³" color "15/1"
@ 18,00 say "³³                                                                                              ³³" color "15/1"
@ 19,00 say "³³                                                                                              ³³" color "15/1"
@ 20,00 say "³³                                                                                              ³³" color "15/1"
@ 21,00 say "³³                                                                                              ³³" color "15/1"
@ 22,00 say "³³                                                                                              ³³" color "15/1"
@ 23,00 say "³³                                                                                              ³³" color "15/1"
@ 24,00 say "³ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ³" color "15/1"
@ 25,00 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" color "15/1"
@ 26,00 say "³ Opcoes....:[Incluir] [Alterar] [Excluir]                                                       ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 26,14 say "I" color "14/1"
@ 26,24 say "A" color "14/1"
@ 26,34 say "E" color "14/1"
@ 27,00 say "³ Consultas.:[Conferencia] [A Receber] [Gerar TxT]                                               ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 27,17 say "F" color "14/1"
@ 27,34 say "B" color "14/1"
@ 27,47 say "X" color "14/1"
@ 28,00 say "³ Relatorios:[Acerto]                                                                            ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 28,17 say "R" color "14/1"
@ 29,00 say "³ Ordena Por:[Codigo] [Nome] [NC Pesquisa Por Nome]                                              ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 29,14 say "C" color "14/1"
@ 29,23 say "N" color "14/1"
@ 29,30 say "NC" color "14/1"
@ 30,00 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" color "15/1"
@ 31,00 say replicate(" ",97) color "0/15"
@ 31,80 say rodape2 color "0/15"

select clientes

do while .t.

	set cursor off
	setcolor("14/1,15/1")
	
	@ 04,14 say clibloq
	@ 04,34 say clitippes
	@ 04,52 say clidatcad picture "@K 99/99/9999"
	@ 04,80 say clicadpor
	@ 05,11 say clicodigo
	@ 05,27 say clidescli
	@ 06,13 say cliendcli
	@ 06,75 say clinumero
	@ 06,86 say clicep picture "@R 99999-999"
	@ 07,13 say clibairro
	@ 07,53 say clicidade
	@ 07,89 say cliuf
	if clitippes = "F"
		@ 08,13 say clicpf picture "@R 999.999.999-99"
	else
		@ 08,13 say clicnpj picture "@R 99.999.999/9999-99"
	endif
	@ 08,42 say cliinsc
	@ 08,73 say clicontato
	@ 09,13 say clifone picture "@R (99)9999-9999"
	@ 09,33 say clifax picture "@R (99)9999-9999"
	@ 09,57 say clicelular picture "@R (99)9999-9999"
	@ 10,20 say clidatnasc picture "@K 99/99/9999"
	@ 10,48 say cliultserv picture "@K 99/99/9999"
	@ 10,75 say cliultcomp picture "@K 99/99/9999"

	ik = 0

	ik = inkey(0)

	if ik=27
		exit
	elseif ik=5
		skip -1
		ik = 0
	elseif ik=24 
      skip 
		ik = 0
	elseif ik = 6
		go bottom
	elseif ik = 1
		go top
	elseif ik = 105 .or. ik = 73
		telinccli=savescreen(00,00,31,97)
		inccli()
		restscreen(00,00,31,97,telinccli)
	elseif ik = 69 .or. ik = 101
		op = MsgBox2("CONFIRMA EXCLUSÇO DO CLIENTE?" )
		do case
			case op = 1	
			select clientes
			if rlock()
				delete
				skip 
				dbcommit()
				unlock
			else
				MsgBox1("NÇO CONSEGUI EXCLUIR O REGISTRO, TENTE NOVAMENTE")
			endif
		endcase
	elseif ik = 65 .or. ik = 97
		if .not. empty(clidescli)
			altcli()
		endif
	elseif ik = 82 .or. ik = 114
		if .not. empty(clidescli)
			remoto()
		endif					
  	else
		tone(300)
	endif

	if eof()
		skip -1
	endif

	if bof()
		go top
	endif
enddo	

select 1
use
select 2
use
close
restscreen(00,00,31,97,telcliente)
return(nil)
*******************************************************************************
static procedure inccli()

local	iclibloq:=space(01),iclitippes:=space(01),iclicadpor:=space(15),iclicodigo:=space(05),;
		iclidescli:=space(68),icliendcli:=space(52),iclinumero:=space(04),iclicep:=space(08),;
		iclibairro:=space(30),iclicidade:=space(30),icliuf:=space(02),iclicpf:=space(11),;
		iclicnpj:=space(14),icliinsc:=space(20),iclicontato:=space(22),iclifone:=space(10),;
		iclifax:=space(10),iclicelular:=space(10),iclidatnasc:=ctod("00.00.00")

@ 00,00 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" color "15/1"
@ 01,00 say "³                                                                                                ³" color "15/1"
@ 01,35 say "CADASTRO DE CLIENTES" color "14/1"
@ 02,00 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" color "15/1"
@ 03,00 say "³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿³" color "15/1"
//				 01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
@ 04,00 say "³³ Bloqueado.: : Tipo Pessoa J/F.: : Data Cadastro.:          : Cadastrado Por.:               :³³" color "15/1"
@ 05,00 say "³³ Codigo.:     : Cliente.:                                                                    :³³" color "15/1"
@ 06,00 say "³³ Endereco.:                                                    : Numero.:    : Cep.:         :³³" color "15/1"
@ 07,00 say "³³ Bairro...:                              : Cidade.:                              : UF.:  :    ³³" color "15/1"
@ 08,00 say "³³ Cpf/Cnpj.:                  : Insc/Rg.:                    : Contato.:                      :³³" color "15/1"
@ 09,00 say "³³ Fone.....:             : Fax.:             : Celular.:             :                        :³³" color "15/1"
@ 10,00 say "³³ Data Nascimento.:          : Ultimo Servico.:          : Ultima Compra.:          :          ³³" color "15/1"
@ 11,00 say "³³                                                                                              ³³" color "15/1"
@ 12,00 say "³³                                                                                              ³³" color "15/1"
@ 13,00 say "³³                                                                                              ³³" color "15/1"
@ 14,00 say "³³                                                                                              ³³" color "15/1"
@ 15,00 say "³³                                                                                              ³³" color "15/1"
@ 16,00 say "³³                                                                                              ³³" color "15/1"
@ 17,00 say "³³                                                                                              ³³" color "15/1"
@ 18,00 say "³³                                                                                              ³³" color "15/1"
@ 19,00 say "³³                                                                                              ³³" color "15/1"
@ 20,00 say "³³                                                                                              ³³" color "15/1"
@ 21,00 say "³³                                                                                              ³³" color "15/1"
@ 22,00 say "³³                                                                                              ³³" color "15/1"
@ 23,00 say "³³                                                                                              ³³" color "15/1"
@ 24,00 say "³ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ³" color "15/1"
@ 25,00 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" color "15/1"
@ 26,00 say "³ Opcoes....:[Incluir] [Alterar] [Excluir]                                                       ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 26,14 say "I" color "14/1"
@ 26,24 say "A" color "14/1"
@ 26,34 say "E" color "14/1"
@ 27,00 say "³ Consultas.:[Conferencia] [A Receber] [Gerar TxT]                                               ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 27,17 say "F" color "14/1"
@ 27,34 say "B" color "14/1"
@ 27,47 say "X" color "14/1"
@ 28,00 say "³ Relatorios:[Acerto]                                                                            ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 28,17 say "R" color "14/1"
@ 29,00 say "³ Ordena Por:[Codigo] [Nome] [NC Pesquisa Por Nome]                                              ³" color "15/1"
//				 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
@ 29,14 say "C" color "14/1"
@ 29,23 say "N" color "14/1"
@ 29,30 say "NC" color "14/1"
@ 30,00 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" color "15/1"
@ 31,00 say replicate(" ",97) color "0/15"
@ 31,80 say rodape2 color "0/15"

do while .t.

	setcolor("10/1,10/1")
	
	iclibloq="N"
	
	@ 04,14 say iclibloq picture "@!KX" //valid(iclibloq$"SN")
	@ 04,34 get iclitippes picture "@!KX" valid(iclitippes$"JF")
	set cursor on
	read	
	set cursor off
	if lastkey() == 27
		return
	endif	
	@ 04,52 say date() picture "@K 99/99/9999"
	@ 04,80 say funcionario
	select clientes
   set order to 6
   go top
   bus = 0
   do while .t.
	   bus++
      seek strzero(bus,5,0)
      if .not. found()
      	iclicodigo = bus
      	exit
      endif
   enddo
	@ 05,11 say iclicodigo picture "@K 99999"
	@ 05,27 get iclidescli picture "@!KX" valid !empty(iclidescli)
	@ 06,13 get icliendcli picture "@!KX" 
	@ 06,75 get iclinumero picture "@!K"
	@ 06,86 get iclicep picture "@R 99999-999"
	@ 07,13 get iclibairro picture "@!KX" 
	@ 07,53 get iclicidade picture "@!KX" 
	@ 07,89 get icliuf picture "@!KX" 
	if iclitippes = "F"
		@ 08,13 get iclicpf picture "@R 999.999.999-99"
	else
		@ 08,13 get iclicnpj picture "@R 99.999.999/9999-99"
	endif
	@ 08,42 get icliinsc picture "@!KX" 
	@ 08,73 get iclicontato picture "@!KX" 
	@ 09,13 get iclifone picture "@R (99)9999-9999"
	@ 09,33 get iclifax picture "@R (99)9999-9999"
	@ 09,57 get iclicelular picture "@R (99)9999-9999"
	@ 10,20 get iclidatnasc picture "@K 99/99/9999"
	set cursor on
	read
	set cursor off
	if lastkey() == 27
		return
	endif

   op=MsgBox2( "CONFIRMA CADASTRO?" )
  	do case 
  		case op=1
			clientes->(dbappend())
			if neterr()
				op=MsgBox1("NAO FOI POSSIVEL GRAVAR O REGISTRO","TENTE NOVAMENTE")
				do case
					case op=1
						loop
				endcase		
			else
				if rlock()
					clientes->clibloq:=		iclibloq
					clientes->clitippes:=	iclitippes
					clientes->clidatcad:=	date()
					clientes->clicadpor:=	funcionario
					clientes->clicodigo:=	strzero(iclicodigo,5,0)
					clientes->clidescli:=	iclidescli
					clientes->cliendcli:=	icliendcli
					clientes->clinumero:=	padl(rtrim(iclinumero),4," ")
					clientes->clicep:=		iclicep
					clientes->clibairro:=	iclibairro
					clientes->clicidade:=	iclicidade
					clientes->cliuf:=			icliuf
					if iclitippes = "F"
						clientes->clicpf:=	iclicpf
					else
						clientes->clicnpj:=	iclicnpj
					endif
					clientes->cliinsc:=		icliinsc
					clientes->clicontato:=	iclicontato
					clientes->clifone:=		iclifone
					clientes->clifax:=		iclifax
					clientes->clicelular:=	iclicelular
					clientes->clidatnasc:=	iclidatnasc						
					dbcommit()
   	         unlock
				endif
			endif
		case op=2
			exit
	endcase			
exit
enddo
*******************************************************************************
static procedure altcli()

local	aclibloq:=clibloq,aclitippes:=clitippes,aclicadpor:=clicadpor,aclicodigo:=clicodigo,;
		aclidescli:=clidescli,acliendcli:=cliendcli,aclinumero:=clinumero,aclicep:=clicep,;
		aclibairro:=clibairro,aclicidade:=clicidade,acliuf:=cliuf,aclicpf:=clicpf,;
		aclicnpj:=clicnpj,acliinsc:=cliinsc,aclicontato:=clicontato,aclifone:=clifone,;
		aclifax:=clifax,aclicelular:=clicelular,aclidatnasc:=clidatnasc

do while .t.

	setcolor("10/1,10/1")
	
// 04,14 say aclibloq picture "@!KX" //valid(aclibloq$"SN")
// 04,34 say aclitippes picture "@!KX" //valid(aclitippes$"JF")

/* 04,52 say date() picture "@K 99/99/9999"
   04,80 say funcionario
	select clientes
   set order to 6
   go top
   bus = 0
   do while .t.
	   bus++
      seek strzero(bus,5,0)
      if .not. found()
      	iclicodigo = bus
      	exit
      endif
   enddo
*/
	@ 05,11 say aclicodigo picture "@K 99999"
	@ 05,27 get aclidescli picture "@!KX" valid !empty(aclidescli)
	@ 06,13 get acliendcli picture "@!KX" 
	@ 06,75 get aclinumero picture "@!K"
	@ 06,86 get aclicep picture "@R 99999-999"
	@ 07,13 get aclibairro picture "@!KX" 
	@ 07,53 get aclicidade picture "@!KX" 
	@ 07,89 get acliuf picture "@!KX" 
	if aclitippes = "F"
		@ 08,13 get aclicpf picture "@R 999.999.999-99"
	else
		@ 08,13 get aclicnpj picture "@R 99.999.999/9999-99"
	endif
	@ 08,42 get acliinsc picture "@!KX" 
	@ 08,73 get aclicontato picture "@!KX" 
	@ 09,13 get aclifone picture "@R (99)9999-9999"
	@ 09,33 get aclifax picture "@R (99)9999-9999"
	@ 09,57 get aclicelular picture "@R (99)9999-9999"
	@ 10,20 get aclidatnasc picture "@K 99/99/9999"
	set cursor on
	read
	set cursor off
	if lastkey() == 27
		return
	endif

	op2=MsgBox2( "CONFIRMA ALTERAۂO DO CADASTRO DO CLIENTE?" )
		if op2 = 1
			if rlock()
//		clientes->clibloq:=		aclibloq
//		clientes->clitippes:=	aclitippes
//		clientes->clidatcad:=	date()
//		clientes->clicadpor:=	funcionario
//		clientes->clicodigo:=	strzero(aclicodigo,5,0)
				clientes->clidescli:=	aclidescli
				clientes->cliendcli:=	acliendcli
				clientes->clinumero:=	padl(rtrim(aclinumero),4," ")
				clientes->clicep:=		aclicep
				clientes->clibairro:=	aclibairro
				clientes->clicidade:=	aclicidade
				clientes->cliuf:=			acliuf
				if clitippes = "F"
					clientes->clicpf:=	aclicpf
				else
					clientes->clicnpj:=	aclicnpj
				endif
				clientes->cliinsc:=		acliinsc
				clientes->clicontato:=	aclicontato
				clientes->clifone:=		aclifone
				clientes->clifax:=		aclifax
				clientes->clicelular:=	aclicelular
				clientes->clidatnasc:=	aclidatnasc						
				dbcommit()
      	   unlock
			endif
		else
			exit
		endif
	exit
enddo
*******************************************************************************
function remoto()

local vet1[5],vet2[5],vet3[5]	

telrem=savescreen(02,39,29,97)

setcolor("15/1,1/15")	
@ 02,39 clear to 29,97
@ 02,39 to 29,97
@ 04,39 say "Ã"
@ 04,97 say "´"
@ 27,39 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄ´"
//				  01234567890123456789012345678901234567890
@ 28,40 say  "[Incluir] [Excluir] [Alterar] [Esc -> Retorna]"
@ 28,41 say "I" color("14/1")
@ 28,51 say "E" color("14/1")
@ 28,61 say "A" color("14/1")
@ 28,71 say "ESC" color("14/1")

select remoto
set filter to codcli = clientes->clicodigo
go top

do while .t.
	select remoto
	
	vet1[1]="tipacesso"
	vet1[2]="estacao"
	vet1[3]="codacesso"
	vet1[4]="senha"
	
	vet3[1]="TIPO ACESSO"
	vet3[2]="ESTACAO"
	vet3[3]="CODIGO"
	vet3[4]="SENHA"

	dbedit(03,40,26,96,vet1,"sairem","",vet3)
	set filter to
	exit
enddo
restscreen(02,39,29,97,telrem)
select clientes
return
*******************************************************************************
function sairem()

if lastkey() = 27
	return(0)
endif	
Se voce observar estou usando a sqllib para testes, resumindo sistema em modo texto com base de dados mysql

Segue link para vc ter uma previa
http://www.4shared.com/file/Ze7z2DNz/NovoArquivo.html

Usuario.: teste
Senha.:123456

Este sistema não esta pronto estou fazendo testes.

Mas da para cadastrar,excluir e alterar clientes
Responder